      SUBROUTINE DPMESS(IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE DATAPLOT MESSAGES
C              FOR THE ANALYST'S PERUSAL UPON
C              SIGNING ON TO DATAPLOT.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--DECEMBER  1977.
C     UPDATED         --JANUARY   1979.
C     UPDATED         --NOVEMBER  1980.
C     UPDATED         --JUNE      1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1985.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*80 IFILE
      CHARACTER*12 ISTAT
      CHARACTER*12 IFORM
      CHARACTER*12 IACCES
      CHARACTER*12 IPROT
      CHARACTER*12 ICURST
      CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*80 ISTRIN
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOF2.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPME'
      ISUBN2='SS  '
C
      IFOUND='YES'
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'MESS')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMESS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR
   53 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IMESNU
   61 FORMAT('IMESNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IMESNA
   62 FORMAT('IMESNA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IMESST
   63 FORMAT('IMESST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IMESFO
   64 FORMAT('IMESFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IMESAC
   65 FORMAT('IMESAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)IMESFO
   66 FORMAT('IMESFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)IMESCS
   67 FORMAT('IMESCS = ',A12)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************
C               **  STEP 11--           **
C               **  COPY OVER VARIABLES **
C               **************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MESS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=IMESNU
      IFILE=IMESNA
      ISTAT=IMESST
      IFORM=IMESFO
      IACCES=IMESAC
      IPROT=IMESPR
      ICURST=IMESCS
C
      ISUBN0='MESS'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'MESS')GOTO1199
      WRITE(ICOUT,1193)IOUNIT
 1193 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1194)IFILE
 1194 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1195)ISTAT,IFORM,IACCES,IPROT,ICURST
 1195 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1196)ISUBN0,IERRFI
 1196 FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1199 CONTINUE
C
C               *******************************************
C               **  STEP 12--                            **
C               **  CHECK TO SEE IF MESSAGE FILE EXISTS  **
C               *******************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MESS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')GOTO9000
C
C               *********************
C               **  STEP 31--      **
C               **  OPEN THE FILE  **
C               *********************
C
      ISTEPN='31'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MESS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
C               ******************************
C               **  STEP 41--               **
C               **  READ THE FILE.          **
C               **  WRITE OUT THE MESSAGES. **
C               ******************************
C
      ISTEPN='41'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MESS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ANUMLI=0.0
      READ(IOUNIT,4111,END=4190)ANUMLI
 4111 FORMAT(F10.0)
      NUMLIN=ANUMLI+0.5
C
      IF(NUMLIN.LE.0)GOTO4190
      DO4120I=1,NUMLIN
      READ(IOUNIT,4121,END=4190)(ISTRIN(J:J),J=1,80)
 4121 FORMAT(80A1)
      CALL DPDB80(ISTRIN,JMAX,IBUGS2,ISUBRO,IERROR)
      IF(JMAX.GE.1)WRITE(ICOUT,4122)(ISTRIN(J:J),J=1,JMAX)
 4122 FORMAT(5X,80A1)
      IF(JMAX.GE.1)CALL DPWRST('XXX','BUG ')
      IF(JMAX.LE.0)WRITE(ICOUT,999)
      IF(JMAX.LE.0)CALL DPWRST('XXX','BUG ')
 4120 CONTINUE
 4190 CONTINUE
C
C               ***********************
C               **  STEP 51--        **
C               **  CLOSE THE FILE.  **
C               ***********************
C
      ISTEPN='51'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MESS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'MESS')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMESS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR
 9012 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IOUNIT
 9021 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IFILE
 9022 FORMAT('IFILE  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)ISTAT
 9023 FORMAT('ISTAT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)IFORM
 9024 FORMAT('IFORM  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)IACCES
 9025 FORMAT('IACCES = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)IPROT
 9026 FORMAT('IPROT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)ICURST
 9027 FORMAT('ICURST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IENDFI
 9028 FORMAT('IENDFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IREWIN
 9029 FORMAT('IREWIN = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)ISUBN0
 9031 FORMAT('ISUBN0 = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IERRFI
 9032 FORMAT('IERRFI = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)JMAX
 9041 FORMAT('JMAX = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(JMAX.GE.1)WRITE(ICOUT,9042)(ISTRIN(J:J),J=1,JMAX)
 9042 FORMAT('ISTRIN--',80A1)
      IF(JMAX.GE.1)CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMFCO(IHARG,NUMARG,IDEMFC,MAXMAR,IMAFCO,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE MARKER FILL COLORS = THE COLORS
C              OF THE (BACKGROUND) FILL WITHIN THE MARKERS.
C              THESE ARE LOCATED IN THE VECTOR IMAFCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEMFC
C                     --MAXMAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IMAFCO (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEMFC
      CHARACTER*4 IMAFCO
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IMAFCO(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPMF'
      ISUBN2='CO  '
C
      NUMMAR=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMFCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXMAR,NUMMAR
   53 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEMFC
   55 FORMAT('IDEMFC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IMAFCO(1)
   70 FORMAT('IMAFCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IMAFCO(I)
   76 FORMAT('I,IMAFCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMMAR=1
      IMAFCO(1)=IDEMFC
      GOTO1270
C
 1220 CONTINUE
      NUMMAR=NUMARG-2
      IF(NUMMAR.GT.MAXMAR)NUMMAR=MAXMAR
      DO1225I=1,NUMMAR
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDEMFC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEMFC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMFC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMFC
      IMAFCO(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMMAR
      WRITE(ICOUT,1276)I,IMAFCO(I)
 1276 FORMAT('THE FILL COLOR OF MARKER ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMMAR=MAXMAR
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDEMFC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEMFC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMFC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMFC
      DO1315I=1,NUMMAR
      IMAFCO(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IMAFCO(I)
 1316 FORMAT('THE FILL COLOR OF ALL MARKERS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMFCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXMAR,NUMMAR
 9013 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEMFC
 9015 FORMAT('IDEMFC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IMAFCO(1)
 9030 FORMAT('IMAFCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IMAFCO(I)
 9036 FORMAT('I,IMAFCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMFSW(IHARG,NUMARG,IDEMFS,MAXMAR,IMAFSW,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE MARKER FILL SWITCHES = THE ON/OFF SWITCHES
C              OF THE (BACKGROUND) FILL WITHIN THE MARKERS.
C              THESE ARE LOCATED IN THE VECTOR IMAFSW(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEMFS
C                     --MAXMAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IMAFSW (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEMFS
      CHARACTER*4 IMAFSW
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IMAFSW(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPMF'
      ISUBN2='SW  '
C
      NUMMAR=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMFSW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXMAR,NUMMAR
   53 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEMFS
   55 FORMAT('IDEMFS = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IMAFSW(1)
   70 FORMAT('IMAFSW(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IMAFSW(I)
   76 FORMAT('I,IMAFSW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='ON'
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMMAR=1
      IMAFSW(1)='ON'
      GOTO1270
C
 1220 CONTINUE
      NUMMAR=NUMARG-2
      IF(NUMMAR.GT.MAXMAR)NUMMAR=MAXMAR
      DO1225I=1,NUMMAR
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMFS
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMFS
      IMAFSW(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMMAR
      WRITE(ICOUT,1276)I,IMAFSW(I)
 1276 FORMAT('THE FILL SWITCH FOR MARKER ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMMAR=MAXMAR
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMFS
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMFS
      DO1315I=1,NUMMAR
      IMAFSW(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IMAFSW(I)
 1316 FORMAT('THE FILL SWITCH FOR ALL MARKERS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMFSW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXMAR,NUMMAR
 9013 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEMFS
 9015 FORMAT('IDEMFS = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IMAFSW(1)
 9030 FORMAT('IMAFSW(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IMAFSW(I)
 9036 FORMAT('I,IMAFSW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMGU1(Y,TAG,N,
     1XTEMP,DTEMP,MAXNXT,
     1SCALML,SCA2ML,SCALSE,SCALMO,SCMOSE,
     1UHATML,UHATSE,UHATMO,UMOMSE,COVSE,
     1NUMV,ICENTY,TEND,
     1ICAPSW,ICAPTY,IGUMBC,MINMAX,
     1QP,XQPHAT,XQPSE,XQPLCL,XQPUCL,NPERC,
     1XQPHTZ,XQPLCZ,XQPUCZ,
     1IOUNI1,IOUNI2,ALPHAP,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR GUMBEL (EXTREME VALUE TYPE 1) DISTRIBUTION
C              FOR THE FULL SAMPLE CASE.
C     EXAMPLE--GUMBEL MAXIMUM LIKELIHOOD Y
C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
C                1999, CHAPTER 15.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/12
C     ORIGINAL VERSION--DECEMBER  2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICENTY
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IGUMBC
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*7 ICASE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      PARAMETER (NUMALP=6)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWU(NUMALP)
      DIMENSION AHIGHU(NUMALP)
      DIMENSION ALOWB(NUMALP)
      DIMENSION AHIGHB(NUMALP)
      DIMENSION A2LOWB(NUMALP)
      DIMENSION A2HGHB(NUMALP)
      DIMENSION A2LOWU(NUMALP)
      DIMENSION A2HGHU(NUMALP)
C
      DIMENSION Y(*)
      DIMENSION TAG(*)
      DIMENSION XTEMP(*)
      DIMENSION XQPHTZ(*)
      DIMENSION XQPLCZ(*)
      DIMENSION XQPUCZ(*)
      DIMENSION QP(*)
      DIMENSION XQPHAT(*)
      DIMENSION XQPSE(*)
      DIMENSION XQPLCL(*)
      DIMENSION XQPUCL(*)
C
      DOUBLE PRECISION DTEMP(*)
C
      DOUBLE PRECISION EV1FU2
      DOUBLE PRECISION EV1FU3
      DOUBLE PRECISION EV1FU4
      DOUBLE PRECISION EV1FU6
      EXTERNAL EV1FU2
      EXTERNAL EV1FU3
      EXTERNAL EV1FU4
      EXTERNAL EV1FU6
C
      INTEGER IN 
      DOUBLE PRECISION XBAR
      COMMON/EV1CO2/XBAR,MINMX2,IN
      DOUBLE PRECISION DK
      DOUBLE PRECISION DLLUS
      COMMON/EV1CO3/DK, DLLUS
      DOUBLE PRECISION SHAT
      COMMON/EV1CO4/SHAT
      DOUBLE PRECISION DQ
      DOUBLE PRECISION SHATML
      COMMON/EV1CO6/DQ,SHATML
C
      DOUBLE PRECISION DN
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DAE
      DOUBLE PRECISION DRE
      DOUBLE PRECISION DG
      DOUBLE PRECISION DS
      DOUBLE PRECISION DT1
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION DXSTRT
      DOUBLE PRECISION DXLOW
      DOUBLE PRECISION DXUP
      DOUBLE PRECISION XLOWSV
      DOUBLE PRECISION XUPSV
C
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
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPMG'
      ISUBN2='U1  '
C
      ICASE='Maximum'
      IF(MINMAX.NE.2)ICASE='Minimum'
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGU1')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPPGU1--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,NUMV
   55   FORMAT('N,NUMV,NPERC = ',3I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I),TAG(I)
   57     FORMAT('I,Y(I),TAG(I) = ',I8,2E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
        WRITE(ICOUT,59)ICENTY
   59   FORMAT('ICENTY = ',A4)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGU1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN GUMBEL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)
 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 1 ',
     1         'IS <= 1')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)N
 1113   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** WARNING FROM GUMBEL MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1132)HOLD
 1132 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
      IF(NPERC.GT.0)THEN
        DO1145I=1,NPERC
          IF(QP(I).LE.0.0 .OR. QP(I).GE.100.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1141)
 1141       FORMAT('***** WARNING IN GUMBEL MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1143)QP(I)
 1143       FORMAT('      REQUESTED PERCENTILE (',G15.7,') IS ',
     1             'OUTSIDE THE (0,100) INTERVAL')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1144)
 1144       FORMAT('      NO PERCENTILE CONFIDENCE LIMITS WILL BE ',
     1             'COMPUTED.')
            CALL DPWRST('XXX','WRIT')
            NPERC=0
          ENDIF
 1145   CONTINUE
      ENDIF
C
C
C               **********************************
C               **  STEP 41--                   **
C               **  CARRY OUT CALCULATIONS      **
C               **  FOR GUMBEL MLE              **
C               **  ESTIMATE (FULL SAMPLE CASE) **
C               **********************************
C
 3100 CONTINUE
C
      ISTEPN='31'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGU1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      AN=REAL(N)
C
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
C
C  MOMENT ESTIMATES ARE:
C
C    MUHAT = XBAR - 0.45006*SD
C    SHAT  = 0.77970*SD
C
C  THE MAXIMUM LIKELIHOOD ESTIMATES ARE:
C
C
C  THE ML ESTIMATE OF THE SCALE PARAMETER IS THE SOLUTION TO
C  THE FOLLOWING EQUATION:
C
C              FOR THE MAXIMUM CASE:
C
C                 SHAT - XBAR + SUM[i=1 to N][X(I)*EXP(-X(I)/SHAT)]/
C                        SUM[i=1 to N][EXP(-X(I)/SHAT)] = 0
C
C              FOR THE MINIMUM CASE:
C
C                 SHAT - XBAR + SUM[i=1 to N][X(I)*EXP(X(I)/SHAT)]/
C                        SUM[i=1 to N][EXP(X(I)/SHAT)] = 0
C
C              WITH
C
C                 SHAT     = CURRENT ESTIMATE OF SCALE PARAMETER
C                 XBAR     = SAMPLE MEAN
C                 N        = SAMPLE SIZE
C                 MINMAX   = SPECIFY WHETHER MAXIMUM OR MINIMUM
C                            CASE IS BEING ESTIMATED
C
C THE ML ESTIMATE OF LOCATION FOR THE MAXIMUM CASE IS
C
C   MUHAT = -SHAT*LOG(SUM[i=1 to N][EXP(-X(I)/SHAT)]/N)
C
C THE ML ESTIMATE OF LOCATION FOR THE MINIMUM CASE IS
C
C   MUHAT = -SHAT*LOG(SUM[i=1 to N][EXP(X(I)/SHAT)]/N)
C
C
      AN=REAL(N)
      DN=DBLE(N)
      IF(MINMAX.EQ.2)THEN
        UHATMO=XMEAN - 0.45006*XSD
      ELSE
        UHATMO=XMEAN + 0.45006*XSD
      ENDIF
      SCALMO=0.77970*XSD
      UMOMSE=SQRT(1.16781*SCALMO**2/AN)
      SCMOSE=1.10001*XSD**2/AN
C
      XBAR=DBLE(XMEAN)
      MINMX2=MINMAX
      IN=N
C
      DXSTRT=DBLE(SCALMO)
      DAE=2.0*0.000001D0*DXSTRT
      DRE=DAE
      IFLAG=0
      DXLOW=DXSTRT/2.0D0
      DXUP=2.0D0*DXSTRT
      ITBRAC=0
      DO3104I=1,N
        DTEMP(I)=DBLE(Y(I))
 3104 CONTINUE
C
 3105 CONTINUE
      XLOWSV=DXLOW
      XUPSV=DXUP
      CALL DFZER2(EV1FU2,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
C
      IF(IFLAG.EQ.4 .AND. ITBRAC.LE.100)THEN
        DXLOW=XLOWSV/2.0D0
        DXUP=2.0D0*XUPSV
        ITBRAC=ITBRAC+1
        GOTO3105
      ENDIF
C
      IF(IFLAG.EQ.2)THEN
C
C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,111)
CC111   FORMAT('***** WARNING FROM GUMBEL MAXIMUM ',
CCCCC1         'LIKELIHOOD--')
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,113)
CC113   FORMAT('      ESTIMATE OF SIGMA MAY NOT BE COMPUTED TO ',
CCCCC1         'DESIRED 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 GUMBEL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,123)
  123   FORMAT('      ESTIMATE OF SCALE 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 GUMBEL MAXIMUM LIKELIHOOD--')
        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 GUMBEL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,143)
  143   FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      SCALML=REAL(DXLOW)
      BN=(1.0 + 2.2/AN**1.13)
      SCA2ML=BN*SCALML
C
      DSUM1=0.0D0
      IF(MINMAX.EQ.2)THEN
        DO3108I=1,N
          DX=-DBLE(Y(I))
          DSUM1=DSUM1 + DEXP(DX/DBLE(SCALML))
 3108   CONTINUE
        DTERM1=-DBLE(SCALML)*DLOG(DSUM1/DN)
      ELSE
        DO3109I=1,N
          DX=DBLE(Y(I))
          DSUM1=DSUM1 + DEXP(DX/DBLE(SCALML))
 3109   CONTINUE
        DTERM1=DBLE(SCALML)*DLOG(DSUM1/DN)
      ENDIF
      UHATML=REAL(DTERM1)
C
      SCALSE=0.77970*SCALML/SQRT(AN)
      UHATSE=1.05293*SCALML/SQRT(AN)
      COVSE=0.50697*SCALML/SQRT(AN)
      IF(IGUMBC.EQ.'ON')THEN
        SCALSE=SCALSE*BN
        COVSE=COVSE*SQRT(BN)
      ENDIF
C
      IF(IGUMBC.EQ.'ON')THEN
        SCTEMP=SCA2ML
      ELSE
        SCTEMP=SCALML
      ENDIF
C
      DSUM1=0.0D0
      IF(MINMAX.EQ.2)THEN
        DO3110I=1,N
          DSUM1=DSUM1 + DEXP(-(Y(I) - DBLE(UHATML))/DBLE(SCALML))
 3110   CONTINUE
        DLLUS=-DN*DLOG(DBLE(SCALML)) - DN*XBAR/DBLE(SCALML) +
     1         DN*DBLE(UHATML)/DBLE(SCALML) - DSUM1
      ELSE
        DO3115I=1,N
          DSUM1=DSUM1 + DEXP((Y(I) + DBLE(UHATML))/DBLE(SCALML))
 3115   CONTINUE
        DLLUS=-DN*DLOG(DBLE(SCALML)) - DN*XBAR/DBLE(SCALML) +
     1         DN*DBLE(UHATML)/DBLE(SCALML) - DSUM1
      ENDIF
      SHAT=DBLE(SCALML)
C
      DAE=1.D-7
      DRE=1.D-7
      NUTEMP=1
C
      DO3120I=1,NUMALP
C
        ALP=ALPHA(I)
        P=1.0-(ALP/2.0)
        CALL NORPPF(P,APPF)
        ALOWB(I)=SCTEMP - APPF*SCALSE
        AHIGHB(I)=SCTEMP + APPF*SCALSE
        ALOWU(I)=UHATML - APPF*UHATSE
        AHIGHU(I)=UHATML + APPF*UHATSE
C
        CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
        DK=DBLE(APPF)
C
        DXSTRT=DBLE(ALOWB(I))
        DXLOW=DXSTRT/5.0D0
        DXUP=DBLE(SCTEMP)
        CALL DFZER2(EV1FU3,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
        A2LOWB(I)=REAL(DXLOW)
C
        DXSTRT=DBLE(AHIGHB(I))
        DXUP=DXSTRT*5.0D0
        DXLOW=DBLE(SCTEMP)
        CALL DFZER2(EV1FU3,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
        A2HGHB(I)=REAL(DXLOW)
C
        DXSTRT=DBLE(ALOWU(I))
        DXLOW=DXSTRT/2.0D0
        DXUP=DBLE(UHATML)
        CALL DFZER2(EV1FU4,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
        A2LOWU(I)=REAL(DXLOW)
C
        DXSTRT=DBLE(AHIGHU(I))
        DXUP=DXSTRT*2.0D0
        DXLOW=DBLE(UHATML)
        CALL DFZER2(EV1FU4,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
        A2HGHU(I)=REAL(DXLOW)
C
 3120 CONTINUE
C
C               **********************************************
C               **  STEP 41B--                              **
C               **  ESTIMATE CONFIDENCE LIMITS FOR SELECTED **
C               **  PERCENTILES.  THE CONFIDENCE LIMITS ON  **
C               **  SIGMA ARE (SL,SU) ARE:                  **
C               **  (2*N*SIGMAHAT/CHSPPF(2N,1-ALPHA/2),     **
C               **   2*N*SIGMAHAT/CHSPPF(2N,1-ALPHA/2))     **
C               **  THEN (XpLCL,XpUCL) IS:                  **
C               **  ((-LN(1 - Xp))*SL,(-LN(1 - Xp))*SU)     **
C               **********************************************
C
      ISTEPN='41B'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C  NOTE: COMMENTED OUT CODE IS 1-PARAMETER MODEL PLUS ESTIMATE
C        OF LOCATION.  FOR 2-PARAMETER MODEL, USE APPROXIMATION
C        FOR LOWER LIMIT GIVEN ON PP. 190-191 OF BURY.
C
      IF(NPERC.GE.1)THEN
C
        ALP=ALPHAP
        P=1.0-(ALP/2.0)
        CALL NORPPF(P,ANOR)
        CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
        DK=DBLE(APPF)
        SHATML=DBLE(SCALML)
C
        DAE=1.D-7
        DRE=1.D-7
        NUTEMP=1
C
        WRITE(IOUNI2,3131)
 3131   FORMAT(15X,'       POINT     ','   STANDARD    ',
     1         '     LOWER     ','     UPPER')
        WRITE(IOUNI2,3132)
 3132   FORMAT('    PERCENTILE ','     ESTIMATE   ','     ERROR     ',
     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
        DO3130I=1,NPERC
C
          QPTEMP=QP(I)/100.0
          CALL EV1PPF(QPTEMP,MINMAX,APPF)
C
          XQPHAT(I)=UHATML + SCTEMP*APPF
          SEXQP=UHATSE**2 + (APPF*SCALSE)**2 + 2.0*APPF*COVSE**2
          XQPSE(I)=SQRT(SEXQP)
          XQPLCL(I)=XQPHAT(I) - ANOR*XQPSE(I)
          XQPUCL(I)=XQPHAT(I) + ANOR*XQPSE(I)
          WRITE(IOUNI2,'(6E15.7)')
     1         QP(I),XQPHAT(I),SEXQP,XQPLCL(I),XQPUCL(I)
C
          DQ=DBLE(QPTEMP)
          DPPF=DBLE(XQPHAT(I))
          DXSTRT=DBLE(XQPLCL(I))
          DXLOW=DPPF/2.0D0
          DXUP=DBLE(XQPHAT(I))
          CALL DFZER2(EV1FU6,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
          XQPLCZ(I)=REAL(DXLOW)
C
          DXSTRT=DBLE(XQPUCL(I))
          DXUP=DPPF*2.0D0
          DXLOW=DBLE(XQPHAT(I))
          CALL DFZER2(EV1FU6,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
          XQPUCZ(I)=REAL(DXLOW)
C
CCCCC     IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MGU1')THEN
CCCCC       WRITE(ICOUT,3133)I,QP(I),XQPHAT(I),SEXQP,APPF
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,3135)ACHSUL,ACHSLL,ATEMP1,ATEMP2
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,3137)XQPLCL(I),XQPUCL(I)
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC     ENDIF
 3130   CONTINUE
C
      ENDIF
C
C               *************************************
C               **   STEP 42--                     **
C               **   WRITE OUT EVERYTHING          **
C               **   FOR GUMBEL MLE ESTIMATE  **
C               *************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGU1')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5002   FORMAT('<B>GUMBEL MAXIMUM LIKELIHOOD ESTIMATION:')
 5003   FORMAT('<BR>Full Sample ',A7,' Extreme Values Case')
 5004   FORMAT('<BR><BR>f(x) = (1/s)e<sup>-(x-u)/s</sup>e<sup>-e<sup>',
     1         '-(x-u)/s</sup></sup>')
 5005   FORMAT('<BR><BR>f(x) = (1/s)e<sup>(x-u)/s</sup>e<sup>-e<sup>',
     1         '(x-u)/s</sup></sup></B>')
 5006   FORMAT('<BR>u and s denote the location and scale ',
     1         'parameters, respectively</B>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5003)ICASE
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,5004)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,5005)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5006)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5016   FORMAT('      <B>Standard Errors and Confidence Intervals</B>')
 5017   FORMAT('      <B>Based on No Bias Correction Scale ',
     1         'Parameter</B>')
 5018   FORMAT('      <B>Based on Bias Corrected Scale Parameter</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5016)
        CALL DPWRST('XXX','WRIT')
        IF(IGUMBC.EQ.'OFF')THEN
          WRITE(ICOUT,5017)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,5018)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5018)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=400>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Minimum:')
 5063   FORMAT('         Sample Maximum:')
 5064   FORMAT('         Sample Mean:')
 5065   FORMAT('         Sample Standard Deviation:')
 5066   FORMAT('         Moment Estimate of Location:')
 5067   FORMAT('         Standard Error of Moment Estimate of ',
     1         'Location:')
 5068   FORMAT('         Moment Estimate of Scale:')
 5069   FORMAT('         Standard Error of Moment Estimate of Scale:')
 5070   FORMAT('         Maximum Likelihood Estimate of Location:')
 5071   FORMAT('         Standard Error of Maximum Likelihood ',
     1         'Estimate of Location:')
 5072   FORMAT('         Maximum Likelihood Estimate of Scale:')
 5073   FORMAT('         Bias Corrected Maximum Likelihood Estimate ',
     1         'of Scale:')
 5074   FORMAT('         Standard Error of Maximum Likelihood ',
     1         'Estimate of Scale:')
 5075   FORMAT('         Standard Error of Covariance ')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)UHATMO
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)UMOMSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALMO
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCMOSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5070)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)UHATML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)UHATSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5072)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5073)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCA2ML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5074)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5075)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)COVSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Limits for the Scale ',
     1         'Parameter</B>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5134   FORMAT('         &nbsp;')
 5136   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM COLSPAN=2>')
 5137   FORMAT('         Normal Approximation')
 5138   FORMAT('         Likelihood Ratio')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=5>')
55161   FORMAT('      <TD COLSPAN=3>')
 5162   FORMAT('          <HR>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,5136)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5138)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,5129)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5131)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5129)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5133)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,5161)
        ELSE
          WRITE(ICOUT,55161)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        DO5150I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWB(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AHIGHB(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          IF(MINMAX.EQ.2)THEN
            WRITE(ICOUT,5149)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5151)A2LOWB(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5147)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5149)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5151)A2HGHB(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5147)
            CALL DPWRST('XXX','WRIT')
          ENDIF
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5150   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5217   FORMAT('      <B>Confidence Limits for the Location ',
     1         'Parameter</B>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5217)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5136)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5138)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,5129)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5131)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5129)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5133)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,5161)
        ELSE
          WRITE(ICOUT,55161)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
        DO5140I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWU(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AHIGHU(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          IF(MINMAX.EQ.2)THEN
            WRITE(ICOUT,5149)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5151)A2LOWU(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5147)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5149)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5151)A2HGHU(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5147)
            CALL DPWRST('XXX','WRIT')
          ENDIF
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5140   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
 5801     FORMAT('</PRE>')
 5811     FORMAT('<UL>')
 5813     FORMAT('<TABLE NOBORDER>')
 5815     FORMAT('   <CAPTION ALIGN=CENTER>')
 5816     FORMAT('      <BR><B>Alpha = ',F7.3,'</B>')
 5817     FORMAT('      <B>Confidence Limits for Selected ',
     1           'Percentiles (Based on Normal Approximation)</B>')
 5818     FORMAT('      <B>Confidence Limits for Selected ',
     1           'Percentiles (Based on Likelihood Ratio)</B>')
 5819     FORMAT('   </CAPTION>')
C
C  START THE TABLE
C
          WRITE(ICOUT,5801)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          WRITE(ICOUT,5811)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5813)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5815)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5817)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5816)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5819)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5841     FORMAT('   <TR>')
 5843     FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5847     FORMAT('      </TD>')
 5848     FORMAT('      </TH>')
 5849     FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5851     FORMAT('         ',G15.7)
 5859     FORMAT('   </TR>')
 5861     FORMAT('         Percentile')
 5862     FORMAT('         Point <br> Estimate')
 5863     FORMAT('         Standard <br> Error')
 5864     FORMAT('         Lower <br>Confidence Limit')
 5865     FORMAT('         Upper <br>Confidence Limit')
 5870     FORMAT('      <TD COLSPAN=5>')
 5872     FORMAT('         <HR WIDTH=600>')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5861)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5863)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5864)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5865)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5870)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5872)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5847)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          DO55880I=1,NPERC
            WRITE(ICOUT,5841)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)QP(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPHAT(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPSE(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPLCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPUCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5859)
            CALL DPWRST('XXX','WRIT')
55880     CONTINUE
C
C  END THE TABLE AND RESET ASIS MODE
C
          WRITE(ICOUT,5191)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5193)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
C  START THE TABLE
C
          IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,5801)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          WRITE(ICOUT,5811)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5813)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5815)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5818)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5816)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5819)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5970     FORMAT('      <TD COLSPAN=4>')
 5972     FORMAT('         <HR WIDTH=480>')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5861)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5864)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5865)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5970)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5972)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5847)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          DO55980I=1,NPERC
            WRITE(ICOUT,5841)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)QP(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPHAT(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPLCZ(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPUCZ(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5859)
            CALL DPWRST('XXX','WRIT')
55980     CONTINUE
C
C  END THE TABLE AND RESET ASIS MODE
C
          WRITE(ICOUT,5191)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5193)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
        ENDIF
        ENDIF
C
 5899   FORMAT('<PRE>')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5899)
        CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001   FORMAT(A1,'end{verbatim}')
 8003   FORMAT(A1,'begin{table}')
 8004   FORMAT(A1,'end{table}')
 8005   FORMAT('{',A1,'bf Gumbel Maximum Likelihood ',
     1         'Estimation:}')
 8007   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009   FORMAT(A1,'begin{center}')
 8010   FORMAT('{',A1,'bf Full Sample ',A7,' Extreme Values Case}')
88010   FORMAT('{',A1,'bf u and s denote the location and ',
     1         'scale parameters, respectively}')
 8011   FORMAT('{',A1,'bf f(x) = (1/s)*EXP(-(x-u)/s)*',
     1         'EXP(-EXP(-(x-u)/s))}')
88011   FORMAT('{',A1,'bf f(X) = (1/s)*EXP((x-u)/s)*',
     1         'EXP(-EXP((x-u)/s))}')
 8012   FORMAT('{',A1,'bf Standard Errors and Confidence Intervals ',
     1         'Based on Bias Corrected Scale Parameter}')
88012   FORMAT('{',A1,'bf Standard Errors and Confidence Intervals ',
     1         'Based on No Bias Correction Scale Parameter}')
 8013   FORMAT(A1,'end{center}')
 8015   FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8010)IBASLC,ICASE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,8011)IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,88011)IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,88010)IBASLC,ICASE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IGUMBC.EQ.'ON')THEN
          WRITE(ICOUT,8012)IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,88012)IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020   FORMAT(5X,A1,'begin{tabular} {lr}')
 8021   FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022   FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8023   FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8024   FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8025   FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8026   FORMAT(5X,'Moment Estimate of Location: & ',G15.7,2X,A1,A1)
 8027   FORMAT(5X,'Standard Error of Moment Estimate of Location: & ',
     1         G15.7,2X,A1,A1)
 8028   FORMAT(5X,'Moment Estimate of Scale: & ',G15.7,2X,A1,A1)
 8029   FORMAT(5X,'Standard Error of Moment Estimate of Scale: & ',
     1         G15.7,2X,A1,A1)
 8030   FORMAT(5X,'Maximum Likelihood Estimate of Location: & ',
     1         G15.7,2X,A1,A1)
 8031   FORMAT(5X,'Standard Error of ML Estimate of Location: & ',
     1         G15.7,2X,A1,A1)
 8032   FORMAT(5X,'Maximum Likelihood Estimate of Scale: & ',
     1         G15.7,2X,A1,A1)
 8033   FORMAT(5X,'Bias Corrected Maximum Likelihood Estimate of ',
     1         'Scale: & ',G15.7,2X,A1,A1)
 8034   FORMAT(5X,'Standard Error of ML Estimate of Scale: & ',
     1         G15.7,2X,A1,A1)
 8035   FORMAT(5X,'Standard Error of Maximum Likelihood ',
     1         'Covariance: & ',G15.7,2X,A1,A1)
 8039   FORMAT(5X,'  & ',2X,A1,A1)
 8049   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8039)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)UHATMO,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)UMOMSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)SCALMO,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)SCMOSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8039)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)UHATML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)UHATSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)SCALML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8033)SCA2ML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8034)SCALSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8035)COVSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8093   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for Scale Parameter}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8111)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120   FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper & Lower & Upper ',
     1         2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit & Limit & Limit',
     1         2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,' & ',G15.7,' & ',
     1         G15.7,2X,A1,A1)
 8126   FORMAT(5X,'& ',A1,'multicolumn{2}{c}{Normal Approximation}',
     1         ' & ',A1,'multicolumn{2}{c}{Likelihood Ratio}',
     1         2X,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8126)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8130I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWB(I),AHIGHB(I),A2LOWB(I),
     1                     A2HGHB(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8130   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8191   FORMAT(A1,'end{table}')
 8193   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8211 FORMAT(5X,'{',A1,'bf Confidence Limits for Location Parameter}')
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8211)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8126)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8230I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWU(I),AHIGHU(I),A2LOWU(I),
     1                     A2HGHU(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8230   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8191)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C WRITE SELECTED PERCENTILES (IF ANY)
C
        IF(NPERC.GT.0)THEN
C
          CALL DPCONA(92,IBASLC)
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8803)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8810)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8812)IBASLC,IBASLC,ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8813)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8820)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8821)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8822)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,
     1                     IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8840)IBASLC
          CALL DPWRST('XXX','WRIT')
          DO8830I=1,NPERC
            WRITE(ICOUT,8823)QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),
     1                       XQPUCL(I),IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
 8830     CONTINUE
          WRITE(ICOUT,8849)IBASLC
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8891)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8893)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
 8801   FORMAT(A1,'end{verbatim}')
 8803   FORMAT(A1,'begin{table}')
 8807   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8809   FORMAT(A1,'begin{center}')
 8810   FORMAT(5X,'{',A1,'bf Confidence Limits (Normal Approximation)',
     1         'for Selected Percentiles}')
 8812   FORMAT(5X,'{',A1,'bf $',A1,'alpha$ = ',F7.3,'}')
 8813   FORMAT(A1,'end{center}')
 8815   FORMAT(5X,'} ',A1,A1)
 8820   FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8821   FORMAT(5X,' & {',A1,'bf Point} & {',A1,'bf Standard} & {',
     1         A1,'bf Lower} & {',A1,'bf Upper}',2X,A1,A1)
 8822   FORMAT(5X,'{',A1,'bf Percentile} & {',A1,'bf Estimate} & {',
     1         A1,'bf Error} & {',A1,'bf Confidence Limit} & {',
     1         A1,'bf Confidence Limit}',
     1         2X,A1,A1)
 8823   FORMAT(5X,G15.7,' & ',G15.7,' & ',G15.7,' & ',G15.7,
     1         ' & ',G15.7,2X,A1,A1)
 8840   FORMAT(5X,A1,'hline')
 8849   FORMAT(A1,'end{tabular}')
 8891   FORMAT(A1,'end{center}')
 8893   FORMAT(A1,'end{table}')
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8803)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8910)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8812)IBASLC,IBASLC,ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8813)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8920)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8921)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8922)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8840)IBASLC
          CALL DPWRST('XXX','WRIT')
          DO8930I=1,NPERC
            WRITE(ICOUT,8923)QP(I),XQPHAT(I),XQPLCZ(I),
     1                       XQPUCZ(I),IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
 8930     CONTINUE
          WRITE(ICOUT,8849)IBASLC
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8891)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8893)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
 8910   FORMAT(5X,'{',A1,'bf Confidence Limits (Likelihood Ratio)',
     1         'for Selected Percentiles}')
 8920   FORMAT(5X,A1,'begin{tabular} {cccc}')
 8921   FORMAT(5X,' & {',A1,'bf Point} & {',
     1         A1,'bf Lower} & {',A1,'bf Upper}',2X,A1,A1)
 8922   FORMAT(5X,'{',A1,'bf Percentile} & {',A1,'bf Estimate} & {',
     1         A1,'bf Confidence Limit} & {',
     1         A1,'bf Confidence Limit}',
     1         2X,A1,A1)
 8923   FORMAT(5X,G15.7,' & ',G15.7,' & ',G15.7,
     1         ' & ',G15.7,2X,A1,A1)
C
C
 8899   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8899)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4201)
 4201   FORMAT(6X,'GUMBEL MAXIMUM LIKELIHOOD ESTIMATION: ')
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,4205)
 4205     FORMAT(6X,'FULL SAMPLE, MAXIMUM EXTREME VALUES CASE')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4206)
 4206     FORMAT(6X,'f(X) = (1/s)*EXP(-(X-U)/S)*EXP(-EXP(-(X-U)/S))')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4208)
 4208     FORMAT(6X,'FULL SAMPLE, MINIMUM EXTREME VALUES CASE')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4209)
 4209     FORMAT(6X,'F(X) = (1/s)*EXP((X-U)/S)*EXP(-EXP((X-U)/S))')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,4210)
 4210   FORMAT(6X,'U AND S DENOTE THE LOCATION AND SCALE ',
     1         'PARAMETERS, RESPECTIVELY')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(IGUMBC.EQ.'ON')THEN
          WRITE(ICOUT,4211)
 4211     FORMAT(6X,'STANDARD ERRORS AND CONFIDENCE INTERVALS ')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,44211)
44211     FORMAT(6X,'BASED ON BIAS CORRECTED SCALE PARAMETER')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4212)
 4212     FORMAT(6X,'STANDARD ERRORS AND CONFIDENCE INTERVALS ',
     1           'BASED ON NO BIAS CORRECTION SCALE PARAMETER')
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4213)N
 4213   FORMAT('NUMBER OF OBSERVATIONS                          = ',
     1         I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4214)XMIN
 4214   FORMAT('SAMPLE MINIMUM                                  = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4215)XMAX
 4215   FORMAT('SAMPLE MAXIMUM                                  = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4217)XMEAN
 4217   FORMAT('SAMPLE MEAN                                     = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4219)XSD
 4219   FORMAT('SAMPLE STANDARD DEVIATION                       = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4220)UHATMO
 4220   FORMAT('MOMENT ESTIMATE OF LOCATION                     = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)UMOMSE
 4221   FORMAT('STANDARD ERROR OF MOMENT ESTIMATE OF LOCATION   = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4222)SCALMO
 4222   FORMAT('MOMENT ESTIMATE OF SCALE                        = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)SCMOSE
 4223   FORMAT('STANDARD ERROR OF MOMENT ESTIMATE OF SCALE      = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4226)UHATML
 4226   FORMAT('MAXIMUM LIKELIHOOD ESTIMATE OF LOCATION         = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4227)UHATSE
 4227   FORMAT('STANDARD ERROR OF LOCATION ESTIMATE             = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4228)SCALML
 4228   FORMAT('MAXIMUM LIKELIHOOD ESTIMATE OF SCALE            = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4229)SCA2ML
 4229   FORMAT('BIAS CORRECTED ML ESTIMATE OF SCALE             = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4230)SCALSE
 4230   FORMAT('STANDARD ERROR OF SCALE ESTIMATE                = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4231)COVSE
 4231   FORMAT('STANDARD ERROR OF COVARIANCE                    = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4241)
 4241   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,4242)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4243)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4245)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4246)
          CALL DPWRST('XXX','WRIT')
          DO4249I=1,NUMALP
            ATEMP=100.0*(1.0 - ALPHA(I))
            WRITE(ICOUT,4247)ATEMP,ALOWB(I),AHIGHB(I),A2LOWB(I),
     1                       A2HGHB(I)
 4247       FORMAT('   ',F8.3,10X,4(G12.6,2X))
            CALL DPWRST('XXX','WRIT')
 4249     CONTINUE
        ELSE
          WRITE(ICOUT,44242)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,44243)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,44245)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,44246)
          CALL DPWRST('XXX','WRIT')
          DO44249I=1,NUMALP
            ATEMP=100.0*(1.0 - ALPHA(I))
            WRITE(ICOUT,44247)ATEMP,ALOWB(I),AHIGHB(I)
44247       FORMAT('   ',F8.3,10X,2(G12.6,2X))
            CALL DPWRST('XXX','WRIT')
44249     CONTINUE
        ENDIF
 4242   FORMAT('                       NORMAL APPROXIMATION',
     1         '            LIKELIHOOD RATIO')
44242   FORMAT('                       NORMAL APPROXIMATION')
 4243   FORMAT('   CONFIDENCE           LOWER         UPPER     ',
     1         '    LOWER         UPPER')
44243   FORMAT('   CONFIDENCE           LOWER         UPPER     ')
 4245   FORMAT('   VALUE (%)            LIMIT         LIMIT     ',
     1         '    LIMIT         LIMIT')
44245   FORMAT('   VALUE (%)            LIMIT         LIMIT     ')
 4246   FORMAT('-------------------------------------------',
     1         '----------------------------')
44246   FORMAT('-------------------------------------------')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4252)
 4252   FORMAT('CONFIDENCE INTERVAL FOR LOCATION PARAMETER')
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,4242)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4243)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4245)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4246)
          CALL DPWRST('XXX','WRIT')
          DO4259I=1,NUMALP
            ATEMP=100.0*(1.0 - ALPHA(I))
            WRITE(ICOUT,4247)ATEMP,ALOWU(I),AHIGHU(I),A2LOWU(I),
     1                       A2HGHU(I)
            CALL DPWRST('XXX','WRIT')
 4259     CONTINUE
        ELSE
          WRITE(ICOUT,44242)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,44243)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,44245)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,44246)
          CALL DPWRST('XXX','WRIT')
          DO44259I=1,NUMALP
            ATEMP=100.0*(1.0 - ALPHA(I))
            WRITE(ICOUT,44247)ATEMP,ALOWU(I),AHIGHU(I)
            CALL DPWRST('XXX','WRIT')
44259     CONTINUE
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,4911)
 4911     FORMAT('CONFIDENCE LIMITS FOR SELECTED PERCENTILES')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4912)
 4912     FORMAT('(BASED ON NORMAL APPROXIMATION):')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4915)ALPHAP
 4915     FORMAT('ALPHA = ',F7.4)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4921)
4921      FORMAT(10X,'       POINT     ','   STANDARD    ',
     1          '       LOWER     ','      UPPER     ')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4922)
4922      FORMAT('PERCENTILE','     ESTIMATE   ','     ERROR    ',
     1           ' CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,44916)
44916     FORMAT('---------------',
     1           '-----------------------------------',
     1           '------------------------')
          CALL DPWRST('XXX','WRIT')
C
          DO4931I=1,NPERC
            WRITE(ICOUT,4932)QP(I),XQPHAT(I),XQPSE(I),
     1                       XQPLCL(I),XQPUCL(I)
 4932       FORMAT(F10.4,2G15.7,2G17.7)
            CALL DPWRST('XXX','WRIT')
 4931     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
          IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,4911)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4962)
 4962     FORMAT('(BASED ON LIKELIHOOD RATIO):')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4915)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4971)
4971      FORMAT(10X,'      POINT      ',
     1          '     LOWER     ','       UPPER')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4972)
4972      FORMAT('PERCENTILE','   ESTIMATE    ',
     1           ' CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,44976)
44976     FORMAT('---------------',
     1           '--------------------',
     1           '------------------------')
          CALL DPWRST('XXX','WRIT')
C
          DO4981I=1,NPERC
            WRITE(ICOUT,4982)QP(I),XQPHAT(I),XQPLCZ(I),XQPUCZ(I)
 4982       FORMAT(F10.4,G15.7,2G17.7)
            CALL DPWRST('XXX','WRIT')
 4981     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        ENDIF
C
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,4251)
 4251     FORMAT('THE FOLLOWING INTERNAL PARAMETERS WILL BE SAVED:')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4253)
 4253     FORMAT('UHATML, UHATSE, UHATMOM, UMOMSE, SCALEML, SCAEMLBC, ',
     1           'SCALEMOM,SCMOSE, COVSE')
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IF(IFEEDB.EQ.'ON')THEN
          IF(NPERC.GT.0)THEN
            WRITE(ICOUT,4943)
 4943       FORMAT('PERCENTILE CONFIDENCE LIMITS BASED ON NORMAL ')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4945)
 4945       FORMAT('APPROXIMATION WRITTEN TO FILE  dpst1f.dat')
            CALL DPWRST('XXX','BUG ')
          ENDIF
        ENDIF
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGU1')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPPGU1--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMIN(ICOM,IHARG,IARGT,ARG,NUMARG,
     1GX1MIN,GY1MIN,
     1GX2MIN,GY2MIN,
     1IX1MIN,IY1MIN,
     1IX2MIN,IY2MIN,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE AXIS MINIMA
C              (HORIZONTAL AXIS OR VERTICAL AXIS OR BOTH)
C              WHICH IN TURN WILL DEFINE THE LOWER EXTREME
C              WHICH WILL APPEAR ON THE PLOT.
C              THE MINIMA WILL BE PLACED IN THE 4 VARIABLES
C              GX1MIN,GY1MIN,
C              GX2MIN,GY2MIN,
C              THE STATUS (FIXED OR FLOAT) WILL BE PLACED
C              IN THE 4 VARIABLES
C              IX1MIN,IY1MIN,
C              IX2MIN,IY2MIN,
C     INPUT  ARGUMENTS--ICOM  (A  HOLLERITH VARIABLE)
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--
C                     --GX1MIN = MINIMUM FOR BOTTOM HORIZONTAL AXIS
C                     --GY1MIN = MINIMUM FOR LEFT   VERTICAL   AXIS
C                     --GX2MIN = MINIMUM FOR TOP    HORIZONTAL AXIS
C                     --GX2MIN = MINIMUM FOR RIGHT  VERTICAL   AXIS
C                     --IX1MIN = STATUS FOR MINIMUM FOR BOTTOM HORIZONTAL AXIS
C                     --IY1MIN = STATUS FOR MINIMUM FOR LEFT   VERTICAL   AXIS
C                     --IX2MIN = STATUS FOR MINIMUM FOR TOP    HORIZONTAL AXIS
C                     --IX2MIN = STATUS FOR MINIMUM FOR RIGHT  VERTICAL   AXIS
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1978.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --FEBRUARY 1992.  FIX YMIN WITH NO ARG BOMB
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IX1MIN
      CHARACTER*4 IY1MIN
      CHARACTER*4 IX2MIN
      CHARACTER*4 IY2MIN
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
CCCCC THE FOLLOWING LINE WAS FIXED FEBRUARY 1992
CCCCC IF(IHARG(NUMARG).EQ.'?')GOTO8100
      IF(NUMARG.LE.0)GOTO1090
      IF(IHARG(NUMARG).EQ.'?')GOTO8100
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                           **
C               **  BOTH HORIZONTAL AXIS MINIMA ARE TO BE FIXED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XMIN')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(NUMARG.LE.0)GOTO1110
      IF(IARGT(1).EQ.'NUMB')GOTO1120
      GOTO1110
C
 1110 CONTINUE
      IFOUND='YES'
      GX1MIN=CPUMIN
      GX2MIN=CPUMIN
      IX1MIN='FLOA'
      IX2MIN='FLOA'
 1113 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)
 1115 FORMAT('THE X AXIS MINIMUM (FOR BOTH HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1116)
 1116 FORMAT('FRAME LINES) HAS JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1117)
 1117 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO9000
C
 1120 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      GX1MIN=A1
      GX2MIN=A1
      IX1MIN='FIXE'
      IX2MIN='FIXE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('THE X AXIS MINIMUM (FOR BOTH HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)GX1MIN
 1126 FORMAT('FRAME LINES) HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO9000
C
 1199 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN THE                        **
C               **  BOTTOM HORIZONTAL AXIS MINIMUM ARE TO BE FIXED  **
C               *****************************************************
C
      IF(ICOM.EQ.'X1MI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(NUMARG.LE.0)GOTO1210
      IF(IARGT(1).EQ.'NUMB')GOTO1220
      GOTO1210
C
 1210 CONTINUE
      IFOUND='YES'
      GX1MIN=CPUMIN
      IX1MIN='FLOA'
 1213 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1219
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('THE X AXIS MINIMUM (FOR THE BOTTOM HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('FRAME LINE) HAS JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)
 1217 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1219 CONTINUE
      GOTO9000
C
 1220 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      GX1MIN=A1
      IX1MIN='FIXE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1229
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1225)
 1225 FORMAT('THE X AXIS MINIMUM (FOR THE BOTTOM HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1226)GX1MIN
 1226 FORMAT('FRAME LINE) HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1229 CONTINUE
      GOTO9000
C
 1299 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN THE                        **
C               **  TOP    HORIZONTAL AXIS MINIMUM ARE TO BE FIXED  **
C               *****************************************************
C
      IF(ICOM.EQ.'X2MI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(NUMARG.LE.0)GOTO1310
      IF(IARGT(1).EQ.'NUMB')GOTO1320
      GOTO1310
C
 1310 CONTINUE
      IFOUND='YES'
      GX2MIN=CPUMIN
      IX2MIN='FLOA'
 1313 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1315)
 1315 FORMAT('THE X AXIS MINIMUM (FOR THE TOP    HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1316)
 1316 FORMAT('FRAME LINE) HAS JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1317)
 1317 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      GOTO9000
C
 1320 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      GX2MIN=A1
      IX2MIN='FIXE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1329
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1325)
 1325 FORMAT('THE X AXIS MINIMUM (FOR THE TOP    HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1326)GX2MIN
 1326 FORMAT('FRAME LINE) HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1329 CONTINUE
      GOTO9000
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                           **
C               **  BOTH VERTICAL   AXIS MINIMUM ARE TO BE FIXED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YMIN')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(NUMARG.LE.0)GOTO1410
      IF(IARGT(1).EQ.'NUMB')GOTO1420
      GOTO1410
C
 1410 CONTINUE
      IFOUND='YES'
      GY1MIN=CPUMIN
      GY2MIN=CPUMIN
      IY1MIN='FLOA'
      IY2MIN='FLOA'
 1413 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1419
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)
 1415 FORMAT('THE Y AXIS MINIMUM (FOR BOTH VERTICAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1416)
 1416 FORMAT('FRAME LINES) HAS JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1417)
 1417 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1419 CONTINUE
      GOTO9000
C
 1420 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      GY1MIN=A1
      GY2MIN=A1
      IY1MIN='FIXE'
      IY2MIN='FIXE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1429
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1425)
 1425 FORMAT('THE Y AXIS MINIMUM (FOR BOTH VERTICAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1426)GY1MIN
 1426 FORMAT('FRAME LINES) HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1429 CONTINUE
      GOTO9000
C
 1499 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN THE                        **
C               **  LEFT   VERTICAL   AXIS MINIMUM ARE TO BE FIXED  **
C               *****************************************************
C
      IF(ICOM.EQ.'Y1MI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(NUMARG.LE.0)GOTO1510
      IF(IARGT(1).EQ.'NUMB')GOTO1520
      GOTO1510
C
 1510 CONTINUE
      IFOUND='YES'
      GY1MIN=CPUMIN
      IY1MIN='FLOA'
 1513 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1519
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1515)
 1515 FORMAT('THE Y AXIS MINIMUM (FOR THE LEFT   VERTICAL  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1516)
 1516 FORMAT('FRAME LINE) HAS JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1517)
 1517 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1519 CONTINUE
      GOTO9000
C
 1520 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      GY1MIN=A1
      IY1MIN='FIXE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1529
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1525)
 1525 FORMAT('THE Y AXIS MINIMUM (FOR THE LEFT   VERTICAL  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1526)GY1MIN
 1526 FORMAT('FRAME LINE) HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1529 CONTINUE
      GOTO9000
C
 1599 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN THE                        **
C               **  RIGHT  VERTICAL   AXIS MINIMUM ARE TO BE FIXED  **
C               *****************************************************
C
      IF(ICOM.EQ.'Y2MI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(NUMARG.LE.0)GOTO1610
      IF(IARGT(1).EQ.'NUMB')GOTO1620
      GOTO1610
C
 1610 CONTINUE
      IFOUND='YES'
      GY2MIN=CPUMIN
      IY2MIN='FLOA'
 1613 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1619
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1615)
 1615 FORMAT('THE Y AXIS MINIMUM (FOR THE RIGHT  VERTICAL  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1616)
 1616 FORMAT('FRAME LINE) HAS JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1617)
 1617 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1619 CONTINUE
      GOTO9000
C
 1620 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      GY2MIN=A1
      IY2MIN='FIXE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1629
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1625)
 1625 FORMAT('THE Y AXIS MINIMUM (FOR THE RIGHT  VERTICAL  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1626)GY2MIN
 1626 FORMAT('FRAME LINE) HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1629 CONTINUE
      GOTO9000
C
 1699 CONTINUE
C
C               ******************************************
C               **  TREAT THE CASE WHEN                 **
C               **  BOTH AXIS MINIMUM ARE TO BE FIXED    **
C               ******************************************
C
C
      IF(ICOM.EQ.'XYMI')GOTO1700
      IF(ICOM.EQ.'YXMI')GOTO1700
      IF(ICOM.EQ.'MINI')GOTO1700
      IF(ICOM.EQ.'MIN ')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(NUMARG.LE.0)GOTO1710
      IF(IARGT(1).EQ.'NUMB')GOTO1720
      GOTO1710
C
 1710 CONTINUE
      IFOUND='YES'
      GX1MIN=CPUMIN
      GY1MIN=CPUMIN
      GX2MIN=CPUMIN
      GY2MIN=CPUMIN
      IX1MIN='FLOA'
      IY1MIN='FLOA'
      IX2MIN='FLOA'
      IY2MIN='FLOA'
 1713 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1719
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1715)
 1715 FORMAT('THE X AXIS MINIMUM (FOR ALL 4')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1716)
 1716 FORMAT('FRAME LINES) HAS JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1717)
 1717 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1719 CONTINUE
      GOTO9000
C
 1720 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      GX1MIN=A1
      GY1MIN=A1
      GX2MIN=A1
      GY2MIN=A1
      IX1MIN='FIXE'
      IY1MIN='FIXE'
      IX2MIN='FIXE'
      IY2MIN='FIXE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1729
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1725)
 1725 FORMAT('THE AXIS MINIMUM (FOR ALL 4')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1726)GX1MIN
 1726 FORMAT('FRAME LINES) HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1729 CONTINUE
      GOTO9000
C
 1799 CONTINUE
      GOTO9000
C
C               ********************************************
C               **  STEP 81--                             **
C               **  TREAT THE    ?    CASE--              **
C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
C               ********************************************
C
 8100 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8111)
 8111 FORMAT('THE CURRENT AXIS MINIMA ARE ')
      CALL DPWRST('XXX','BUG ')
      IF(IX1MIN.NE.'FLOA')WRITE(ICOUT,8112)GX1MIN
 8112 FORMAT('            --X1 (BOTTOM HORIZONTAL) = ',E15.7)
      IF(IX1MIN.NE.'FLOA')CALL DPWRST('XXX','BUG ')
      IF(IX1MIN.EQ.'FLOA')WRITE(ICOUT,8113)
 8113 FORMAT('            --X1 (BOTTOM HORIZONTAL) = FLOAT & NEAT')
      IF(IX1MIN.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
      IF(IX2MIN.NE.'FLOA')WRITE(ICOUT,8114)GX2MIN
 8114 FORMAT('            --X2 (TOP    HORIZONTAL) = ',E15.7)
      IF(IX2MIN.NE.'FLOA')CALL DPWRST('XXX','BUG ')
      IF(IX2MIN.EQ.'FLOA')WRITE(ICOUT,8115)
 8115 FORMAT('            --X2 (TOP    HORIZONTAL) = FLOAT & NEAT')
      IF(IX2MIN.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
      IF(IY1MIN.NE.'FLOA')WRITE(ICOUT,8116)GY1MIN
 8116 FORMAT('            --Y1 (LEFT   VERTICAL  ) = ',E15.7)
      IF(IY1MIN.NE.'FLOA')CALL DPWRST('XXX','BUG ')
      IF(IY1MIN.EQ.'FLOA')WRITE(ICOUT,8117)
 8117 FORMAT('            --Y1 (LEFT   VERTICAL  ) = FLOAT & NEAT')
      IF(IY1MIN.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
      IF(IY2MIN.NE.'FLOA')WRITE(ICOUT,8118)GY2MIN
 8118 FORMAT('            --Y2 (RIGHT  VERTICAL  ) = ',E15.7)
      IF(IY2MIN.NE.'FLOA')CALL DPWRST('XXX','BUG ')
      IF(IY2MIN.EQ.'FLOA')WRITE(ICOUT,8119)
 8119 FORMAT('            --Y2 (RIGHT  VERTICAL  ) = FLOAT & NEAT')
      IF(IY2MIN.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8121)
 8121 FORMAT('THE DEFAULT AXIS MINIMA ARE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8122)
 8122 FORMAT('            --X1 (BOTTOM HORIZONTAL) = FLOAT & NEAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8123)
 8123 FORMAT('            --X2 (TOP    HORIZONTAL) = FLOAT & NEAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8124)
 8124 FORMAT('            --Y1 (LEFT   VERTICAL  ) = FLOAT & NEAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8125)
 8125 FORMAT('            --Y2 (BOTTOM VERTICAL  ) = FLOAT & NEAT')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPMITN(IHARG,IARGT,IARG,NUMARG,
     1IX1NSW,IX2NSW,IY1NSW,IY2NSW,
     1NMNX1T,NMNX2T,NMNY1T,NMNY2T,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE NUMBER OF MINOR TIC MARKS
C              FOR HORIZONTAL FRAME LINES OR VERTICAL FRAME LINES OR BOTH.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARG   (AN INTEGER VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--
C                     --IX1NSW (A CHARACTER VARIABLE)
C                     --IX2NSW (A CHARACTER VARIABLE)
C                     --IY1NSW (A CHARACTER VARIABLE)
C                     --IY2NSW (A CHARACTER VARIABLE)
C                     --NMNX1T (AN INTEGER VARIABLE)
C                     --NMNX2T (AN INTEGER VARIABLE)
C                     --NMNY1T (AN INTEGER VARIABLE)
C                     --NMNY2T (AN INTEGER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IX1NSW
      CHARACTER*4 IX2NSW
      CHARACTER*4 IY1NSW
      CHARACTER*4 IY2NSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'XTIC')GOTO1100
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'X1TI')GOTO1200
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'X2TI')GOTO1300
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'YTIC')GOTO1400
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'Y1TI')GOTO1500
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'Y2TI')GOTO1600
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'TIC')GOTO1700
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'TICS')GOTO1700
      GOTO9000
C
C               ********************************************************
C               **  STEP 1--
C               **  TREAT THE CASE WHEN
C               **  ONLY THE HORIZONTAL MINOR TICS ARE TO BE CHANGED
C               ********************************************************
C
 1100 CONTINUE
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1110
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1110
C
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1101)
 1101 FORMAT('***** ERROR IN DPMITN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1102)
 1102 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1103)
 1103 FORMAT('      NUMBER OF MINOR (HORIZONTAL) TIC MARKS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1104)
 1104 FORMAT('      EXAMPLE TO SPECIFY 3 MINOR TIC MARKS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1105)
 1105 FORMAT('      (ON THE HORIZONTAL FRAME LINES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1106)
 1106 FORMAT('      MINOR XTIC MARK NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1107)
 1107 FORMAT('      MINOR XTICS NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      IERROR='YES'
      GOTO9000
C
 1150 CONTINUE
      IHHOLD='FLOA'
      IHOLD=(-1)
      GOTO1180
C
 1160 CONTINUE
      IHHOLD='FIXE'
      IHOLD=IARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1NSW=IHHOLD
      IX2NSW=IHHOLD
      NMNX1T=IHOLD
      NMNX2T=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE NUMBER OF MINOR TIC MARKS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)
 1182 FORMAT('(FOR BOTH HORIZONTAL FRAME LINES')
      CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1183)IHOLD
 1183 FORMAT('HAS JUST BEEN SET TO ',I8)
      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1184)
 1184 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
 1190 CONTINUE
C
C               ********************************************************
C               **  STEP 2--
C               **  TREAT THE CASE WHEN
C               **  ONLY THE BOTTOM HORIZONTAL MINOR TICS ARE TO BE CHANGED
C               ********************************************************
C
 1200 CONTINUE
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1210
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1210
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1201)
 1201 FORMAT('***** ERROR IN DPMITN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1202)
 1202 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1203)
 1203 FORMAT('      NUMBER OF MINOR (HORIZONTAL) TIC MARKS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1204)
 1204 FORMAT('      EXAMPLE TO SPECIFY 3 MINOR TIC MARKS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1205)
 1205 FORMAT('      (ON THE BOTTOM HORIZONTAL FRAME LINES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1206)
 1206 FORMAT('      MINOR X1TIC MARK NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1207)
 1207 FORMAT('      MINOR X1TICS NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1210 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1250
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1260
      IERROR='YES'
      GOTO9000
C
 1250 CONTINUE
      IHHOLD='FLOA'
      IHOLD=(-1)
      GOTO1280
C
 1260 CONTINUE
      IHHOLD='FIXE'
      IHOLD=IARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX1NSW=IHHOLD
      NMNX1T=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE NUMBER OF MINOR TIC MARKS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)
 1282 FORMAT('(FOR THE BOTTOM HORIZONTAL FRAME LINE')
      CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1283)IHOLD
 1283 FORMAT('HAS JUST BEEN SET TO ',I8)
      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1284)
 1284 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO9000
 1290 CONTINUE
C
C               ********************************************************
C               **  STEP 3--
C               **  TREAT THE CASE WHEN
C               **  ONLY THE TOP    HORIZONTAL MINOR TICS ARE TO BE CHANGED
C               ********************************************************
C
 1300 CONTINUE
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1310
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1310
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1301)
 1301 FORMAT('***** ERROR IN DPMITN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1302)
 1302 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1303)
 1303 FORMAT('      NUMBER OF MINOR (HORIZONTAL) TIC MARKS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1304)
 1304 FORMAT('      EXAMPLE TO SPECIFY 3 MINOR TIC MARKS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1305)
 1305 FORMAT('      (ON THE TOP HORIZONTAL FRAME LINES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1306)
 1306 FORMAT('      MINOR X2TIC MARK NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1307)
 1307 FORMAT('      MINOR X2TICS NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1310 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1350
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1360
      IERROR='YES'
      GOTO9000
C
 1350 CONTINUE
      IHHOLD='FLOA'
      IHOLD=(-1)
      GOTO1380
C
 1360 CONTINUE
      IHHOLD='FIXE'
      IHOLD=IARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX2NSW=IHHOLD
      NMNX2T=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE NUMBER OF MINOR TIC MARKS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)
 1382 FORMAT('(FOR THE TOP HORIZONTAL FRAME LINE')
      CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1383)IHOLD
 1383 FORMAT('HAS JUST BEEN SET TO ',I8)
      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1384)
 1384 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO9000
 1390 CONTINUE
C
C               ********************************************************
C               **  STEP 4--
C               **  TREAT THE CASE WHEN
C               **  ONLY THE VERTICAL    MINOR TICS ARE TO BE CHANGED
C               ********************************************************
C
 1400 CONTINUE
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1410
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1410
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1401)
 1401 FORMAT('***** ERROR IN DPMITN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1402)
 1402 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1403)
 1403 FORMAT('      NUMBER OF MINOR (VERTICAL) TIC MARKS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1404)
 1404 FORMAT('      EXAMPLE TO SPECIFY 3 MINOR TIC MARKS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1405)
 1405 FORMAT('      (ON THE VERTICAL FRAME LINES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1406)
 1406 FORMAT('      MINOR YTIC MARK NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1407)
 1407 FORMAT('      MINOR YTICS NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1410 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1450
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1460
      IERROR='YES'
      GOTO9000
C
 1450 CONTINUE
      IHHOLD='FLOA'
      IHOLD=(-1)
      GOTO1480
C
 1460 CONTINUE
      IHHOLD='FIXE'
      IHOLD=IARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1NSW=IHHOLD
      IY2NSW=IHHOLD
      NMNY1T=IHOLD
      NMNY2T=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE NUMBER OF MINOR TIC MARKS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)
 1482 FORMAT('(FOR BOTH VERTICAL FRAME LINES')
      CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1483)IHOLD
 1483 FORMAT('HAS JUST BEEN SET TO ',I8)
      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1484)
 1484 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO9000
 1490 CONTINUE
C
C               ********************************************************
C               **  STEP 5--
C               **  TREAT THE CASE WHEN
C               **  ONLY THE LEFT VERTICAL MINOR TICS ARE TO BE CHANGED
C               ********************************************************
C
 1500 CONTINUE
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1510
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1510
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1501)
 1501 FORMAT('***** ERROR IN DPMITN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1502)
 1502 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1503)
 1503 FORMAT('      NUMBER OF MINOR (VERTICAL) TIC MARKS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1504)
 1504 FORMAT('      EXAMPLE TO SPECIFY 3 MINOR TIC MARKS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1505)
 1505 FORMAT('      (ON THE LEFT VERTICAL FRAME LINES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1506)
 1506 FORMAT('      MINOR Y1TIC MARK NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1507)
 1507 FORMAT('      MINOR Y1TICS NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1510 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1550
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1560
      IERROR='YES'
      GOTO9000
C
 1550 CONTINUE
      IHHOLD='FLOA'
      IHOLD=(-1)
      GOTO1580
C
 1560 CONTINUE
      IHHOLD='FIXE'
      IHOLD=IARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY1NSW=IHHOLD
      NMNY1T=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE NUMBER OF MINOR TIC MARKS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)
 1582 FORMAT('(FOR THE LEFT VERTICAL FRAME LINE')
      CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1583)IHOLD
 1583 FORMAT('HAS JUST BEEN SET TO ',I8)
      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1584)
 1584 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO9000
 1590 CONTINUE
C
C               ********************************************************
C               **  STEP 6--
C               **  TREAT THE CASE WHEN
C               **  ONLY THE RIGHT VERTICAL MINOR TICS ARE TO BE CHANGED
C               ********************************************************
C
 1600 CONTINUE
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1610
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1610
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1601)
 1601 FORMAT('***** ERROR IN DPMITN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1602)
 1602 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1603)
 1603 FORMAT('      NUMBER OF MINOR (VERTICAL) TIC MARKS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1604)
 1604 FORMAT('      EXAMPLE TO SPECIFY 3 MINOR TIC MARKS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1605)
 1605 FORMAT('      (ON THE RIGHT VERTICAL FRAME LINES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1606)
 1606 FORMAT('      MINOR Y2TIC MARK NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1607)
 1607 FORMAT('      MINOR Y2TICS NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1610 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1650
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1660
      IERROR='YES'
      GOTO9000
C
 1650 CONTINUE
      IHHOLD='FLOA'
      IHOLD=(-1)
      GOTO1680
C
 1660 CONTINUE
      IHHOLD='FIXE'
      IHOLD=IARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY2NSW=IHHOLD
      NMNY2T=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE NUMBER OF MINOR TIC MARKS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)
 1682 FORMAT('(FOR THE RIGHT VERTICAL FRAME LINE')
      CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1683)IHOLD
 1683 FORMAT('HAS JUST BEEN SET TO ',I8)
      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1684)
 1684 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO9000
 1690 CONTINUE
C
C               ********************************************************
C               **  STEP 7--
C               **  TREAT THE CASE WHEN
C               **  BOTH HORIZONTAL AND VERTICAL    MINOR TICS ARE TO BE
C               ********************************************************
C
 1700 CONTINUE
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1710
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1710
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1701)
 1701 FORMAT('***** ERROR IN DPMITN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1702)
 1702 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1703)
 1703 FORMAT('      NUMBER OF MINOR TIC MARKS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1704)
 1704 FORMAT('      EXAMPLE TO SPECIFY 3 MINOR TIC MARKS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1705)
 1705 FORMAT('      (ON ALL 4 FRAME LINES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1706)
 1706 FORMAT('      MINOR TIC MARK NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1707)
 1707 FORMAT('      MINOR TICS NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1710 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1750
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1760
      IERROR='YES'
      GOTO9000
C
 1750 CONTINUE
      IHHOLD='FLOA'
      IHOLD=(-1)
      GOTO1780
C
 1760 CONTINUE
      IHHOLD='FIXE'
      IHOLD=IARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IX1NSW=IHHOLD
      IX2NSW=IHHOLD
      IY1NSW=IHHOLD
      IY2NSW=IHHOLD
      NMNX1T=IHOLD
      NMNX2T=IHOLD
      NMNY1T=IHOLD
      NMNY2T=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE NUMBER OF MINOR TIC MARKS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)
 1782 FORMAT('(FOR EACH FRAME LINES')
      CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1783)IHOLD
 1783 FORMAT('HAS JUST BEEN SET TO ',I8)
      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1784)
 1784 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO9000
 1790 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPMJTC(ICOM,IHARG,IARGT,ARG,NUMARG,
     1IX1TSW,IX2TSW,IY1TSW,IY2TSW,
     1X1COOR,X2COOR,Y1COOR,Y2COOR,
     1NX1COO,NX2COO,NY1COO,NY2COO,
     1MAXTIC,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE MAJOR TIC MARK COORDINATES
C              FOR ANY OF THE 4 FRAME LINES.
C              THE MAJOR TIC MARK COORDINATES ARE GIVEN IN UNITS
C              OF THE PLOTTED DATA.
C     ALSO, A SECONDARY PURPOSE IS TO ADJUST ACCORDINGLY
C              THE TIC MARK SWITCHES
C              FOR ANY OF THE 4 FRAME LINES.
C              SUCH TIC MARK SWITCHES TURN ON OR OFF
C              THE TIC MARKS ON THE 4 FRAME LINES OF A PLOT.
C              THE CONTENTS OF A TIC MARK SWITCH ARE
C              ON   OR    OFF
C              THE TIC MARK SWITCHES DEFINE WHETHER
C              THE TIC MARKS FOR A GIVEN FRAME SHOULD
C              BE ON (THAT IS, APPEAR), OR BE OFF (THAT IS,
C              BE SUPPRESSED.
C              THE TIC MARK SWITCHES FOR THE 4 FRAME LINES
C              ARE CONTAINED IN THE 4 VARIABLES
C              IX1TSW,IX2TSW,IY1TSW,IY2TSW,
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C                     --MAXTIC
C     OUTPUT ARGUMENTS--
C                     --IX1TSW,IX2TSW,IY1TSW,IY2TSW,
C                     --X1COOR,X2COOR,Y1COOR,Y2COOR,
C                     --NX1COO,NX2COO,NY1COO,NY2COO,
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IX1TSW
      CHARACTER*4 IX2TSW
      CHARACTER*4 IY1TSW
      CHARACTER*4 IY2TSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION X1COOR(*)
      DIMENSION X2COOR(*)
      DIMENSION Y1COOR(*)
      DIMENSION Y2COOR(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ILOCC=0
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COOR')ILOCC=1
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'COOR')ILOCC=2
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'COOR')ILOCC=3
      ILOCCP=ILOCC+1
      IF(ILOCC.EQ.0)GOTO1900
C
C               *****************************************************
C               **  TREAT THE CASE WHEN MAJOR TIC MARK COORDINATES ON    **
C               **  BOTH HORIZONTAL FRAME LINES ARE TO BE DEFINED  **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(ILOCC.EQ.NUMARG)GOTO1110
      IF(IHARG(ILOCCP).EQ.'ON')GOTO1110
      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1120
      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1110
      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1110
      GOTO1130
C
 1110 CONTINUE
      IFOUND='YES'
      IX1TSW='ON'
      IX2TSW='ON'
      NX1COO=-1
      NX2COO=-1
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)
 1115 FORMAT('THE MAJOR TIC MARK COORDINATES (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1116)
 1116 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO1900
C
 1120 CONTINUE
      IFOUND='YES'
      IX1TSW='OFF'
      IX2TSW='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('THE MAJOR TIC MARK COORDINATES (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('HAVE JUST BEEN TURNED OFF ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('(THUS NO MAJOR TIC MARKS WILL APPEAR ON THEM')
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO1900
C
 1130 CONTINUE
      IX1TSW='ON'
      IX2TSW='ON'
C
      J=0
      DO1131I=ILOCCP,NUMARG
      J=J+1
      IF(J.GT.MAXTIC)GOTO1800
      IF(IARGT(I).NE.'NUMB')GOTO1850
      X1COOR(J)=ARG(I)
      X2COOR(J)=ARG(I)
 1131 CONTINUE
      IFOUND='YES'
      NX1COO=J
      NX2COO=J
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('THE MAJOR TIC MARK COORDINATES (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN MAJOR TIC MARK COORDINATES ON
C               **  ONLY THE BOTTOM HORIZONTAL FRAME LINE ARE TO BE DEFINED **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
C
 1200 CONTINUE
      IF(ILOCC.EQ.NUMARG)GOTO1210
      IF(IHARG(ILOCCP).EQ.'ON')GOTO1210
      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1220
      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1210
      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1210
      GOTO1230
C
 1210 CONTINUE
      IFOUND='YES'
      IX1TSW='ON'
      NX1COO=-1
C
      IF(IFEEDB.EQ.'OFF')GOTO1219
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('THE TIC COORDINATES (FOR THE BOTTOM HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
      CALL DPWRST('XXX','BUG ')
 1219 CONTINUE
      GOTO1900
C
 1220 CONTINUE
      IFOUND='YES'
      IX1TSW='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1229
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1225)
 1225 FORMAT('THE TIC COORDINATES (FOR THE BOTTOM HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1226)
 1226 FORMAT('HAVE JUST BEEN TURNED OFF ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1227)
 1227 FORMAT('(THUS NO MAJOR TIC MARKS WILL APPEAR ON IT)')
      CALL DPWRST('XXX','BUG ')
 1229 CONTINUE
      GOTO1900
C
 1230 CONTINUE
      IX1TSW='ON'
C
      J=0
      DO1231I=ILOCCP,NUMARG
      J=J+1
      IF(J.GT.MAXTIC)GOTO1800
      IF(IARGT(I).NE.'NUMB')GOTO1850
      X1COOR(J)=ARG(I)
 1231 CONTINUE
      IFOUND='YES'
      NX1COO=J
C
      IF(IFEEDB.EQ.'OFF')GOTO1239
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1235)
 1235 FORMAT('THE TIC COORDINATES (FOR THE BOTTOM HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1236)
 1236 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
      CALL DPWRST('XXX','BUG ')
 1239 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN MAJOR TIC MARK COORDINATES ON
C               **  ONLY THE TOP    HORIZONTAL FRAME LINE ARE TO BE DEFINED **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(ILOCC.EQ.NUMARG)GOTO1310
      IF(IHARG(ILOCCP).EQ.'ON')GOTO1310
      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1320
      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1310
      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1310
      GOTO1330
C
 1310 CONTINUE
      IFOUND='YES'
      IX2TSW='ON'
      NX2COO=-1
C
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1315)
 1315 FORMAT('THE TIC COORDINATES (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1316)
 1316 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      GOTO1900
C
 1320 CONTINUE
      IFOUND='YES'
      IX2TSW='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1329
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1325)
 1325 FORMAT('THE TIC COORDINATES (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1326)
 1326 FORMAT('HAVE JUST BEEN TURNED OFF ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1327)
 1327 FORMAT('(THUS NO MAJOR TIC MARKS WILL APPEAR ON IT)')
      CALL DPWRST('XXX','BUG ')
 1329 CONTINUE
      GOTO1900
C
 1330 CONTINUE
      IX2TSW='ON'
C
      J=0
      DO1331I=ILOCCP,NUMARG
      J=J+1
      IF(J.GT.MAXTIC)GOTO1800
      IF(IARGT(I).NE.'NUMB')GOTO1850
      X2COOR(J)=ARG(I)
 1331 CONTINUE
      IFOUND='YES'
      NX2COO=J
C
      IF(IFEEDB.EQ.'OFF')GOTO1339
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1335)
 1335 FORMAT('THE TIC COORDINATES (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1336)
 1336 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
      CALL DPWRST('XXX','BUG ')
 1339 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               ***************************************************
C               **  TREAT THE CASE WHEN MAJOR TIC MARK COORDINATES ON  **
C               **  BOTH VERTICAL FRAME LINES ARE TO BE DEFINED  **
C               ***************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(ILOCC.EQ.NUMARG)GOTO1410
      IF(IHARG(ILOCCP).EQ.'ON')GOTO1410
      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1420
      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1410
      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1410
      GOTO1430
C
 1410 CONTINUE
      IFOUND='YES'
      IY1TSW='ON'
      IY2TSW='ON'
      NY1COO=-1
      NY2COO=-1
C
      IF(IFEEDB.EQ.'OFF')GOTO1419
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)
 1415 FORMAT('THE MAJOR TIC MARK COORDINATES (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1416)
 1416 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
      CALL DPWRST('XXX','BUG ')
 1419 CONTINUE
      GOTO1900
C
 1420 CONTINUE
      IFOUND='YES'
      IY1TSW='OFF'
      IY2TSW='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1429
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1425)
 1425 FORMAT('THE MAJOR TIC MARK COORDINATES (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1426)
 1426 FORMAT('HAVE JUST BEEN TURNED OFF ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1427)
 1427 FORMAT('(THUS NO MAJOR TIC MARKS WILL APPEAR ON THEM')
      CALL DPWRST('XXX','BUG ')
 1429 CONTINUE
      GOTO1900
C
 1430 CONTINUE
      IY1TSW='ON'
      IY2TSW='ON'
C
      J=0
      DO1431I=ILOCCP,NUMARG
      J=J+1
      IF(J.GT.MAXTIC)GOTO1800
      IF(IARGT(I).NE.'NUMB')GOTO1850
      Y1COOR(J)=ARG(I)
      Y2COOR(J)=ARG(I)
 1431 CONTINUE
      IFOUND='YES'
      NY1COO=J
      NY2COO=J
C
      IF(IFEEDB.EQ.'OFF')GOTO1439
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1435)
 1435 FORMAT('THE MAJOR TIC MARK COORDINATES (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1436)
 1436 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
      CALL DPWRST('XXX','BUG ')
 1439 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN MAJOR TIC MARK COORDINATES ON
C               **  ONLY THE LEFT   VERTICAL   FRAME LINE ARE TO BE DEFINED **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(ILOCC.EQ.NUMARG)GOTO1510
      IF(IHARG(ILOCCP).EQ.'ON')GOTO1510
      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1520
      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1510
      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1510
      GOTO1530
C
 1510 CONTINUE
      IFOUND='YES'
      IY1TSW='ON'
      NY1COO=-1
C
      IF(IFEEDB.EQ.'OFF')GOTO1519
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1515)
 1515 FORMAT('THE TIC COORDINATES (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1516)
 1516 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
      CALL DPWRST('XXX','BUG ')
 1519 CONTINUE
      GOTO1900
C
 1520 CONTINUE
      IFOUND='YES'
      IY1TSW='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1529
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1525)
 1525 FORMAT('THE TIC COORDINATES (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1526)
 1526 FORMAT('HAVE JUST BEEN TURNED OFF ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1527)
 1527 FORMAT('(THUS NO MAJOR TIC MARKS WILL APPEAR ON IT)')
      CALL DPWRST('XXX','BUG ')
 1529 CONTINUE
      GOTO1900
C
 1530 CONTINUE
      IY1TSW='ON'
C
      J=0
      DO1531I=ILOCCP,NUMARG
      J=J+1
      IF(J.GT.MAXTIC)GOTO1800
      IF(IARGT(I).NE.'NUMB')GOTO1850
      Y1COOR(J)=ARG(I)
 1531 CONTINUE
      IFOUND='YES'
      NY1COO=J
C
      IF(IFEEDB.EQ.'OFF')GOTO1539
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1535)
 1535 FORMAT('THE TIC COORDINATES (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1536)
 1536 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
      CALL DPWRST('XXX','BUG ')
 1539 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN MAJOR TIC MARK COORDINATES ON
C               **  ONLY THE RIGHT  VERTCIAL   FRAME LINE ARE TO BE DEFINED **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(ILOCC.EQ.NUMARG)GOTO1610
      IF(IHARG(ILOCCP).EQ.'ON')GOTO1610
      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1620
      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1610
      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1610
      GOTO1630
C
 1610 CONTINUE
      IFOUND='YES'
      IY2TSW='ON'
      NY2COO=-1
C
      IF(IFEEDB.EQ.'OFF')GOTO1619
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1615)
 1615 FORMAT('THE TIC COORDINATES (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1616)
 1616 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
      CALL DPWRST('XXX','BUG ')
 1619 CONTINUE
      GOTO1900
C
 1620 CONTINUE
      IFOUND='YES'
      IY2TSW='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1629
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1625)
 1625 FORMAT('THE TIC COORDINATES (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1626)
 1626 FORMAT('HAVE JUST BEEN TURNED OFF ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1627)
 1627 FORMAT('(THUS NO MAJOR TIC MARKS WILL APPEAR ON IT)')
      CALL DPWRST('XXX','BUG ')
 1629 CONTINUE
      GOTO1900
C
 1630 CONTINUE
      IY2TSW='ON'
C
      J=0
      DO1631I=ILOCCP,NUMARG
      J=J+1
      IF(J.GT.MAXTIC)GOTO1800
      IF(IARGT(I).NE.'NUMB')GOTO1850
      Y1COOR(J)=ARG(I)
 1631 CONTINUE
      IFOUND='YES'
      NY2COO=J
C
      IF(IFEEDB.EQ.'OFF')GOTO1639
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1635)
 1635 FORMAT('THE TIC COORDINATES (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1636)
 1636 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
      CALL DPWRST('XXX','BUG ')
 1639 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               **************************************************
C               **  TREAT THE CASE WHEN MAJOR TIC MARK COORDINATES ON **
C               **  THE ENTIRE 4-SIDED FRAME ARE TO BE DEFINED  **
C               **************************************************
C
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'TIC ')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(ILOCC.EQ.NUMARG)GOTO1710
      IF(IHARG(ILOCCP).EQ.'ON')GOTO1710
      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1720
      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1710
      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1710
      GOTO1730
C
 1710 CONTINUE
      IFOUND='YES'
      IX1TSW='ON'
      IX2TSW='ON'
      IY1TSW='ON'
      IY2TSW='ON'
      NX1COO=-1
      NX2COO=-1
      NY1COO=-1
      NY2COO=-1
C
      IF(IFEEDB.EQ.'OFF')GOTO1719
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1715)
 1715 FORMAT('THE TIC COORDINATES (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1716)
 1716 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
      CALL DPWRST('XXX','BUG ')
 1719 CONTINUE
      GOTO1900
C
 1720 CONTINUE
      IFOUND='YES'
      IX1TSW='OFF'
      IX2TSW='OFF'
      IY1TSW='OFF'
      IY2TSW='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1729
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1725)
 1725 FORMAT('THE TIC COORDINATES (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1726)
 1726 FORMAT('HAVE JUST BEEN TURNED OFF ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1727)
 1727 FORMAT('(THUS NO MAJOR TIC MARKS WILL APPEAR ON ANY ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
 1729 CONTINUE
      GOTO1900
C
 1730 CONTINUE
      IX1TSW='ON'
      IX2TSW='ON'
      IY1TSW='ON'
      IY2TSW='ON'
C
      J=0
      DO1731I=ILOCCP,NUMARG
      J=J+1
      IF(J.GT.MAXTIC)GOTO1800
      IF(IARGT(I).NE.'NUMB')GOTO1850
      X1COOR(J)=ARG(I)
      X2COOR(J)=ARG(I)
      Y1COOR(J)=ARG(I)
      Y2COOR(J)=ARG(I)
 1731 CONTINUE
      IFOUND='YES'
      NX1COO=J
      NX2COO=J
      NY1COO=J
      NY2COO=J
C
      IF(IFEEDB.EQ.'OFF')GOTO1739
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1735)
 1735 FORMAT('THE TIC COORDINATES (FOR ALL 4 FRAMES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1736)
 1736 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
      CALL DPWRST('XXX','BUG ')
 1739 CONTINUE
      GOTO1900
C
 1799 CONTINUE
      GOTO1900
C
 1800 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1801)
 1801 FORMAT('***** ERROR IN DPMJTC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1802)
 1802 FORMAT('      THE NUMBER OF SPECIFIED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1803)
 1803 FORMAT('      TIC COORDINATES HAS JUST EXCEEDED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1804)MAXTIC
 1804 FORMAT('      THE ALLOWABLE MAXIMUM OF ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO1900
C
 1850 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1851)
 1851 FORMAT('***** ERROR IN DPMJTC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1852)
 1852 FORMAT('      A SPECIFICATION IN THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1853)
 1853 FORMAT('      TIC COORDINATES COMMAND HAS JUST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1854)
 1854 FORMAT('      BEEN ENCOUNTERED WHICH IS NON-NUMERIC')
      CALL DPWRST('XXX','BUG ')
      GOTO1900
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPMLAD(Y,N,
     1XTEMP,MAXNXT,DALPHA,DBETA,DH,ITEMP,
     1AKML,ALOCML,SCALEML,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR THE ASYMMETRIC DOUBLE EXPONENTIAL
C              DISTRIBUTION.  THE ALGORITHM IS:
C
C              1) SORT THE DATA
C
C              2) COMPUTE
C
C                 h(x(j)) = 2*LOG[alpha(theta)) + SQRT(beta(theta))] +
C                           SQRT(alpha(theta)*SQRT(beta(theta))
C
C                 WHERE
C
C                 alpha(theta) = (1/N)*SUM[j=1 to N][(x(j) - theta)+]
C                 beta(theta)  = (1/N)*SUM[j=1 to N][(x(j) - theta)-]
C
C                 WHERE
C
C                 (x(j) - theta)+ = x(j) - theta       x(j) >= theta
C                                 = 0                  x(j) < theta
C                 (x(j) - theta)- = theta - x(j)       x(j) <= theta
C                                 = 0                  x(j) > theta
C
C              3) SET R EQUAL TO THE VALUE OF J WHERE H(x(j)) HAS
C                 IT'S MINIMUM VALUE.
C
C              4) IF R=1 OR R=N, THE MAXIMUM LIKELIHOOD ESTIMATES
C                 DO NOT EXIST.  HOWEVER, THESE CASES SUGGEST
C                 POSITIVE AND NEGATIVE EXPONENTIAL DISTRIBUTIONS,
C                 RESPECTIVELY.
C
C              5) OTHERWISE, THE MAXIMUM LIKELIHOOD ESTIMATES ARE:
C
C                 THETAHAT = X(R)
C
C                 KHAT     = (BETA(THETAHAT))**(1/4)/
C                            (ALPHA(THETAHAT))**(1/4)
C
C                 SIGMAHAT = SQRT(2)*(BETA(THETAHAT))**(1/4)*
C                            (ALPHA(THETAHAT))**(1/4)*
C                            (SQRT(ALPHA(THETAHAT)) +
C                            SQRT(BETA(THETAHAT)))
C
C     EXAMPLE--ASYMMETRIC DOUBLE EXPONENTIAL MAXIMUM LIKELIHOOD Y
C     REFERENCES--KOTZ, KOZUBOWSKI, AND PODGORSKI, "THE LAPLACE
C                 DISTRIBUTION AND GENERALIZATIONS: A REVISIT WITH
C                 APPLICATIONS TO COMMUNICATIONS, ECONOMICS,
C                 ENGINEERING, AND FINANCE", BIRKHAUSR, 2001,
C                 PP. 133-178.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/8
C     ORIGINAL VERSION--AUGUST    2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      DOUBLE PRECISION DSUM
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
      DIMENSION ITEMP(*)
C
      DOUBLE PRECISION DALPHA(*)
      DOUBLE PRECISION DBETA(*)
      DOUBLE PRECISION DH(*)
C
      DOUBLE PRECISION DHMIN
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DTERM2
      DOUBLE PRECISION DTERM3
      DOUBLE PRECISION DTERM4
C
      DIMENSION FISH(3,3)
      DIMENSION COV(3,3)
C
      INCLUDE 'DPCOF2.INC'
C
      CHARACTER*4 ISUBN0
C
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IERRF1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
C
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='DPML'
      ISUBN2='DE  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLAD')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLAD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLAD')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN ASYMMETRIC DOUBLE EXPONENTIAL MAXIMUM ',
     1         'LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS NON-POSITIVE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR FROM ASYMMETRIC DOUBLE EXPONENTIAL MAXIMUM ',
     1       'LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
C               **********************************
C               **  STEP 21--                   **
C               **  CARRY OUT CALCULATIONS      **
C               **  FOR ASYMMETRIC DOUBLE EXPONENTIAL MLE  **
C               **  ESTIMATE (FULL SAMPLE CASE) **
C               **********************************
C
 2100 CONTINUE
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLAD')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
C
      CALL SORT(Y,N,XTEMP)
      DO2105I=1,N
        Y(I)=XTEMP(I)
 2105 CONTINUE
      XMIN=Y(1)
      XMAX=Y(N)
C
      CALL MEDIAN(Y,N,IWRITE,XTEMP,MAXNXT,XMED,IBUGA3,IERROR)
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
C
      DHMIN=DBLE(CPUMAX)
      DO2110I=1,N
        THETA=Y(I)
        DSUM1=0.0D0
        DSUM2=0.0D0
        DO2120J=1,N
          IF(Y(J).GE.THETA)DSUM1=DSUM1 + DBLE(Y(J) - THETA)
          IF(Y(J).LE.THETA)DSUM2=DSUM2 + DBLE(THETA - Y(J))
 2120   CONTINUE
        DALPHA(I)=DSUM1/DBLE(N)
        DBETA(I)=DSUM2/DBLE(N)
        DH(I)=2.0D0*DLOG(DSQRT(DALPHA(I)) + DSQRT(DBETA(I)))
     1        + DSQRT(DALPHA(I))*DSQRT(DBETA(I))
        IF(DH(I).LT.DHMIN)THEN
          DHMIN=DH(I)
          IR=I
        ENDIF
 2110 CONTINUE
C
      IF(IR.EQ.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2131)
 2131   FORMAT('***** ERROR FROM ASYMMETRIC DOUBLE EXPONENTIAL ',
     1       'MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2133)
 2133   FORMAT('      ESTIMATE OF LOCATION PARAMTER EQUALS DATA ',
     1       'MINIMUM.  THE MAXIMUM')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2135)
 2135   FORMAT('      LIKELIHOOD ESTIMATES DO NOT EXIST.  HOWEVER, ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2137)
 2137   FORMAT('      THIS IMPLIES THAT AN EXPONENTIAL MODEL IS ',
     1         'APPROPRIATE.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        AKML=-999.0
        SCALEML=1.0
        ALOCML=0.0
        GOTO9000
      ELSEIF(IR.EQ.N)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2143)
 2143   FORMAT('      ESTIMATE OF LOCATiON PARAMTER EQUALS DATA ',
     1       'MAXIMUM.  THE MAXIMUM')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2145)
 2145   FORMAT('      LIKELIHOOD ESTIMATES DO NOT EXIST.  HOWEVER, ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2147)
 2147   FORMAT('      THIS IMPLIES THAT A NEGATIVE EXPONENTIAL ',
     1         'MODEL IS APPROPRIATE.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        AKML=-999.0
        SCALEML=1.0
        ALOCML=0.0
        GOTO9000
      ELSE
        ALOCML=Y(IR)
      ENDIF
C
      DTERM1=DBETA(IR)**(1.0D0/4.0D0)
      DTERM2=DALPHA(IR)**(1.0D0/4.0D0)
      DTERM3=DSQRT(DBETA(IR))
      DTERM4=DSQRT(DALPHA(IR))
      IF(DTERM2.LE.0.0D0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2153)
 2153   FORMAT('      INFINITE VALUE FOR THE SHAPE PARAMETER.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2155)
 2155   FORMAT('      THE CAUSE OF THIS IS TIES FOR THE ',
     1         'MAXIMUM DATA VALUE AND')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2157)
 2157   FORMAT('      THE ESTIMATE OF THE LOCATION PARAMETER ',
     1         'OCCURS AT THE DATA MAXIMUM.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      AKML=DTERM1/DTERM2
      SCALEML=DSQRT(2.0D0)*DTERM2*DTERM1*(DTERM3 + DTERM4)
C
C  NOW COMPUTE THE FISHER INFORMATION MATRIX, THEN INVERT TO
C  OBTAIN THE ASYMPTOTIC VARIANCE-COVARIANCE MATRIX.  THEN WRITE
C  TO DPST1F.DAT.
C
      FISH(1,1)=2.0/(SCALEML**2)
      FISH(1,2)=-SQRT(2.0)*2.0/(SCALEML*(1.0+AKML**2))
      FISH(3,1)=0.0
      FISH(2,1)=FISH(1,2)
      FISH(2,2)=(1.0/(AKML**2)) + 4.0/((1.0+AKML**2)**2)
      FISH(2,3)=-(1.0-AKML**2)/(SCALEML*AKML*(1.0+AKML**2))
      FISH(1,3)=FISH(3,1)
      FISH(3,2)=FISH(2,3)
      FISH(3,3)=1.0/(SCALEML**2)
CCCCC print *,'fish(1,1) = ',fish(1,1)
CCCCC print *,'fish(2,2) = ',fish(2,2)
CCCCC print *,'fish(3,3) = ',fish(3,3)
CCCCC print *,'fish(1,2) = ',fish(1,2)
CCCCC print *,'fish(2,3) = ',fish(2,3)
CCCCC print *,'fish(3,1) = ',fish(3,1)
      CALL SGECO(FISH,3,3,ITEMP,RCOND,XTEMP)
      IJOB=1
      CALL SGEDI(FISH,3,3,ITEMP,XTEMP,XTEMP(MAXNXT/2),IJOB)
      DO2810J=1,3
        DO2815I=1,3
          COV(I,J)=FISH(I,J)
 2815   CONTINUE
 2810 CONTINUE
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='MLAD'
      IERRF1='NO'
C
      IREWI1='ON'
      CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      WRITE(IOUNI1,2905)
 2905 FORMAT(' THETA             K               SIGMA')
      DO2910I=1,3
        WRITE(IOUNI1,'(3(E15.7,2X))')COV(I,1),COV(I,2),COV(I,3)
 2910 CONTINUE
C
      IENDF1='OFF'
      IREWI1='ON'
      CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Asymmetric Double Exponential Maximum ',
     1         'Likelihood Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=250>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Mean:')
 5063   FORMAT('         Sample Median:')
 5064   FORMAT('         Sample Standard Deviation:')
 5065   FORMAT('         Estimate of Location Parameter (theta):')
 5066   FORMAT('         Estimate of Scale Parameter (sigma):')
 5067   FORMAT('         Estimate of Shape Parameter (k):')
 5068   FORMAT('         Sample Minimum:')
 5069   FORMAT('         Sample Maximum:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMED
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALOCML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALEML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AKML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Asymmetric Exponential Maximum ',
     1       'Likelihood Estimate}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Median: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Estimate of Location Parameter ($',A1,'theta$): & ',
     1       G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Estimate of Scale Parameter ($,',A1,'sigma$): & ',
     1       G15.7,2X,A1,A1)
 8027 FORMAT(5X,'Estimate of Shape Parameter ($,',A1,'kappa$): & ',
     1       G15.7,2X,A1,A1)
 8028 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8029 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8030 FORMAT(5X,' & ',2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XMED,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)IBASLC,ALOCML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)IBASLC,SCALEML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,AKML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{center}')
 8093 FORMAT(A1,'end{table}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4105)
 4105   FORMAT(6X,'ASYMMETRIC DOUBLE EXPONENTIAL MAXIMUM LIKELIHOOD ',
     1         'ESTIMATION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4109)N
 4109   FORMAT('THE NUMBER OF OBSERVATIONS                 = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4111)XMEAN
 4111   FORMAT('THE SAMPLE MEAN                            = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4112)XMED  
 4112   FORMAT('THE SAMPLE MEDIAN                          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4113)XSD
 4113   FORMAT('THE SAMPLE STANDARD DEVIATION              = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4115)XMIN
 4115   FORMAT('THE SAMPLE MINIMUM                         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4117)XMAX
 4117   FORMAT('THE SAMPLE MAXIMUM                         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4121)ALOCML
 4121   FORMAT('ESTIMATE OF THE LOCATION PARAMETER (THETA) = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4123)SCALEML
 4123   FORMAT('ESTIMATE OF THE SCALE PARAMETER (SIGMA)    = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4125)AKML
 4125   FORMAT('ESTIMATE OF THE SHAPE PARAMETER (AK)       = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4131)
 4131   FORMAT('THE LOCATION, SCALE, AND SHAPE PARAMETERS WILL ',
     1         'BE SAVED AS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4133)
 4133   FORMAT('THE INTERNAL PARAMETERS LOCML, SCALEML, AND ',
     1         'KML.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4135)
 4135   FORMAT('THE ASYMPTOTIC PARAMETER VARIANCE-COVARIANCE ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4137)
 4137   FORMAT('WRITTEN TO THE FILE dpst1f.dat.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLAD')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMLAD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMLBE(Y,N,
     1XTEMP,MAXNXT,AUSER,BUSER,
     1A,B,ALPHA2,BETA2,ALPHA1,BETA1,
     1ALPHSE,BETASE,COVSE,
     1QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
     1IOUNI1,IOUNI2,ALPHAP,
     1ICAPSW,ICAPTY,DTEMP1,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE METHOD OF MOMENT AND
C              MAXIMUM LIKELIHOOD ESTIMATES FOR THE LOWER AND UPPER
C              LIMITS OF THE BETA DISTRIBUTION
C     EXAMPLE--BETA MOMENTS Y
C     REFERENCE--EVANS, HASTINGS, AND PEACOCK.  "STATISTICAL
C                DISTRIBUTIONS", THIRD EDITION, WILEY, 2000,
C                PP. 34-42.
C                JOHNSON, KOTZ, AND BALAKRISHNAN.  "CONTINUOUS
C                UNIVARIATE DISTRIBUTIONS, VOLUME II", SECOND
C                EDITION, WILEY, 1994.
C              --KARL BURY, "STATISTICAL DISTRIBUTIONS IN
C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
C                1999, CHAPTER 14.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003/11
C     ORIGINAL VERSION--NOVEMBER  2003.
C     UPDATED         --DECEMBER  2004. CONFIDENCE INTERVALS FOR
C                                       SHAPE PARAMETERS
C     UPDATED         --JULY      2005. SOME COSMETIC CHANGES TO THE
C                                       OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
      DOUBLE PRECISION DTEMP1(*)
C
      PARAMETER (NUMALP=6)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWAL(NUMALP)
      DIMENSION AUPPAL(NUMALP)
      DIMENSION ALOWBE(NUMALP)
      DIMENSION AUPPBE(NUMALP)
      DIMENSION ALOWA2(NUMALP)
      DIMENSION AUPPA2(NUMALP)
      DIMENSION ALOWB2(NUMALP)
      DIMENSION AUPPB2(NUMALP)
C
      DIMENSION QP(*)
      DIMENSION XQPHAT(*)
      DIMENSION XQPSE(*)
      DIMENSION XQPLCL(*)
      DIMENSION XQPUCL(*)
C
      DOUBLE PRECISION TOL
      DOUBLE PRECISION XPAR(2)
      DOUBLE PRECISION FVEC(2)
      DOUBLE PRECISION DAE
      DOUBLE PRECISION DRE
      DOUBLE PRECISION DXSTRT
      DOUBLE PRECISION DXLOW
      DOUBLE PRECISION DXUP
C
      EXTERNAL BETFUN
      DOUBLE PRECISION BETFU2
      EXTERNAL BETFU2
      DOUBLE PRECISION BETFU5
      EXTERNAL BETFU5
      EXTERNAL BETFU7
      EXTERNAL BETFU8
C
      DOUBLE PRECISION DANS(10)
      DOUBLE PRECISION DA
      DOUBLE PRECISION DB
      DOUBLE PRECISION DC
      DOUBLE PRECISION DALPHA
      DOUBLE PRECISION DBETA
      DOUBLE PRECISION DALPBE
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DTERM2
      DOUBLE PRECISION DTERM3
      DOUBLE PRECISION DTERM4
C
C---------------------------------------------------------------------
C
      COMMON /BETAML/ BETALL, BETAUL
C
      INTEGER N2
      DOUBLE PRECISION DSUM3
      DOUBLE PRECISION DSUM4
      DOUBLE PRECISION DLLAB
      DOUBLE PRECISION DK
      COMMON/BETCO9/DSUM3,DSUM4,DLLAB,DK,N2
C
      DOUBLE PRECISION DBETA2
      COMMON/BETCO2/DBETA2
C
      DOUBLE PRECISION DALPH2
      COMMON/BETCO5/DALPH2
C
      DOUBLE PRECISION DBETA3
      COMMON/BETCO3/DBETA3
C
      DOUBLE PRECISION DALPH3
      COMMON/BETCO4/DALPH3
C
      COMMON/BETCO7/P7,BETA3
      COMMON/BETCO8/P8,ALPHA3
C
      DOUBLE PRECISION DN
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
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='BE  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLBE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPMLBE--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,55)N
   55 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,MIN(N,100)
      WRITE(ICOUT,57)I,Y(I)
   57 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
   66 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN DPMLBE--THE NUMBER OF OBSERVATIONS ',
     1        'FOR VARIABLE 1 IS LESS THAN 3')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)N
 1112   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
      IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM DPMLBE--VARIABLE 1 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
      IF(NPERC.GT.0)THEN
        DO1145I=1,NPERC
          IF(QP(I).LE.0.0 .OR. QP(I).GE.100.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1141)
 1141       FORMAT('***** WARNING IN BETA MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1143)QP(I)
 1143       FORMAT('      REQUESTED PERCENTILE (',G15.7,') IS ',
     1             'OUTSIDE THE (0,100) INTERVAL')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1144)
 1144       FORMAT('      NO PERCENTILE CONFIDENCE LIMITS WILL BE ',
     1             'COMPUTED.')
            CALL DPWRST('XXX','WRIT')
            NPERC=0
          ENDIF
 1145   CONTINUE
      ENDIF
C
 1290 CONTINUE
C
C               *************************************
C               **  STEP 31--                      **
C               **  CARRY OUT CALCULATIONS         **
C               **  FOR BETA MOMENT/MLE ESTIMATION **
C               *************************************
C
 3100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL VAR(Y,N,IWRITE,XVAR,IBUGA3,IERROR)
      XSD=SQRT(XVAR)
C
CCCCC ALLOW FOR USER SPECIFIED LOWER AND UPPER LIMITS
C
      IF((AUSER.EQ.CPUMIN .OR. BUSER.EQ.CPUMIN) .OR.
     1   (AUSER.GE.XMIN .OR. BUSER.LE.XMAX))THEN
        IF((XMIN.GE.0.0 .AND. XMIN.LE.1.0) .AND.
     1     (XMAX.GE.0.0 .AND. XMAX.LE.1.0))THEN
          A=0.0
          B=1.0
        ELSE
          A=XMIN - 1.0E-12
          B=XMAX + 1.0E+12
        ENDIF
        BETALL=A
        BETAUL=B
      ELSE
        BETALL=AUSER
        BETAUL=BUSER
        A=AUSER
        B=BUSER
      ENDIF
C
      XMEAN1=(XMEAN-A)/(B-A)
      VAR1=XVAR/((B-A)**2)
      ALPHA1=XMEAN1*(XMEAN1*(1.0-XMEAN1)/VAR1 - 1.0)
      BETA1=(1.0-XMEAN1)*(XMEAN1*(1.0-XMEAN1)/VAR1 - 1.0)
C
      XPAR(1)=DBLE(ALPHA1)
      XPAR(2)=DBLE(BETA1)
      DPROD1=1.0D0
      DPROD2=1.0D0
      DN=DBLE(N)
C
      DO3101I=1,N
        DTERM1=DBLE((B-Y(I))/(B-A))**(1.0D0/DN)
        DTERM2=DBLE( (Y(I)-A)/(B-A))**(1.0D0/DN)
        IF(DTERM1.NE.0.0D0)DPROD1=DPROD1*DTERM1
        IF(DTERM2.NE.0.0D0)DPROD2=DPROD2*DTERM2
 3101 CONTINUE
      XPAR(1)=0.5D0*(1.0D0 - DPROD1)/(1.0D0 - DPROD2 - DPROD1)
      DO3103I=1,N
        DTERM1=DBLE((Y(I)-A)/(B-A))**(1.0D0/DN)
        DTERM2=DBLE( (B-Y(I))/(B-A))**(1.0D0/DN)
        IF(DTERM1.NE.0.0D0)DPROD1=DPROD1*DTERM1
        IF(DTERM2.NE.0.0D0)DPROD2=DPROD2*DTERM2
 3103 CONTINUE
      XPAR(2)=0.5D0*(1.0D0 - DPROD1)/(1.0D0 - DPROD1 - DPROD2)
C
      IOPT=2
      TOL=1.0D-6
      NVAR=2
      NPRINT=-1
      INFO=0
      LWA=MAXNXT
      CALL DNSQE(BETFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1           DTEMP1,MAXNXT,Y,N)
C
      ALPHA2=REAL(XPAR(1))
      BETA2=REAL(XPAR(2))
C
CCCCC CONFIDENCE INTERVALS FOR SHAPE PARAMETERS
C
      DN=DBLE(N)
      DALPHA=DBLE(ALPHA2)
      DBETA=DBLE(BETA2)
      DALPBE=DBLE(ALPHA2 + BETA2)
C
      KODE=1
      NTEMP=1
      M=1
      NZ=0
C
      CALL DPSIFN(DALPHA,NTEMP,KODE,M,DANS,NZ,IERR)
      DA=DANS(1)
      IF(IERR.EQ.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3201)
 3201   FORMAT('***** ERROR FROM BETA MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3203)
 3203   FORMAT('      UNABLE TO COMPUTE TRIGAMMA FUNCTION.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ELSEIF(IERR.EQ.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3201)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3205)
 3205   FORMAT('      OVERFLOW IN COMPUTING THE TRIGAMMA FUNCTION.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ELSEIF(IERR.EQ.3)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3201)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3207)
 3207   FORMAT('      OVERFLOW IN COMPUTING THE TRIGAMMA FUNCTION.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      CALL DPSIFN(DBETA,NTEMP,KODE,M,DANS,NZ,IERR)
      DB=DANS(1)
      IF(IERR.EQ.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3201)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3203)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ELSEIF(IERR.EQ.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3201)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3205)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ELSEIF(IERR.EQ.3)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3201)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3207)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      CALL DPSIFN(DALPBE,NTEMP,KODE,M,DANS,NZ,IERR)
      DC=DANS(1)
      IF(IERR.EQ.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3201)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3203)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ELSEIF(IERR.EQ.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3201)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3205)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ELSEIF(IERR.EQ.3)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3201)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3207)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      DTERM1=1.0D0/(DN*(DA*DB - DC*(DA+DB)))
      DTERM2=DTERM1*(DB-DC)
      ALPHSE=REAL(DSQRT(DTERM2))
      DTERM2=DTERM1*(DA-DC)
      BETASE=REAL(DSQRT(DTERM2))
      DTERM2=DTERM1*DC
      COVSE=REAL(DSQRT(DTERM2))
C
      DO3310I=1,NUMALP
        ALP=ALPHA(I)
        P=1.0-(ALP/2.0)
        CALL NORPPF(P,PPF)
        ALOWAL(I)=ALPHA2 - PPF*ALPHSE
        AUPPAL(I)=ALPHA2 + PPF*ALPHSE
        ALOWBE(I)=BETA2 - PPF*BETASE
        AUPPBE(I)=BETA2 + PPF*BETASE
 3310 CONTINUE
C
      N2=N
      DA=DBLE(A)
      DB=DBLE(B)
      DALPH2=DBLE(ALPHA2)
      DALPH3=DBLE(ALPHA2)
      DBETA2=DBLE(BETA2)
      DBETA3=DBLE(BETA2)
      DSUM3=0.0D0
      DSUM4=0.0D0
      DO3320I=1,N
        DTEMP1(I)=DBLE(Y(I))
        DSUM3=DSUM3 + DLOG(DBLE(Y(I)) - DA)
        DSUM4=DSUM4 + DLOG(DB - DBLE(Y(I)))
 3320 CONTINUE
      DSUM3=DSUM3/(DN*(DB - DA))
      DSUM4=DSUM4/(DN*(DB - DA))
C
      DTERM1=-DN*DLBETA(DALPH2,DBETA2)
      DTERM2=DN*(DALPH2-1.0D0)*DSUM3
      DTERM3=DN*(DBETA2-1.0D0)*DSUM4
      DLLAB=DTERM1 + DTERM2 + DTERM3
C
      DAE=1.D-7
      DRE=1.D-7
      NUTEMP=1
C
      DO3410I=1,NUMALP
        ALP=ALPHA(I)
        CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
        DK=DBLE(APPF)
C
        DXSTRT=DBLE(ALOWAL(I))
        DXLOW=DXSTRT/5.0D0
        DXUP=DBLE(ALPHA2)
        CALL DFZER2(BETFU2,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP1)
        ALOWA2(I)=REAL(DXLOW)
C
        DXSTRT=DBLE(AUPPAL(I))
        DXUP=DXSTRT*5.0D0
        DXLOW=DBLE(ALPHA2)
        CALL DFZER2(BETFU2,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP1)
        AUPPA2(I)=REAL(DXLOW)
C
        DXSTRT=DBLE(ALOWBE(I))
        DXLOW=DXSTRT/5.0D0
        DXUP=DBLE(BETA2)
        CALL DFZER2(BETFU5,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP1)
        ALOWB2(I)=REAL(DXLOW)
C
        DXSTRT=DBLE(AUPPBE(I))
        DXUP=DXSTRT*5.0D0
        DXLOW=DBLE(BETA2)
        CALL DFZER2(BETFU5,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP1)
        AUPPB2(I)=REAL(DXLOW)
C
 3410 CONTINUE
C
C  CONFIDENCE INTERVALS FOR SELECTED PERCENTILES.
C
C  1. STANDARD ERROR USES TECHNIQUE DEMONSTRATED IN EXAMPLE 14.3
C     (PP. 256-257) OF BURY.  THIS IS BASED ON PROPOGATION OF ERROR.
C 
C  2. CONFIDENCE INTERVAL IS THEN GENERATED USING NORMAL
C     APPROXIMATION (EXAMPLE 14.3 OF BURY).
C
      IF(NPERC.GE.1)THEN
C
        ALPHL=ALPHAP/2.0
        ALPHU=1.0 - ALPHAP/2.0
        CALL NORPPF(ALPHU,Z95)
C
        ALPHA3=ALPHA2
        BETA3=BETA2
        IORD=1
        EPS=0.001
        ACCUR=0.0
C
        WRITE(IOUNI1,3531)
        WRITE(IOUNI1,3532)
        DO3529I=1,NPERC
          QPTEMP=QP(I)/100.0
          CALL BETPPF(QPTEMP,ALPHA2,BETA2,APPF)
          XQPHAT(I)=APPF
C
          P7=QPTEMP
          P8=QPTEMP
C
          IFAIL=0
C
          ALPHAT = ALPHA2
          ALPHMN = 0.0001
          ALPHMX = ALPHA2 + 10.0
          CALL DIFF(IORD,ALPHAT,ALPHMN,ALPHMX,BETFU7,EPS,ACCUR,
     1              D1,ERROR,IFAIL)
C
          IF(IFAIL.EQ.1)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3501)
 3501       FORMAT('***** WARNING IN NUMERICAL DERIVATIVE FOR BETA ',
     1             'MAXIMUM LIKELIHOOD PERCENTILES.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3503)
 3503       FORMAT('      THE ESTIMATED ERROR IN THE RESULT ',
     1             'EXCEEDS THE')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3505)
 3505       FORMAT('      REQUESTED ERROR, BUT THE MOST ACCURATE ',
     1             'RESULT')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3507)
 3507       FORMAT('      POSSIBLE HAS BEEN RETURNED.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFAIL.EQ.2)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3511)
 3511       FORMAT('***** ERROR IN NUMERICAL DERIVATIVE FOR BETA ',
     1             'MAXIMUM LIKELIHOOD PERCENTILES.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3513)
 3513       FORMAT('      ERROR IN THE INPUT TO THE DIFF ROUTINE.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3515)
 3515       FORMAT('      NO PERCENTILES WILL BE GENERATED.')
            CALL DPWRST('XXX','BUG ')
            NPERC=0
          ELSEIF(IFAIL.EQ.3)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3511)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3523)
 3523       FORMAT('      THE INTERVAL FOR DIFFERENTIATION, (',G15.7,
     1             ',',G15.7,')')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3525)
 3525       FORMAT('      IS TOO SMALL.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3515)
            CALL DPWRST('XXX','BUG ')
            D1=0.0
            NPERC=0
          ENDIF
C
          BETAT = BETA2
          BETAMN = 0.0001
          BETAMX = BETA2 + 10.0
          CALL DIFF(IORD,BETAT,BETAMN,BETAMX,BETFU8,EPS,ACCUR,
     1              D2,ERROR,IFAIL)
C
          IF(IFAIL.EQ.1)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3501)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3503)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3505)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3507)
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFAIL.EQ.2)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3511)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3513)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3515)
            CALL DPWRST('XXX','BUG ')
            NPERC=0
          ELSEIF(IFAIL.EQ.3)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3511)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3523)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3525)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,3515)
            CALL DPWRST('XXX','BUG ')
            D2=0.0
            NPERC=0
          ENDIF
          V11=ALPHSE**2
          V22=BETASE**2
          V21=COVSE
          V12=V21
          TERM11=(D1*ALPHSE)**2
          TERM22=(D2*BETASE)**2
          TERM12=2.0*D2*D1*COVSE**2
          SEXQP=TERM11+TERM12+TERM22
          IF(SEXQP.GE.0.0)THEN
            SEXQP=SQRT(SEXQP)
          ELSE
            SEXQP=0.0
          ENDIF
          XQPSE(I)=SEXQP
          XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
          XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
          WRITE(IOUNI1,'(5E15.7)')
     1         QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
 3529   CONTINUE
 3531   FORMAT(15X,'       POINT     ','   STANDARD   ',
     1         '     LOWER     ',
     1         '     UPPER')
 3532   FORMAT('    PERCENTILE ','     ESTIMATE   ',
     1         '     ERRROR     ',
     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
      ENDIF
C               *********************************
C               **   STEP 42--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR BETA MLE ESTIMATION   **
C               **********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5002   FORMAT('<H2>BETA DISTRIBUTION PARAMETER ESTIMATION</H2>')
 5004   FORMAT('<BR><BR>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Full Sample Case</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=350>')
 5044   FORMAT('         <B>Summary Statistics</B>:')
 5144   FORMAT('         <B>Method of Moments</B>:')
 5244   FORMAT('         <B>Maximum Likelihood</B>:')
 5045   FORMAT('         Number of Observations:')
 5061   FORMAT('         Sample Minimum (Estimate of Lower Limit):')
 5062   FORMAT('         Sample Maximum (Estimate of Upper Limit):')
 5063   FORMAT('         Sample Mean:')
 5064   FORMAT('         Sample Standard Deviation:')
 5065   FORMAT('         User Supplied Estimate of Lower Limit:')
 5066   FORMAT('         User Supplied Estimate of Upper Limit:')
 5067   FORMAT('         &nbsp;')
 5068   FORMAT('         Estimate of Alpha:')
 5069   FORMAT('         Estimate of Beta:')
 5071   FORMAT('         Standard Error of of Alpha:')
 5073   FORMAT('         Standard Error of Beta:')
 5074   FORMAT('         Standard Error of of Parameter Covariance:')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5044)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5045)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        IF(BETALL.NE.CPUMIN .AND. BETAUL.NE.CPUMIN)THEN
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5065)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)BETALL
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5066)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)BETAUL
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5144)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALPHA1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)BETA1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5244)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALPHA2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALPHSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)BETA2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5073)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)BETASE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5074)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)COVSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Limits for the Alpha ',
     1         'Parameter</B><BR>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5134   FORMAT('         &nbsp;')
 5136   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM COLSPAN=2>')
 5137   FORMAT('         Normal Approximation')
 5138   FORMAT('         Likelihood Ratio')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=5>')
 5162   FORMAT('          <HR>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5138)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        DO5140I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWAL(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPAL(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWA2(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPA2(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5140   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5217   FORMAT('      <B>Confidence Limits for the Beta ',
     1         'Parameter</B><BR>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5217)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5138)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
        DO5240I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWBE(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPBE(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWB2(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPB2(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5240   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  START THE TABLE FOR PERCENTILE CONFIDENCE INTERVALS
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,5801)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          WRITE(ICOUT,5811)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5813)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5815)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5817)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5816)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5819)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5861)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,55862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5863)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5864)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5870)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5872)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5847)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          DO55880I=1,NPERC
            WRITE(ICOUT,5841)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)QP(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPHAT(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPSE(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPLCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPUCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5859)
            CALL DPWRST('XXX','WRIT')
55880     CONTINUE
C
C  END THE TABLE AND RESET ASIS MODE
C
          WRITE(ICOUT,5191)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5193)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
 5801     FORMAT('</PRE>')
 5811     FORMAT('<UL>')
 5813     FORMAT('<TABLE NOBORDER>')
 5815     FORMAT('   <CAPTION ALIGN=CENTER>')
 5816     FORMAT('      <BR><B>Alpha = ',F7.3,'</B>')
 5817     FORMAT('      <B>Confidence Limits (Normal Approximation) ',
     1           'for Selected Percentiles</B>')
 5819     FORMAT('   </CAPTION>')
 5841     FORMAT('   <TR>')
 5843     FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5847     FORMAT('      </TD>')
 5848     FORMAT('      </TH>')
 5849     FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5851     FORMAT('         ',G15.7)
 5859     FORMAT('   </TR>')
 5861     FORMAT('         Percentile')
 5862     FORMAT('         Point <br> Estimate')
55862     FORMAT('         Standard <br> Error')
 5863     FORMAT('         Lower <br>Confidence Limit')
 5864     FORMAT('         Upper <br>Confidence Limit')
 5870     FORMAT('      <TD COLSPAN=5>')
 5872     FORMAT('         <HR WIDTH=600>')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Beta Distribution Parameter Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8080 FORMAT(5X,'{',A1,'bf Summary Statistics: & ',2X,A1,A1)
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8086 FORMAT(5X,'{',A1,'bf Method of Moment Estimation: & ',2X,A1,A1)
 8026 FORMAT(5X,'Estimate of $',A1,'alpha$: & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,'Estimate of $',A1,'beta$: & ',G15.7,2X,A1,A1)
 8088 FORMAT(5X,'{',A1,'bf Maximum Likelihood Estimation: & ',2X,A1,A1)
 8031 FORMAT(5X,'User Supplied Estimate of Lower Limit: & ',
     1       G15.7,2X,A1,A1)
 8032 FORMAT(5X,'User Supplied Estimate of Upper Limit: & ',
     1       G15.7,2X,A1,A1)
 8033 FORMAT(5X,'Standard Error of Maximum Likelihood Estimate of $',
     1       A1,'alpha$: & ',G15.7,2X,A1,A1)
 8034 FORMAT(5X,'Standard Error of Maximum Likelihood Estimate of $',
     1       A1,'beta$: & ',G15.7,2X,A1,A1)
 8035 FORMAT(5X,'Standard Error of Maximum Likelihood Parameter ',
     1       'Covariance: & ',G15.7,2X,A1,A1)
 8038 FORMAT(5X,' & ',2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
C
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8080)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(BETALL.NE.CPUMIN .AND. BETAUL.NE.CPUMIN)THEN
          WRITE(ICOUT,8031)AUSER,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8032)BUSER,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8038)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8086)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)IBASLC,ALPHA1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,BETA1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8038)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8088)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)IBASLC,ALPHA2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8033)IBASLC,ALPHSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,BETA2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8034)IBASLC,BETASE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8035)COVSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{table}')
 8093 FORMAT(A1,'end{center}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8105 FORMAT(A1,'begin{table}')
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for $',A1,'alpha$}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8105)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8111)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120   FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper & Lower & Upper ',
     1         2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit & Limit & Limit',
     1         2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,' & ',G15.7,' & ',
     1         G15.7,2X,A1,A1)
 8126   FORMAT(5X,'& ',A1,'multicolumn{2}{c}{Normal Approximation}',
     1         ' & ',A1,'multicolumn{2}{c}{Likelihood Ratio}',
     1         2X,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8126)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8130I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWAL(I),AUPPAL(I),ALOWA2(I),
     1                     AUPPA2(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8130   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8191   FORMAT(A1,'end{table}')
 8193   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8211 FORMAT(5X,'{',A1,'bf Confidence Limits for $',A1,'beta$}')
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8211)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8126)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8230I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWBE(I),AUPPBE(I),ALOWB2(I),
     1                     AUPPB2(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8230   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8191)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C WRITE SELECTED PERCENTILES (IF ANY)
C
        IF(NPERC.GT.0)THEN
C
          CALL DPCONA(92,IBASLC)
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8803)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8810)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8812)IBASLC,IBASLC,ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8813)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8820)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8821)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8822)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,
     1                     IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8840)IBASLC
          CALL DPWRST('XXX','WRIT')
          DO8830I=1,NPERC
            WRITE(ICOUT,8823)QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),
     1                       XQPUCL(I),IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
 8830     CONTINUE
          WRITE(ICOUT,8849)IBASLC
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8891)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8893)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
 8801   FORMAT(A1,'end{verbatim}')
 8803   FORMAT(A1,'begin{table}')
 8807   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8809   FORMAT(A1,'begin{center}')
 8810   FORMAT(5X,'{',A1,'bf Confidence Limits (Normal Approximation)',
     1         'for Selected Percentiles}')
 8812   FORMAT(5X,'{',A1,'bf $',A1,'alpha$ = ',F7.3,'}')
 8813   FORMAT(A1,'end{center}')
 8815   FORMAT(5X,'} ',A1,A1)
 8820   FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8821   FORMAT(5X,' & {',A1,'bf Point} & {',A1,'bf Standard} & {',
     1         A1,'bf Lower} & {',A1,'bf Upper}',2X,A1,A1)
 8822   FORMAT(5X,'{',A1,'bf Percentile} & {',A1,'bf Estimate} & {',
     1         A1,'bf Error} & {',A1,'bf Confidence Limit} & {',
     1         A1,'bf Confidence Limit}',
     1         2X,A1,A1)
 8823   FORMAT(5X,G15.7,' & ',G15.7,' & ',G15.7,' & ',G15.7,
     1         ' & ',G15.7,2X,A1,A1)
 8840   FORMAT(5X,A1,'hline')
 8849   FORMAT(A1,'end{tabular}')
 8891   FORMAT(A1,'end{center}')
 8893   FORMAT(A1,'end{table}')
C
 8099   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(12X,'BETA MAXIMUM LIKELIHOOD ESTIMATION:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)N
 4221   FORMAT('NUMBER OF OBSERVATIONS                    = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)XMIN
 4223   FORMAT('SAMPLE MINIMUM                            = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)XMAX
 4225   FORMAT('SAMPLE MAXIMUM                            = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4227)XMEAN
 4227   FORMAT('SAMPLE MEAN                               = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4229)XVAR
 4229   FORMAT('SAMPLE STANDARD DEVIATION                 = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        IF(BETALL.NE.CPUMIN .AND. BETAUL.NE.CPUMIN)THEN
          WRITE(ICOUT,4231)BETALL
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4233)BETAUL
          CALL DPWRST('XXX','WRIT')
        ENDIF
 4231   FORMAT('USER SUPPLIED ESTIMATE OF LOWER LIMIT     = ',G15.7)
 4233   FORMAT('USER SUPPLIED ESTIMATE OF UPPER LIMIT     = ',G15.7)
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4240)
 4240   FORMAT('METHOD OF MOMENT ESTIMATES:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4241)ALPHA1
 4241   FORMAT('ESTIMATE OF ALPHA                         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)BETA1 
 4243   FORMAT('ESTIMATE OF BETA                          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4250)
 4250   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4251)ALPHA2
 4251   FORMAT('ESTIMATE OF ALPHA                         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4253)ALPHSE
 4253   FORMAT('STANDARD ERROR OF ESTIMATE OF ALPHA       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4255)BETA2
 4255   FORMAT('ESTIMATE OF BETA                          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4257)BETASE
 4257   FORMAT('STANDARD ERROR OF ESTIMATE OF BETA        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4259)COVSE
 4259   FORMAT('STANDARD ERROR OF PARAMETER COVARIANCE    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4340)
 4340   FORMAT('CONFIDENCE INTERVAL FOR ALPHA PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4342)
 4342   FORMAT('                       NORMAL APPROXIMATION',
     1         '            LIKELIHOOD RATIO')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4343)
 4343   FORMAT('   CONFIDENCE           LOWER         UPPER',
     1         '         LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4345)
 4345   FORMAT('   VALUE (%)            LIMIT         LIMIT',
     1         '         LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4346)
 4346   FORMAT('---------------------------------------------------',
     1         '--------------------')
        CALL DPWRST('XXX','WRIT')
        DO4349I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4347)ATEMP,ALOWAL(I),AUPPAL(I),
     1                     ALOWA2(I),AUPPA2(I)
 4347     FORMAT('   ',F8.3,10X,4(G12.6,2X))
          CALL DPWRST('XXX','WRIT')
 4349   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4360)
 4360   FORMAT('CONFIDENCE INTERVAL FOR BETA PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4342)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4343)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4345)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4346)
        CALL DPWRST('XXX','WRIT')
        DO4379I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4347)ATEMP,ALOWBE(I),AUPPBE(I),
     1                     ALOWB2(I),AUPPB2(I)
          CALL DPWRST('XXX','WRIT')
 4379   CONTINUE
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,4411)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4415)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4421)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4422)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4446)
          CALL DPWRST('XXX','WRIT')
C
 4411   FORMAT('CONFIDENCE LIMITS (NORMAL APPROXIMATION) FOR ',
     1         'SELECTED PERCENTILES:')
 4415   FORMAT('ALPHA = ',F7.4)
 4421   FORMAT(10X,'      POINT     ','  STANDARD   ',
     1             '        LOWER     ', '       UPPER')
 4422   FORMAT('PERCENTILE','   ESTIMATE   ','      ERROR     ',
     1         'CONFIDENCE LIMIT ',' CONFIDENCE LIMIT')
 4446   FORMAT('-----------------------------------',
     1         '-----------------------------------')
C
          DO4481I=1,NPERC
            WRITE(ICOUT,4432)QP(I),XQPHAT(I),XQPSE(I),
     1                       XQPLCL(I),XQPUCL(I)
 4432       FORMAT(2X,F8.4,2G15.7,2X,G15.7,2X,G15.7)
            CALL DPWRST('XXX','WRIT')
 4481     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4901)
 4901   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES WILL BE SAVED AS ',
     1         'INTERNAL PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4903)
 4903   FORMAT('ALPHAML, BETAML, ALPHASE, BETASE, AND COVSE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4905)
 4905   FORMAT('METHOD OF MOMENT ESTIMATES WILL BE SAVED AS ',
     1         'INTERNAL PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4907)
 4907   FORMAT('ALPHAMOM, AND BETAMOM.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLBE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMLBE--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMLBI(Y,N,NTRIAL,
     1XTEMP,MAXNXT,
     1TEMP1,P,PLCL,PUCL,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR BINOMIAL DISTRIBUTION
C     EXAMPLE--BINOMIAL MAXIMUM LIKELIHOOD Y
C     REFERENCE--XX
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/5
C     ORIGINAL VERSION--MAY       1998.
C     UPDATED         --MARCH     2004. SUPPORT FOR HTML, LATEX
C     UPDATED         --MARCH     2004. CONFIDENCE INTERVAL FOR P
C     UPDATED         --MARCH     2004. SUPPORT FOR USER-SPECIFIED
C                                       VALUE FOR N (NTRIAL)
C     UPDATED         --AUGUST    2005. REFORMAT OUTPUT FOR
C                                       CONSISTENCY WITH OTHER ML
C                                       ROUTINES
C     UPDATED         --AUGUST    2005. IMPROVED CONFIDENCE INTERVALS
C                                       FOR P
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*1 IBASLC
C
      REAL LCL
      REAL UCL
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
      DIMENSION TEMP1(*)
C
      PARAMETER (NUMALP=5)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWAC(NUMALP)
      DIMENSION AUPPAC(NUMALP)
      DIMENSION ALOWNO(NUMALP)
      DIMENSION AUPPNO(NUMALP)
C
      EXTERNAL SUM
      EXTERNAL BINFUN
      COMMON/BINCOM/NTEMP,XSUCC,CONST
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
CCCCC DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='BI  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBI')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLBI--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,NTRIAL
   55   FORMAT('N, NTRIAL = ',2I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
       ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLBI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN BINOMIAL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS NON-POSITIVE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      IF(N.GT.1)THEN
        DO1135I=2,N
          IF(Y(I).NE.HOLD)GOTO1139
 1135   CONTINUE
 1130   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1131)
 1131   FORMAT('***** WARNING FROM BINOMIAL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1133)HOLD
 1133   FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
        CALL DPWRST('XXX','WRIT')
 1139   CONTINUE
      ENDIF
C
C               *******************************
C               **  STEP 41--                **
C               **  CARRY OUT CALCULATIONS   **
C               **  FOR BINOMIAL MLE ESTIMATE**
C               *******************************
C
 2100 CONTINUE
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLBI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
C
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
      CALL SUM(Y,N,IWRITE,XSUM,IBUGA3,IERROR)
C
      CALL DISTIN(Y,N,IWRITE,TEMP1,NDIST,IBUGA3,IERROR)
      IF(NTRIAL.GT.1)THEN
        DO2105I=1,N
          Y(I)=INT(Y(I)+0.5)
          IF(Y(I).LT.0 .OR. Y(I).GT.NTRIAL)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,2111)
 2111       FORMAT('***** ERROR FROM BINOMIAL MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,2113)I,NTRIAL
 2113       FORMAT('      ROW ',I8,' IS LESS THAN ZERO OR GREATER ',
     1             'THAN ',I8,' (= NUMBER OF TRIALS)')
            CALL DPWRST('XXX','WRIT')
            IERROR='YES'
            GOTO9000
          ENDIF
 2105   CONTINUE
      ELSE
        IF(NDIST.GT.2)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2116)
 2116     FORMAT('***** ERROR FROM BINOMIAL MAXIMUM LIKELIHOOD--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2113)NDIST
 2118     FORMAT('      FOR BINOMIAL CASE WITH 1 TRIAL, MORE THAN ',
     1           'TWO DISTINCT VALUES DETECTED.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
        HOLD1=TEMP1(1)
        HOLD2=TEMP1(2)
        IF(HOLD1.LT.HOLD2)THEN
          XMIN=HOLD1
          XMAX=HOLD2
        ELSE
          XMAX=HOLD1
          XMIN=HOLD2
        ENDIF
        DO2120I=1,N
          IF(Y(I).EQ.XMAX)THEN
            Y(I)=1.0
          ELSE
            Y(I)=0.0
          ENDIF
 2120   CONTINUE
      ENDIF
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      P=XMEAN
      IF(NTRIAL.GT.1)THEN
        P=P/REAL(NTRIAL)
      ENDIF
      Q=1.0-P
      AN=REAL(N)*REAL(NTRIAL)
C
      CALL NORPPF(0.975,ZALPHA)
      TERM1=ZALPHA*ZALPHA/(2.0*AN)
      TERM2=ZALPHA*SQRT((P*Q/AN) + ZALPHA*ZALPHA/(4.0*AN*AN))
      TERM3=1.0 + ZALPHA*ZALPHA/AN
      UCL=(P + TERM1 + TERM2)/TERM3
      LCL=(P + TERM1 - TERM2)/TERM3
      PLCL=LCL
      PUCL=PUCL
C
      NTEMP=N*NTRIAL
      AE=1.E-6
      RE=1.E-6
      IFLAG=0
C
      DO2210I=1,NUMALP
C
        ALP=ALPHA(I)
        P1=ALP/2.0
        P2=1.0-(ALP/2.0)
C
C       GENERATE THE AGRESTI-COULL INTERVALS
C
        CALL NORPPF(P2,ZALPHA)
        TERM1=ZALPHA*ZALPHA/(2.0*AN)
        TERM2=ZALPHA*SQRT((P*Q/AN) + ZALPHA*ZALPHA/(4.0*AN*AN))
        TERM3=1.0 + ZALPHA*ZALPHA/AN
        UCL=(P + TERM1 + TERM2)/TERM3
        LCL=(P + TERM1 - TERM2)/TERM3
        ALOWAC(I)=LCL
        AUPPAC(I)=UCL
C
C       FOR NUMBER OF SUCCESSES >= 30, GENERATE NORMAL APPROXIMATION INTERVALS
C       FOR NUMBER OF SUCCESSES <  30, GENERATE EXACT INTERVALS
C
        IF(XSUCC.GE.30.0)THEN
          CALL NORPPF(P2,ZALPHA)
          UCL=P + ZALPHA*SQRT(P*(1.0-P)/AN)
          LCL=P - ZALPHA*SQRT(P*(1.0-P)/AN)
          ALOWNO(I)=LCL
          AUPPNO(I)=UCL
        ELSE
          CONST=P2
          PHAT=P
          PLOWLI=0.0001
          PUPPLI=0.9999
          XSUCC=XSUM-1.0
          IF(XSUCC.LE.0)XSUCC=0.0
          CALL FZERO(BINFUN,PLOWLI,PUPPLI,PHAT,RE,AE,IFLAG)
          ALOWNO(I)=PLOWLI
          IF(IFLAG.EQ.2)THEN
C
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2211)
 2211       FORMAT('***** WARNING FROM BINOMIAL MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2213)
 2213       FORMAT('      ESTIMATE OF LOWER CONFIDENCE VALUE FOR P ',
     1             'MAY NOT BE COMPUTED TO DESIRED TOLERANCE.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.3)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2211)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2223)
 2223       FORMAT('      ESTIMATE OF LOWER CONFIDENCE VALUE FOR P ',
     1             'MAY BE NEAR A SINGULAR POINT.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.4)THEN
CCCCC       WRITE(ICOUT,999)
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,2211)
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,2233)
C2233       FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
CCCCC       CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.5)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2211)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2243)
 2243       FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
          IFLAG=0
          CONST=P1
          PHAT=P
          PLOWLI=0.0001
          PUPPLI=0.9999
          XSUCC=XSUM
          IF(XSUCC.LE.0)XSUCC=0.0
          CALL FZERO(BINFUN,PLOWLI,PUPPLI,PHAT,RE,AE,IFLAG)
          AUPPNO(I)=PLOWLI
          IF(IFLAG.EQ.2)THEN
C
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2211)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2263)
 2263       FORMAT('      ESTIMATE OF UPPER CONFIDENCE VALUE FOR P ',
     1             'MAY NOT BE COMPUTED TO DESIRED TOLERANCE.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.3)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2211)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2273)
 2273       FORMAT('      ESTIMATE OF UPPER CONFIDENCE VALUE FOR P ',
     1             'MAY BE NEAR A SINGULAR POINT.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.4)THEN
CCCCC       WRITE(ICOUT,999)
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,2211)
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,2233)
C2233       FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
CCCCC       CALL DPWRST('XXX','BUG ')
          ELSEIF(IFLAG.EQ.5)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2211)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2283)
 2283       FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
        ENDIF
C
 2210 CONTINUE
C
C               *********************************
C               **   STEP 42--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR BINOMIAL MLE ESTIMATE **
C               **********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLBI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Binomial  Parameter Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=350>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5060   FORMAT('         Summary Statistics:')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Number of Trials Parameter:')
 5069   FORMAT('         Number of Successes:')
 5063   FORMAT('         Sample Mean:')
 5064   FORMAT('         Sample Standard Deviation:')
 5065   FORMAT('         Sample Minimum:')
 5066   FORMAT('         Sample Maximum:')
 5067   FORMAT('         Maximum Likelihood Estimates:')
 5068   FORMAT('         Estimate of Probability of Success ',
     1         'Parameter <i>p</i>:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)NTRIAL
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)INT(XSUM + 0.5)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)P
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Limits for the ',
     1         'Probability of Success Parameter</B><BR>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5134   FORMAT('         &nbsp;')
 5136   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM COLSPAN=2>')
 5137   FORMAT('         Normal Approximation')
55137   FORMAT('         Exact Interval')
 5138   FORMAT('         Agresti-Coull Approximation')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=5>')
 5162   FORMAT('          <HR>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        IF(XSUM.GE.30.0)THEN
          WRITE(ICOUT,5137)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,55137)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5138)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        DO5140I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWNO(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPNO(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWAC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPAC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5140   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Binomial Parameter Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Summary Statistics: & ',2X,A1,A1)
 8022 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8023 FORMAT(5X,'Number of Trials Parameter: & ',I8,2X,A1,A1)
 8036 FORMAT(5X,'Number of Successes: & ',I8,2X,A1,A1)
 8024 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8028 FORMAT(5X,' & ',2X,A1,A1)
 8029 FORMAT(5X,'Maximum Likelihood Estimates: & ',2X,A1,A1)
 8030 FORMAT(5X,'Estimate of Probability of Success ',
     1       'Parameter $p$: & ',
     1       G15.7,2X,A1,A1)
C8031 FORMAT(5X,'95',A1,'% Lower Confidence Limit for $p$: & ',
CCCCC1       G15.7,2X,A1,A1)
C8032 FORMAT(5X,'95',A1,'% Upper Confidence Limit for $p$: & ',
CCCCC1       G15.7,2X,A1,A1)
C8033 FORMAT(5X,'(Confidence Limits use Agresti and Coull Method) & ',
CCCCC1       '& ',2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)NTRIAL,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8036)INT(XSUCC+0.5),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)P,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8031)IBASLC,LCL,IBASLC,IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8032)IBASLC,LCL,IBASLC,IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8033)IBASLC,IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
 8091 FORMAT(A1,'end{center}')
 8093 FORMAT(A1,'end{table}')
C
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for Probability ',
     1      'of Success Parameter}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8111)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120   FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper & Lower & Upper ',
     1         2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit & Limit & Limit',
     1         2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,' & ',G15.7,' & ',
     1         G15.7,2X,A1,A1)
 8126   FORMAT(5X,'& ',A1,'multicolumn{2}{c}{Normal Approximation}',
     1         ' & ',A1,'multicolumn{2}{c}',
     1         '{Agresti-Coull Approximation}',
     1         2X,A1,A1)
 8426   FORMAT(5X,'& ',A1,'multicolumn{2}{c}{Exact Interval}',
     1         ' & ',A1,'multicolumn{2}{c}',
     1         '{Agresti-Coull Approximation}',
     1         2X,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(XSUM.GE.30.0)THEN
          WRITE(ICOUT,8126)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8426)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8130I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWNO(I),AUPPNO(I),ALOWAC(I),
     1                       AUPPAC(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8130   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8191   FORMAT(A1,'end{table}')
 8193   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(12X,'BINOMIAL PARAMETER ESTIMATION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4240)
 4240   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)N
 4242   FORMAT('NUMBER OF OBSERVATIONS                         = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)NTRIAL
 4243   FORMAT('NUMBER OF TRIALS PARAMETER                     = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4244)INT(XSUM+0.5)
 4244   FORMAT('NUMBER OF SUCCESSES                            = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)XMEAN
 4245   FORMAT('SAMPLE MEAN                                    = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4246)XSD
 4246   FORMAT('SAMPLE STANDARD DEVIATION                      = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4247)XMIN
 4247   FORMAT('SAMPLE MINIMUM                                 = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4248)XMAX
 4248   FORMAT('SAMPLE MAXIMUM                                 = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4250)
 4250   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4252)P
 4252   FORMAT('ESTIMATE OF PROBABILITY OF SUCCESS PARAMETER P = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4310)
 4310   FORMAT('CONFIDENCE INTERVAL FOR PROBABILITY OF SUCCESS ',
     1         'PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(XSUM.GE.30.0)THEN
          WRITE(ICOUT,4312)
 4312     FORMAT('                       NORMAL APPROXIMATION',
     1           ' AGRESTI-COULL APPROXIMATION')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4314)
 4314     FORMAT('                             EXACT INTERVAL',
     1           ' AGRESTI-COULL APPROXIMATION')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,4321)
 4321   FORMAT('   CONFIDENCE           LOWER         UPPER',
     1         '         LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4323)
 4323   FORMAT('   VALUE (%)            LIMIT         LIMIT',
     1         '         LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4326)
 4326   FORMAT('------------------------------------------------',
     1           '-----------------------')
        CALL DPWRST('XXX','WRIT')
        DO4341I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4347)ATEMP,ALOWNO(I),AUPPNO(I),ALOWAC(I),
     1                     AUPPAC(I)
 4347     FORMAT('   ',F8.3,10X,4(G12.6,2X))
          CALL DPWRST('XXX','WRIT')
 4341   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        PLCL=ALOWAC(4)
        PUCL=AUPPAC(4)
        WRITE(ICOUT,4351)
 4351   FORMAT('PML, PLCL, AND PUCL WILL BE SAVED AS AN INTERNAL ',
     1         'PARAMETERS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLBI')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLBI--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLCA(Y,N,
     1XTEMP,TEMP1,MAXNXT,
     1ALOC,ASCALE,ALOCOS,ASCLOS,ALOWOS,SCAWOS,
     1ICAPSW,ICAPTY,DTEMP1,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR CAUCHY DISTRIBUTION
C     EXAMPLE--CAUCHY MAXIMUM LIKELIHOOD Y
C     REFERENCE--GERALD HAAS, LEE BAIN, CHARLES ANTLE, (1970).
C                "INFERENCES FOR THE CAUCHY DISTRIBUTION BASED ON
C                MAXIMUM LIKELIHOOD ESTIMATORS", BIOMETRIKA,
C                PP. 403-407.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003/10
C     ORIGINAL VERSION--OCTOBER   2003.
C     UPDATED         --MAY       2005. ADD SUMS OF WEIGHTED ORDER
C                                       STATISTICS METHOD
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
      DIMENSION TEMP1(*)
      DOUBLE PRECISION DTEMP1(*)
C
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION TOL
      DOUBLE PRECISION XPAR(2)
      DOUBLE PRECISION FVEC(2)
C
      DIMENSION ATABLE(11,2)
      DIMENSION BTABLE(10,4)
C
      EXTERNAL CAUFUN
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
      DATA PI/3.14159265358979/
C
      DATA (ATABLE(1,J),J=1,2)/4.77, 6.78/
      DATA (ATABLE(2,J),J=1,2)/3.11, 3.95/
      DATA (ATABLE(3,J),J=1,2)/2.79, 3.46/
      DATA (ATABLE(4,J),J=1,2)/2.63, 3.27/
      DATA (ATABLE(5,J),J=1,2)/2.60, 3.13/
      DATA (ATABLE(6,J),J=1,2)/2.51, 3.05/
      DATA (ATABLE(7,J),J=1,2)/2.48, 2.97/
      DATA (ATABLE(8,J),J=1,2)/2.45, 2.96/
      DATA (ATABLE(9,J),J=1,2)/2.40, 2.89/
      DATA (ATABLE(10,J),J=1,2)/2.38, 2.85/
      DATA (ATABLE(11,J),J=1,2)/2.33, 2.77/
C
      DATA (BTABLE(1,J),J=1,4)/0.130, 0.101, 2.56, 3.277/
      DATA (BTABLE(2,J),J=1,4)/0.320, 0.387, 2.005, 2.353/
      DATA (BTABLE(3,J),J=1,4)/0.418, 0.479, 1.746, 1.970/
      DATA (BTABLE(4,J),J=1,4)/0.488, 0.546, 1.628, 1.811/
      DATA (BTABLE(5,J),J=1,4)/0.533, 0.583, 1.536, 1.708/
      DATA (BTABLE(6,J),J=1,4)/0.568, 0.621, 1.498, 1.635/
      DATA (BTABLE(7,J),J=1,4)/0.622, 0.670, 1.412, 1.525/
      DATA (BTABLE(8,J),J=1,4)/0.656, 0.702, 1.366, 1.463/
      DATA (BTABLE(9,J),J=1,4)/0.710, 0.751, 1.289, 1.358/
      DATA (BTABLE(10,J),J=1,4)/0.746, 0.779, 1.251, 1.305/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='CA  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLCA')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLCA--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,N
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLCA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.4)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN CAUCHY MAXIMUM LIKELIHOOD ESTIMATION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)
 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE RESPONSE ',
     1         'VARIABLE IS LESS THAN OR EQUAL TO FOUR')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
      IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM CAUCHY MAXIMUM LIKELIHOOD--RESPONSE ',
     1'VARIABLE HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
C               ********************************
C               **  STEP 41--                 **
C               **  CARRY OUT CALCULATIONS    **
C               **  FOR CAUCHY MLE ESTIMATE   **
C               ********************************
C
 3100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
      IERROR='NO'
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
      P1=55.65
      CALL PERCEN(P1,Y,N,IWRITE,XTEMP,MAXNXT,XUPPQU,IBUGA3,IERROR)
      P2=100.0 - P1
      CALL PERCEN(P2,Y,N,IWRITE,XTEMP,MAXNXT,XLOWQU,IBUGA3,IERROR)
      CALL MEDIAN(Y,N,IWRITE,XTEMP,MAXNXT,XMED,IBUGA3,IERROR)
      DO3109I=1,N
        TEMP1(I)=Y(I)
 3109 CONTINUE
      CALL MAD(TEMP1,N,IWRITE,XTEMP,MAXNXT,XMAD,IBUGA3,IERROR)
      CALL MEAN(TEMP1,N,IWRITE,XMEAN,IBUGA3,IERROR)
C
      ALOCOS=0.5*(XUPPQU + XLOWQU)
      P2Q=P2/100.0
      ASCLOS=0.5*(XUPPQU - XLOWQU)*TAN(PI*P2Q)
      AN=REAL(N)
C
      CALL SORT(Y,N,TEMP1)
      DSUM1=0.0D0
      DSUM2=0.0D0
      DO3210I=1,N
        TERM1=REAL(I)/REAL(N+1) - 0.5
        ANUM=SIN(4.0*PI*TERM1)
        ADENOM=REAL(N)*SIN(PI*TERM1)/COS(PI*TERM1)
        DSUM1=DSUM1 + DBLE(ANUM/ADENOM)*DBLE(TEMP1(I))
        ANUM=8.0*SIN(PI*TERM1)/COS(PI*TERM1)
        TERM2=COS(PI*TERM1)
        IF(TERM2.NE.0.0)THEN
          TERM2=1.0/TERM2
        ELSE
          TERM2=1.0/0.0000001
        ENDIF
        ADENOM=REAL(N)*TERM2**4
        DSUM2=DSUM2 + DBLE(ANUM/ADENOM)*DBLE(TEMP1(I))
 3210 CONTINUE
      ALOWOS=REAL(DSUM1)
      SCAWOS=REAL(DSUM2)
C
      IF(N.EQ.3)THEN
        CALL SORT(Y,N,TEMP1)
        X1=TEMP1(1)
        X2=TEMP1(2)
        X3=TEMP1(3)
        TERM1=X1*(X3-X2)**2 + X2*(X3-X1)**2 + X3*(X2-X1)**2
        TERM2=(X3-X2)**2 + (X3-X1)**2 + (X2-X1)**2
        ALOC=TERM1/TERM2
        TERM1=SQRT(3.0)*(X3-X2)*(X3-X1)*(X2-X1)
        ASCALE=TERM1/TERM2
      ELSEIF(N.EQ.3)THEN
        CALL SORT(Y,N,TEMP1)
        X1=TEMP1(1)
        X2=TEMP1(2)
        X3=TEMP1(3)
        X4=TEMP1(4)
        TERM1=X2*X4 - X1*X3
        TERM2=X4 - X3 + X2 - X1
        ALOC=TERM1/TERM2
        TERM1=(X4-X3)*(X3-X2)*(X2-X1)*(X4-X1)
        TERM2=(X4 - X3 + X2 - X1)**2
        ASCALE=TERM1/TERM2
      ELSE
        XPAR(1)=DBLE(XMED)
        XPAR(2)=DBLE(XMAD)
C
        IOPT=2
        TOL=1.0D-6
        NVAR=2
        NPRINT=-1
        INFO=0
        LWA=MAXNXT
        CALL DNSQE(CAUFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1             DTEMP1,MAXNXT,Y,N)
C
        ALOC=REAL(XPAR(1))
        ASCALE=REAL(XPAR(2))
      ENDIF
C
C               ***********************************************
C               **  STEP 41B-                                **
C               **  COMPUTE 90% AND 95% CONFIDENCE INTERVALS **
C               **  USING METHOD GIVEN IN ANTLE PAPER        **
C               ***********************************************
C
      AN=REAL(N)
      IF(N.EQ.5)THEN
        A1=ATABLE(1,1)
        A2=ATABLE(1,2)
      ELSEIF(N.GE.6 .AND. N.LE.9)THEN
        AFACT=REAL(N-5)/REAL(10-5)
        A1=ATABLE(2,1) - AFACT*ABS(ATABLE(2,1)-ATABLE(1,1))
        A2=ATABLE(2,2) - AFACT*ABS(ATABLE(2,2)-ATABLE(1,2))
      ELSEIF(N.EQ.10)THEN
        A1=ATABLE(2,1)
        A2=ATABLE(2,2)
      ELSEIF(N.GE.11 .AND. N.LE.14)THEN
        AFACT=REAL(N-10)/REAL(15-10)
        A1=ATABLE(3,1) - AFACT*ABS(ATABLE(3,1)-ATABLE(2,1))
        A2=ATABLE(3,2) - AFACT*ABS(ATABLE(3,2)-ATABLE(2,2))
      ELSEIF(N.GE.15 .AND. N.LE.18)THEN
        A1=ATABLE(3,1)
        A2=ATABLE(3,2)
      ELSEIF(N.GE.19 .AND. N.LE.23)THEN
        A1=ATABLE(4,1)
        A2=ATABLE(4,2)
      ELSEIF(N.GE.24 .AND. N.LE.28)THEN
        A1=ATABLE(5,1)
        A2=ATABLE(5,2)
      ELSEIF(N.GE.29 .AND. N.LE.35)THEN
        A1=ATABLE(6,1)
        A2=ATABLE(6,2)
      ELSEIF(N.GE.36 .AND. N.LE.45)THEN
        A1=ATABLE(7,1)
        A2=ATABLE(7,2)
      ELSEIF(N.GE.46 .AND. N.LE.63)THEN
        A1=ATABLE(8,1)
        A2=ATABLE(8,2)
      ELSEIF(N.GE.64 .AND. N.LE.88)THEN
        A1=ATABLE(9,1)
        A2=ATABLE(9,2)
      ELSEIF(N.GE.89 .AND. N.LE.100)THEN
        A1=ATABLE(10,1)
        A2=ATABLE(10,2)
      ELSE
        A1=ATABLE(11,1)
        A2=ATABLE(11,2)
      ENDIF
      ALOW90=ALOC - A1*ASCALE/SQRT(AN)
      AHIG90=ALOC + A1*ASCALE/SQRT(AN)
      ALOW95=ALOC - A2*ASCALE/SQRT(AN)
      AHIG95=ALOC + A2*ASCALE/SQRT(AN)
C
      IF(N.EQ.5)THEN
        B1=BTABLE(1,1)
        B2=BTABLE(1,2)
        B3=BTABLE(1,3)
        B4=BTABLE(1,4)
      ELSEIF(N.GE.6 .AND. N.LE.9)THEN
        AFACT=REAL(N-5)/REAL(10-5)
        B1=BTABLE(1,1) + AFACT*ABS(BTABLE(2,1)-BTABLE(1,1))
        B2=BTABLE(1,2) + AFACT*ABS(BTABLE(2,2)-BTABLE(1,2))
        B3=BTABLE(1,3) + AFACT*ABS(BTABLE(2,3)-BTABLE(1,3))
        B4=BTABLE(1,4) + AFACT*ABS(BTABLE(2,4)-BTABLE(1,4))
      ELSEIF(N.EQ.10)THEN
        B1=BTABLE(2,1)
        B2=BTABLE(2,2)
        B3=BTABLE(2,3)
        B4=BTABLE(2,4)
      ELSEIF(N.GE.11 .AND. N.LE.14)THEN
        AFACT=REAL(N-10)/REAL(15-10)
        B1=BTABLE(2,1) + AFACT*ABS(BTABLE(3,1)-BTABLE(2,1))
        B2=BTABLE(2,2) + AFACT*ABS(BTABLE(3,2)-BTABLE(2,2))
        B3=BTABLE(2,3) + AFACT*ABS(BTABLE(3,3)-BTABLE(2,3))
        B4=BTABLE(2,4) + AFACT*ABS(BTABLE(3,4)-BTABLE(2,4))
      ELSEIF(N.EQ.15)THEN
        B1=BTABLE(3,1)
        B2=BTABLE(3,2)
        B3=BTABLE(3,3)
        B4=BTABLE(3,4)
      ELSEIF(N.GE.16 .AND. N.LE.19)THEN
        AFACT=REAL(N-15)/REAL(20-15)
        B1=BTABLE(3,1) + AFACT*ABS(BTABLE(4,1)-BTABLE(3,1))
        B2=BTABLE(3,2) + AFACT*ABS(BTABLE(4,2)-BTABLE(3,2))
        B3=BTABLE(3,3) + AFACT*ABS(BTABLE(4,3)-BTABLE(3,3))
        B4=BTABLE(3,4) + AFACT*ABS(BTABLE(4,4)-BTABLE(3,4))
      ELSEIF(N.EQ.20)THEN
        B1=BTABLE(4,1)
        B2=BTABLE(4,2)
        B3=BTABLE(4,3)
        B4=BTABLE(4,4)
      ELSEIF(N.GE.21 .AND. N.LE.24)THEN
        AFACT=REAL(N-20)/REAL(25-20)
        B1=BTABLE(4,1) + AFACT*ABS(BTABLE(5,1)-BTABLE(4,1))
        B2=BTABLE(4,2) + AFACT*ABS(BTABLE(5,2)-BTABLE(4,2))
        B3=BTABLE(4,3) + AFACT*ABS(BTABLE(5,3)-BTABLE(4,3))
        B4=BTABLE(4,4) + AFACT*ABS(BTABLE(5,4)-BTABLE(4,4))
      ELSEIF(N.GE.25)THEN
        B1=BTABLE(5,1)
        B2=BTABLE(5,2)
        B3=BTABLE(5,3)
        B4=BTABLE(5,4)
      ELSEIF(N.GE.26 .AND. N.LE.29)THEN
        AFACT=REAL(N-25)/REAL(30-25)
        B1=BTABLE(5,1) + AFACT*ABS(BTABLE(6,1)-BTABLE(5,1))
        B2=BTABLE(5,2) + AFACT*ABS(BTABLE(6,2)-BTABLE(5,2))
        B3=BTABLE(5,3) + AFACT*ABS(BTABLE(6,3)-BTABLE(5,3))
        B4=BTABLE(5,4) + AFACT*ABS(BTABLE(6,4)-BTABLE(5,4))
      ELSEIF(N.GE.30)THEN
        B1=BTABLE(6,1)
        B2=BTABLE(6,2)
        B3=BTABLE(6,3)
        B4=BTABLE(6,4)
      ELSEIF(N.GE.31 .AND. N.LE.39)THEN
        AFACT=REAL(N-30)/REAL(40-30)
        B1=BTABLE(6,1) + AFACT*ABS(BTABLE(7,1)-BTABLE(6,1))
        B2=BTABLE(6,2) + AFACT*ABS(BTABLE(7,2)-BTABLE(6,2))
        B3=BTABLE(6,3) + AFACT*ABS(BTABLE(7,3)-BTABLE(6,3))
        B4=BTABLE(6,4) + AFACT*ABS(BTABLE(7,4)-BTABLE(6,4))
      ELSEIF(N.GE.40)THEN
        B1=BTABLE(7,1)
        B2=BTABLE(7,2)
        B3=BTABLE(7,3)
        B4=BTABLE(7,4)
      ELSEIF(N.GE.41 .AND. N.LE.49)THEN
        AFACT=REAL(N-40)/REAL(50-40)
        B1=BTABLE(7,1) + AFACT*ABS(BTABLE(8,1)-BTABLE(7,1))
        B2=BTABLE(7,2) + AFACT*ABS(BTABLE(8,2)-BTABLE(7,2))
        B3=BTABLE(7,3) + AFACT*ABS(BTABLE(8,3)-BTABLE(7,3))
        B4=BTABLE(7,4) + AFACT*ABS(BTABLE(8,4)-BTABLE(7,4))
      ELSEIF(N.GE.50)THEN
        B1=BTABLE(8,1)
        B2=BTABLE(8,2)
        B3=BTABLE(8,3)
        B4=BTABLE(8,4)
      ELSEIF(N.GE.51 .AND. N.LE.74)THEN
        AFACT=REAL(N-50)/REAL(75-50)
        B1=BTABLE(8,1) + AFACT*ABS(BTABLE(9,1)-BTABLE(8,1))
        B2=BTABLE(8,2) + AFACT*ABS(BTABLE(9,2)-BTABLE(8,2))
        B3=BTABLE(8,3) + AFACT*ABS(BTABLE(9,3)-BTABLE(8,3))
        B4=BTABLE(8,4) + AFACT*ABS(BTABLE(9,4)-BTABLE(8,4))
      ELSEIF(N.GE.75)THEN
        B1=BTABLE(9,1)
        B2=BTABLE(9,2)
        B3=BTABLE(9,3)
        B4=BTABLE(9,4)
      ELSEIF(N.GE.76 .AND. N.LE.99)THEN
        AFACT=REAL(N-75)/REAL(100-75)
        B1=BTABLE(9,1) + AFACT*ABS(BTABLE(10,1)-BTABLE(9,1))
        B2=BTABLE(9,2) + AFACT*ABS(BTABLE(10,2)-BTABLE(9,2))
        B3=BTABLE(9,3) + AFACT*ABS(BTABLE(10,3)-BTABLE(9,3))
        B4=BTABLE(9,4) + AFACT*ABS(BTABLE(10,4)-BTABLE(9,4))
      ELSE
        B1=BTABLE(10,1)
        B2=BTABLE(10,2)
        B3=BTABLE(10,3)
        B4=BTABLE(10,4)
      ENDIF
      BLOW90=ASCALE/B4
      BHIG90=ASCALE/B2
      BLOW95=ASCALE/B3
      BHIG95=ASCALE/B1
C
C               *********************************
C               **   STEP 42--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR CAUCHY MLE ESTIMATE **
C               **********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLCA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Cauchy Parameter Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=350>')
 5045   FORMAT('         Number of Observations:')
 5061   FORMAT('         Sample Mean:')
 5062   FORMAT('         Sample Median:')
 5063   FORMAT('         Sample Standard Deviation:')
 5064   FORMAT('         Sample Median Absolute Deviation:')
 5065   FORMAT('         Sample Minimum:')
 5066   FORMAT('         Sample Maximum:')
 5067   FORMAT('         <B>Order Statistic Method:</B>')
 5068   FORMAT('         <B>Maximum Likelihood Method:</B>')
 5069   FORMAT('         Estimate of Location:')
 5070   FORMAT('         Estimate of Scale:')
 5071   FORMAT('         <B>Weighted Order Statistic Method:</B>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5045)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMED
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALOCOS
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5070)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ASCLOS
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALOWOS
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5070)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCAWOS
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALOC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5070)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ASCALE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Limits for the Location ',
     1         'Parameter</B>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5134   FORMAT('         &nbsp;')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=3>')
 5162   FORMAT('          <HR>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        ATEMP=90.0
        WRITE(ICOUT,5141)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)ATEMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)ALOW90
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)AHIG90
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5159)
        CALL DPWRST('XXX','WRIT')
C
        ATEMP=95.0
        WRITE(ICOUT,5141)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)ATEMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)ALOW95
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)AHIG95
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5159)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5217   FORMAT('      <B>Confidence Limits for the Scale ',
     1         'Parameter</B>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5217)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
        ATEMP=90.0
        WRITE(ICOUT,5141)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)ATEMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)BLOW90
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)BHIG90
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5159)
        CALL DPWRST('XXX','WRIT')
C
        ATEMP=95.0
        WRITE(ICOUT,5141)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)ATEMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)BLOW95
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)BHIG95
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5159)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
C
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Cauchy Parameter Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Median: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Median Absolute Deviation: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8028 FORMAT(5X,' & ',2X,A1,A1)
 8029 FORMAT(5X,'{',A1,'bf Method of Order Statistics:} & ',
     1       2X,A1,A1)
 8030 FORMAT(5X,'{',A1,'bf Method of Maximum Likelihood:} & ',
     1       2X,A1,A1)
 8031 FORMAT(5X,'Estimate of Location Parameter: & ',G15.7,2X,A1,A1)
 8032 FORMAT(5X,'Estimate of Scale Parameter: & ',G15.7,2X,A1,A1)
 8033 FORMAT(5X,'{',A1,'bf Method of Weighted Order Statistics:} & ',
     1       2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XMED,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XMAD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)ALOCOS,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)ASCLOS,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8033)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)ALOWOS,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)SCAWOS,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)ALOC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)ASCALE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8093 FORMAT(A1,'end{center}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for Location Parameter}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8111)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper ',2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit',2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,2X,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        ATEMP=90.0
        WRITE(ICOUT,8131)ATEMP,ALOW90,AHIG90,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        ATEMP=95.0
        WRITE(ICOUT,8131)ATEMP,ALOW95,AHIG95,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8191   FORMAT(A1,'end{table}')
 8193   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8211 FORMAT(5X,'{',A1,'bf Confidence Limits for Scale Parameter}')
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8211)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        ATEMP=90.0
        WRITE(ICOUT,8131)ATEMP,BLOW90,BHIG90,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        ATEMP=95.0
        WRITE(ICOUT,8131)ATEMP,BLOW95,BHIG95,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8191)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8899)IBASLC
 8899   FORMAT(A1,'begin{verbatim}')
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4111)
 4111   FORMAT(10X,'CAUCHY PARAMETER ESTIMATION:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4113)N
 4113   FORMAT('NUMBER OF OBSERVATIONS                   = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4114)XMEAN
 4114   FORMAT('SAMPLE MEAN                              = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4115)XMED
 4115   FORMAT('SAMPLE MEDIAN                            = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4116)XSD
 4116   FORMAT('SAMPLE STANDARD DEVIATION                = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4117)XMAD
 4117   FORMAT('SAMPLE MEDIAN ABSOLUTE DEVIATION         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4118)XMIN
 4118   FORMAT('SAMPLE MINIMUM                           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4119)XMAX
 4119   FORMAT('SAMPLE MAXIMUM                           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4121)
 4121   FORMAT('ORDER STATISTIC METHOD:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4123)ALOCOS
 4123   FORMAT('ESTIMATE OF LOCATION PARAMETER           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4125)ASCLOS
 4125   FORMAT('ESTIMATE OF SCALE PARAMETER              = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4131)
 4131   FORMAT('WEIGHTED ORDER STATISTIC METHOD:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4133)ALOWOS
 4133   FORMAT('ESTIMATE OF LOCATION PARAMETER           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4135)SCAWOS
 4135   FORMAT('ESTIMATE OF SCALE PARAMETER              = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4141)
 4141   FORMAT('MAXIMUM LIKELIHOOD METHOD:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4143)ALOC
 4143   FORMAT('ESTIMATE OF LOCATION PARAMETER           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4145)ASCALE
 4145   FORMAT('ESTIMATE OF SCALE PARAMETER              = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4640)
 4640   FORMAT('CONFIDENCE INTERVAL FOR LOCATION PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4643)
 4643   FORMAT('   CONFIDENCE           LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4645)
 4645   FORMAT('   VALUE (%)            LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4646)
 4646   FORMAT('-------------------------------------------')
        CALL DPWRST('XXX','WRIT')
C
        ATEMP=90.0
        WRITE(ICOUT,4647)ATEMP,ALOW90,AHIG90
 4647   FORMAT('   ',F8.3,10X,G12.6,2X,G12.6)
        CALL DPWRST('XXX','WRIT')
        ATEMP=95.0
        WRITE(ICOUT,4647)ATEMP,ALOW95,AHIG95
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4680)
 4680   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4643)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4645)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4646)
        CALL DPWRST('XXX','WRIT')
C
        ATEMP=90.0
        WRITE(ICOUT,4647)ATEMP,BLOW90,BHIG90
        CALL DPWRST('XXX','WRIT')
        ATEMP=95.0
        WRITE(ICOUT,4647)ATEMP,BLOW95,BHIG95
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4161)
 4161   FORMAT('LOCOS, SCALEOS, LOCOS, SCALEWOS, LOCML, AND ',
     1         'SCALEML ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4162)
 4162   FORMAT('WILL BE SAVED AS INTERNAL PARAMETERS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLCA')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLCA--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLDE(Y,N,
     1XTEMP,MAXNXT,
     1ALOC,SCALE,ALOCSE,SCALESE,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR THER DOUBLE EXPONENTIAL DISTRIBUTION
C     EXAMPLE--DOUBLE EXPONENTIAL MAXIMUM LIKELIHOOD Y
C     REFERENCE--XX
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/6
C     ORIGINAL VERSION--JUNE      1998.
C     UPDATED         --MARCH     2004.
C     UPDATED         --FEBRUARY  2005. SOME CHANGES IN THE OUTPUT
C                                       FORMAT
C     UPDATED         --MAY       2005. ADD CONFIDENCE INTERVALS FOR
C                                       LOCATION AND SCALE PARAMETERS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      DOUBLE PRECISION DSUM
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
C
      PARAMETER (NUMALP=6)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWSC(NUMALP)
      DIMENSION AUPPSC(NUMALP)
      DIMENSION ALOWLO(NUMALP)
      DIMENSION AUPPLO(NUMALP)
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
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='DE  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLDE')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLDE--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLDE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN DOUBLE EXPONENTIAL MAXIMUM ',
     1         'LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS NON-POSITIVE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR FROM DOUBLE EXPONENTIAL MAXIMUM ',
     1       'LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
C               **********************************
C               **  STEP 41--                   **
C               **  CARRY OUT CALCULATIONS      **
C               **  FOR DOUBLE EXPONENTIAL MLE  **
C               **  ESTIMATE (FULL SAMPLE CASE) **
C               **********************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLDE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      CALL MEDIAN(Y,N,IWRITE,XTEMP,MAXNXT,XMED,IBUGA3,IERROR)
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
      ALOC=XMED
C
      AN=REAL(N)
      DSUM=0.0D0
      DO4110I=1,N
        DSUM=DSUM + DBLE(ABS(Y(I) - XMED))
 4110 CONTINUE
      SCALE=REAL(DSUM)/AN
C
CCCCC ALOCSE=SCALE
CCCCC SCALESE=SCALE
C
      IDF=2*N-1
      DO4120I=1,NUMALP
C
        ALP=ALPHA(I)
        P1=ALP/2.0
        P2=1.0-(ALP/2.0)
C
        CALL CHSPPF(P1,IDF,AUPP)
        CALL CHSPPF(P2,IDF,ALOW)
        ALOWSC(I)=XMEAN + 2.0*REAL(DSUM)/ALOW
        AUPPSC(I)=XMEAN + 2.0*REAL(DSUM)/AUPP
C
        CALL NORPPF(P2,APPF2)
        ALOWLO(I)=ALOC - APPF2*REAL(DSUM)/(AN*SQRT(AN-APPF2**2))
        AUPPLO(I)=ALOC + APPF2*REAL(DSUM)/(AN*SQRT(AN-APPF2**2))
C
 4120   CONTINUE
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Double Exponential Maximum Likelihood ',
     1         'Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=250>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Mean:')
 5063   FORMAT('         Sample Standard Deviation:')
 5064   FORMAT('         Sample Minimum:')
 5065   FORMAT('         Sample Maximum:')
 5066   FORMAT('         Maximum Likelihood Estimate of the ',
     1         'Location Parameter:')
 5067   FORMAT('         Location Standard Error:')
 5068   FORMAT('         Maximum Likelihood Estimate of the ',
     1         'Scale Parameter:')
 5069   FORMAT('         Scale Standard Error:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALOC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5041)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5043)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5067)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5047)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5049)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5051)ALOCSE
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5047)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5059)
CCCCC   CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5041)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5043)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5069)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5047)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5049)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5051)SCALESE
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5047)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5059)
CCCCC   CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Limits for the Location ',
     1         'Parameter</B>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5134   FORMAT('         &nbsp;')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=3>')
 5162   FORMAT('          <HR>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        DO5140I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWLO(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPLO(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5140   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5217   FORMAT('      <B>Confidence Limits for the Scale ',
     1         'Parameter</B>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5217)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
        DO5240I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWSC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPSC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5240   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5195   FORMAT('<PRE>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5195)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Double Exponential Maximum Likelihood ',
     1       'Estimate}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,' & ',2X,A1,A1)
 8027 FORMAT(5X,'Maximum Likelihood Estimate of the Location ',
     1       'Parameter: & ',G15.7,2X,A1,A1)
 8028 FORMAT(5X,'Standard Error of the Location Parameter: & ',
     1       G15.7,2X,A1,A1)
 8029 FORMAT(5X,'Maximum Likelihood Estimate of the Scale ',
     1       'Parameter: & ',G15.7,2X,A1,A1)
 8030 FORMAT(5X,'Standard Error of the Scale Parameter: & ',
     1       G15.7,2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)ALOC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8028)ALOCSE,IBASLC,IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)SCALE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8030)SCALESE,IBASLC,IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{center}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for Location Parameter}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8111)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper ',2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit',2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,2X,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8130I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWLO(I),AUPPLO(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8130   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8191   FORMAT(A1,'end{table}')
 8193   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8211 FORMAT(5X,'{',A1,'bf Confidence Limits for Scale Parameter}')
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8211)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8230I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWSC(I),AUPPSC(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8230   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8195   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8191)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8195)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4105)
 4105   FORMAT(10X,'DOUBLE EXPONENTIAL MAXIMUM LIKELIHOOD ESTIMATION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4109)N
 4109   FORMAT(
     1  'THE NUMBER OF OBSERVATIONS                             = ',
     1  I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4111)XMEAN
 4111   FORMAT(
     1  'THE SAMPLE MEAN                                        = ',
     1   G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4113)XSD
 4113   FORMAT(
     1  'THE SAMPLE STANDARD DEVIATION                          = ',
     1  G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4115)XMIN
 4115   FORMAT(
     1  'THE SAMPLE MINIMUM                                     = ',
     1  G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4117)XMAX
 4117   FORMAT(
     1  'THE SAMPLE MAXIMUM                                     = ',
     1  G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4121)ALOC
 4121   FORMAT(
     1  'MAXIMUM LIKELIHOOD ESTIMATE OF THE LOCATION PARAMETER  = ',
     1  G15.7)
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,4123)ALOCSE
C4123   FORMAT(
CCCCC1  'STANDARD ERROR OF THE LOCATION PARAMETER               = ',
CCCCC1  G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4131)SCALE
 4131   FORMAT(
     1  'MAXIMUM LIKELIHOOD ESTIMATE OF THE SCALE PARAMETER     = ',
     1  G15.7)
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,4133)SCALESE
C4133   FORMAT(
CCCCC1  'STANDARD ERROR OF THE SCALE PARAMETER                  = ',
CCCCC1  G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4640)
 4640   FORMAT('CONFIDENCE INTERVAL FOR LOCATION PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4643)
 4643   FORMAT('   CONFIDENCE           LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4645)
 4645   FORMAT('   VALUE (%)            LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4646)
 4646   FORMAT('-------------------------------------------')
        CALL DPWRST('XXX','WRIT')
C
        DO4649I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4647)ATEMP,ALOWLO(I),AUPPLO(I)
 4647     FORMAT('   ',F8.3,10X,G12.6,2X,G12.6)
          CALL DPWRST('XXX','WRIT')
 4649   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4680)
 4680   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4643)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4645)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4646)
        CALL DPWRST('XXX','WRIT')
C
        DO4689I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4647)ATEMP,ALOWSC(I),AUPPSC(I)
          CALL DPWRST('XXX','WRIT')
 4689   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
      IF(IFEEDB.EQ.'ON')THEN
        WRITE(ICOUT,4141)
 4141   FORMAT('THE LOCATION AND SCALE PARAMETERS WILL BE SAVED AS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4143)
 4143   FORMAT(6X,'THE INTERNAL PARAMETERS LOCML AND SCALEML.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLDE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMLDE--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMLDL(Y,N,
     1XTEMP,MAXNXT,
     1THETA,ASYMVA,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR LOGARITHMIC SERIES DISTRIBUTION
C              THE MAXIMUM LIKELIHOOD ESTIMATE OF THETA IS THE
C              SOLUTION TO THE EQUATION:
C                 XBAR = THETAHAT/[-(1-THETAHAT)LN(1-THETAHAT)
C              BOUNDS FOR THETAHAT ARE:
C                [(9*XBAR-6)-SQRT(9*XBAR**2-12*XBAR+12)]/(6*XBAR-2)
C                         <= THETAHAT  <=
C                [(6*XBAR-3)-SQRT(24*XBAR**2-24*XBAR+9)]/XBAR
C              THE ASYMPTOTIC VARIANCE OF THETAHAT IS:
C                 (1/N)*THETA**2/U2)
C              WITH U2 DENOTING THE VARIANCE OF THE LOGARITMIC
C              SERIES DISTRIBUTION:
C                 U2 = A*THETA(1-A*THETA)/(1-THETA)**2
C                  A = -1/LN(1-THETA)
C              THE SAMPLE VARIANCE AND THETAHAT ARE USED TO
C              COMPUTE AN ESTIMATE OF THIS ASYMPTOTIC VARIANCE.
C     EXAMPLE--LOGARITHMIC SERIES MAXIMUM LIKELIHOOD Y
C     REFERENCE--"UNIVARIATE DISCRETE DISTRIBUTIONS", SECOND EDITION,
C                JOHNSON, KOTZ, AND KEMP, WILEY, 1992, CHAPTER 7.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/3
C     ORIGINAL VERSION--MARCH     2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*4 IBASLC
C
      EXTERNAL DLGFU2
      REAL XMEAN
      COMMON/DLGCOM/XMEAN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
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='DPML'
      ISUBN2='DL  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLDL')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLDL--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLDL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN LOGARITHMIC SERIES MAXIMUM ',
     1         'LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 1 ',
     1         'IS NON-POSITIVE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR FROM LOGARITHMIC SERIES MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
C               ******************************************
C               **  STEP 21--                           **
C               **  CARRY OUT CALCULATIONS              **
C               **  FOR LOGARITHMIC SERIES MLE ESTIMATE **
C               ******************************************
C
 2100 CONTINUE
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO2105I=1,N
        ITEMP=INT(Y(I)+0.5)
        Y(I)=REAL(ITEMP)
 2105 CONTINUE
      IERROR='NO'
      IWRITE='OFF'
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      IF(XMIN.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2111)
 2111   FORMAT('***** ERROR FROM LOGARITHMIC SERIES MAXIMUM ',
     1         'LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2113)
 2113   FORMAT('      NEGATIVE VALUE ENCOUNTERED.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
C
      TERM1=9.0*XMEAN-6.0
      TERM2=SQRT(9.0*XMEAN*XMEAN - 12.0*XMEAN + 12.0)
      TERM3=6.0*XMEAN - 2.0
      XLOWLI=(TERM1-TERM2)/TERM3
      TERM1=6.0*XMEAN-3.0
      TERM2=SQRT(24.0*XMEAN*XMEAN - 24.0*XMEAN + 9.0)
      TERM3=XMEAN
      XUPPLI=(TERM1-TERM2)/TERM3
C
      AE=1.E-6
      RE=1.E-6
      IFLAG=0
      THETA2=(XLOWLI+XUPPLI)/2.0
      CALL FZERO(DLGFU2,XLOWLI,THETA2,XUPPLI,RE,AE,IFLAG)
C
      THETA=XLOWLI
      A=-1.0/(LOG(1.0-THETA))
      DVARI=A*THETA*(1.0-A*THETA)/(1.0-THETA)**2
      ASYMVA=(1.0/REAL(N))*(THETA**2/DVARI)
C
      IF(IFLAG.EQ.2)THEN
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2211)
 2211   FORMAT('***** WARNING FROM LOGARITHMIC SERIES MAXIMUM ',
     1         'LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2213)
 2213   FORMAT('      ESTIMATE OF THETA VALUE MAY NOT BE COMPUTED ',
     1         'TO DESIRED TOLERANCE.')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IFLAG.EQ.3)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2211)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2223)
 2223   FORMAT('      ESTIMATE OF THETA MAY BE NEAR A SINGULAR POINT.')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IFLAG.EQ.4)THEN
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,2231)
C2231   FORMAT('***** ERROR FROM LOGARITHMIC SERIES MAXIMUM ',
CCCCC1         'LIKELIHOOD--')
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,2233)
C2233   FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
CCCCC   CALL DPWRST('XXX','BUG ')
      ELSEIF(IFLAG.EQ.5)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2211)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2243)
 2243   FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ********************************************
C               **   STEP 42--                            **
C               **   WRITE OUT EVERYTHING                 **
C               **   FOR LOGARITHMIC SERIES MLE ESTIMATE  **
C               ********************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLDL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Logarithmic Series Parameter ',
     1         'Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=300>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5060   FORMAT('         Summary Statistics:')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Mean:')
 5063   FORMAT('         Sample SD:')
 5064   FORMAT('         Sample Minimum:')
 5065   FORMAT('         Sample Maximum:')
 5066   FORMAT('         Maximum Likelihhod Estimates:')
 5067   FORMAT('         Estimate of Shape Parameter Theta:')
 5068   FORMAT('         Estimate of Asymptotic Variance of Theta:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)THETA
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ASYMVA
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Logarithmic Series Parameter ',
     1       'Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Summary Statistics: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8023 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,' & ',I8,2X,A1,A1)
 8028 FORMAT(5X,'Maximum Likelihood Estimates: & ',2X,A1,A1)
 8029 FORMAT(5X,'Estimate of Shape Parameter $',A1,'theta$: & ',
     1       G15.7,2X,A1,A1)
 8030 FORMAT(5X,'Estimate of Asymptotic Variance of $',A1,'theta$: & ',
     1       G15.7,2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC,THETA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC,ASYMVA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{center}')
 8093 FORMAT(A1,'end{table}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4301)
 4301   FORMAT(12X,'LOGARITHMIC SERIES PARAMETER ESTIMATION')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4302)
 4302   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4303)N
 4303   FORMAT('NUMBER OF OBSERVATIONS                    = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4305)XMEAN
 4305   FORMAT('SAMPLE MEAN                               = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4307)XSD
 4307   FORMAT('SAMPLE STANDARD DEVIATION                 = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4309)XMIN
 4309   FORMAT('SAMPLE MINIMUM                            = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4311)XMAX
 4311   FORMAT('SAMPLE MAXIMUM                            = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4320)
 4320   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4321)THETA
 4321   FORMAT('ESTIMATE OF SHAPE PARAMETER THETA         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4323)ASYMVA
 4323   FORMAT('ESTIMATE OF ASYMPTOTIC VARIANCE OF THETA  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4341)
 4341   FORMAT('THETAML WILL BE SAVED AS AN INTERNAL PARAMETER.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLDL')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLDL--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLE(ICASML,ISEED,ILOCES,
     1IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--THIS IS A DUMMY SUBROUTINE
C              FOR FUTURE IMPLEMENTATION
C              OF MAXIMUM LIKELIHOOD CODE.
C
      CHARACTER*4 ICASML
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      RETURN
      END
      SUBROUTINE DPMLE1(Y,TAG,N,
     1XTEMP,MAXNXT,
     1XMIN,SCALE,SCALE2,NUMV,ICENTY,TEND,
     1ICAPSW,ICAPTY,IEXPBC,
     1QP,XQPHAT,XQPLCL,XQPUCL,NPERC,
     1XQPHTZ,XQPLCZ,XQPUCZ,
     1IOUNI1,IOUNI2,ALPHAP,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR EXPONENTIAL DISTRIBUTION
C              FOR THE FULL SAMPLE CASE.
C     EXAMPLE--EXPONENTIAL MAXIMUM LIKELIHOOD Y
C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
C                1999, CHAPTER 12.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/3
C     ORIGINAL VERSION--MARCH     1998.
C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML/LATEX OUTPUT
C     UPDATED         --OCTOBER   2004. SUPPORT FOR BOTH TIME AND
C                                       NUMBER OF FAILURES CENSORING,
C                                       MULTIPLY CENSORED DATA FOR
C                                       TIME CENSORED DATA
C     UPDATED         --OCTOBER   2004. CONFIDENCE INTERVALS FOR
C                                       SELECT PERCENTILES
C     UPDATED         --OCTOBER   2004. SPLIT FULL CASE OUT FROM
C                                       CENSORED CASE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICENTY
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IEXPBC
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      PARAMETER (NUMALP=6)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWU(NUMALP)
      DIMENSION AHIGHU(NUMALP)
      DIMENSION ALOWB(NUMALP)
      DIMENSION AHIGHB(NUMALP)
      DIMENSION A2LOWB(NUMALP)
      DIMENSION A2HGHB(NUMALP)
C
      DIMENSION Y(*)
      DIMENSION TAG(*)
      DIMENSION XTEMP(*)
      DIMENSION XQPHTZ(*)
      DIMENSION XQPLCZ(*)
      DIMENSION XQPUCZ(*)
      DIMENSION QP(*)
      DIMENSION XQPHAT(*)
      DIMENSION XQPLCL(*)
      DIMENSION XQPUCL(*)
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
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='E1  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE1')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLE1--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,NUMV
   55   FORMAT('N,NUMV,NPERC = ',3I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I),TAG(I)
   57     FORMAT('I,Y(I),TAG(I) = ',I8,2E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
        WRITE(ICOUT,59)ICENTY
   59   FORMAT('ICENTY = ',A4)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN EXPONENTIAL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)
 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 1 ',
     1         'IS <= 1')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)N
 1113   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** WARNING FROM EXPONENTIAL MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1132)HOLD
 1132 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
      IF(NPERC.GT.0)THEN
        DO1145I=1,NPERC
          IF(QP(I).LE.0.0 .OR. QP(I).GE.100.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1141)
 1141       FORMAT('***** WARNING IN EXPONENTIAL MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1143)QP(I)
 1143       FORMAT('      REQUESTED PERCENTILE (',G15.7,') IS ',
     1             'OUTSIDE THE (0,100) INTERVAL')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1144)
 1144       FORMAT('      NO PERCENTILE CONFIDENCE LIMITS WILL BE ',
     1             'COMPUTED.')
            CALL DPWRST('XXX','WRIT')
            NPERC=0
          ENDIF
 1145   CONTINUE
      ENDIF
C
 1290 CONTINUE
C
C               **********************************
C               **  STEP 41--                   **
C               **  CARRY OUT CALCULATIONS      **
C               **  FOR EXPONENTIAL MLE         **
C               **  ESTIMATE (FULL SAMPLE CASE) **
C               **********************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      AN=REAL(N)
C
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
C
C  ESTIMATES FOR 1-PARAMETER MODEL
C
      SCALE=XMEAN
      SCALSE=SCALE/SQRT(AN)
C
      NU=2*N
      DO4110I=1,NUMALP
        ALP=ALPHA(I)
        P=1.0-(ALP/2.0)
        CALL CHSPPF(P,NU,PPF1)
        P=ALP/2.0
        CALL CHSPPF(P,NU,PPF2)
        A2LOWB(I)=2.0*AN*SCALE/PPF1
        A2HGHB(I)=2.0*AN*SCALE/PPF2
 4110 CONTINUE
C
      IF(NPERC.GE.1)THEN
C
        NU2=2*N
        ALPHL=ALPHAP/2.0
        ALPHU=1.0 - ALPHAP/2.0
        CALL CHSPPF(ALPHL,NU2,ACHSLL)
        CALL CHSPPF(ALPHU,NU2,ACHSUL)
C
        WRITE(IOUNI1,4131)
        WRITE(IOUNI1,4132)
        DO4119I=1,NPERC
          QPTEMP=QP(I)/100.0
          CALL EXPPPF(QPTEMP,APPF)
          XQPHTZ(I)=SCALE*APPF
          SEXQP=APPF*SCALSE
          ATEMP1=APPF*2.0*AN*SCALE/ACHSUL
          ATEMP2=APPF*2.0*AN*SCALE/ACHSLL
          XQPLCZ(I)=MIN(ATEMP1,ATEMP2)
          XQPUCZ(I)=MAX(ATEMP1,ATEMP2)
          WRITE(IOUNI1,'(3E15.7,2X,E15.7)')
     1         QP(I),XQPHTZ(I),XQPLCZ(I),XQPUCZ(I)
          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLE1')THEN
            WRITE(ICOUT,4133)I,QP(I),XQPHTZ(I),SEXQP,APPF
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4135)ACHSUL,ACHSLL,ATEMP1,ATEMP2
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4137)XQPLCZ(I),XQPUCZ(I)
            CALL DPWRST('XXX','BUG ')
          ENDIF
 4119   CONTINUE
 4131   FORMAT(15X,'       POINT     ','     LOWER     ')
C4131   FORMAT(15X,'       POINT     ','     LOWER     ',
CCCCC1         '     UPPER')
 4132   FORMAT('    PERCENTILE ','     ESTIMATE   ',
CCCCC1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
     1         'CONFIDENCE LIMIT ')
 4133       FORMAT('I,QP(I),XQPHAT(I),SEXQP,APPF = ',I8,4G15.7)
 4135       FORMAT('ACHSUL,ACHSLL,ATEMP1,ATEMP2 = ',4G15.7)
 4137       FORMAT('XQPLCL(I),XQPUCL(I) = ',2G15.7)
      ENDIF
C
C  ESTIMATES FOR 2-PARAMETER MODEL
C
      UHAT=XMIN
      UHATBC=(AN*XMIN - XMEAN)/(AN - 1.0)
      SCALE2=XMEAN-XMIN
      SCA2SE=SCALE2/SQRT(AN - 1.0)
      SCA2BC=AN*(XMEAN - XMIN)/(AN - 1.0)
      SCBCSE=SCA2BC/SQRT(AN - 1.0)
      UHATSE=SCALE2/SQRT(AN*(AN-1.0))
      UHBCSE=SCA2BC/SQRT(AN*(AN-1.0))
C
      IF(IEXPBC.EQ.'ON')THEN
        UTEMP=UHATBC
        SCTEMP=SCA2BC
      ELSE
        UTEMP=UHAT
        SCTEMP=SCALE2
      ENDIF
      NU2=2*(N-1)
      DO4120I=1,NUMALP
        ALP=ALPHA(I)
        P=1.0-(ALP/2.0)
        CALL CHSPPF(P,NU2,PPF3)
        P=ALP/2.0
        CALL CHSPPF(P,NU2,PPF4)
        ALOWB(I)=2.0*AN*SCTEMP/PPF3
        AHIGHB(I)=2.0*AN*SCTEMP/PPF4
        P=1.0-ALP
        ACONS1=(ALP/2.0)**(1.0/(1.0-AN)) - 1.0
        ACONS2=(1.0 - ALP/2.0)**(1.0/(1.0-AN)) - 1.0
        ATEMP1=XMIN - SCTEMP*ACONS1
        ATEMP2=XMIN - SCTEMP*ACONS2
        ALOWU(I)=MIN(ATEMP1,ATEMP2)
        AHIGHU(I)=MAX(ATEMP1,ATEMP2)
 4120 CONTINUE
C
C               **********************************************
C               **  STEP 41B--                              **
C               **  ESTIMATE CONFIDENCE LIMITS FOR SELECTED **
C               **  PERCENTILES.  THE CONFIDENCE LIMITS ON  **
C               **  SIGMA ARE (SL,SU) ARE:                  **
C               **  (2*N*SIGMAHAT/CHSPPF(2N,1-ALPHA/2),     **
C               **   2*N*SIGMAHAT/CHSPPF(2N,1-ALPHA/2))     **
C               **  THEN (XpLCL,XpUCL) IS:                  **
C               **  ((-LN(1 - Xp))*SL,(-LN(1 - Xp))*SU)     **
C               **********************************************
C
      ISTEPN='41B'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C  NOTE: COMMENTED OUT CODE IS 1-PARAMETER MODEL PLUS ESTIMATE
C        OF LOCATION.  FOR 2-PARAMETER MODEL, USE APPROXIMATION
C        FOR LOWER LIMIT GIVEN ON PP. 190-191 OF BURY.
C
      IF(NPERC.GE.1)THEN
C
CCCCC   NU2=2*N
CCCCC   ALPHL=ALPHAP/2.0
CCCCC   ALPHU=1.0 - ALPHAP/2.0
CCCCC   CALL CHSPPF(ALPHL,NU2,ACHSLL)
CCCCC   CALL CHSPPF(ALPHU,NU2,ACHSUL)
C
CCCCC   WRITE(IOUNI2,4131)
C4131   FORMAT(15X,'       POINT     ','     LOWER     ',
CCCCC1         '     UPPER')
CCCCC   WRITE(IOUNI2,4132)
C4132   FORMAT('    PERCENTILE ','     ESTIMATE   ',
CCCCC1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
CCCCC   DO4130I=1,NPERC
CCCCC     QPTEMP=QP(I)/100.0
CCCCC     CALL EXPPPF(QPTEMP,APPF)
CCCCC     XQPHAT(I)=UTEMP + SCTEMP*APPF
CCCCC     SEXQP=APPF*SCA2SE
CCCCC     ATEMP1=APPF*2.0*AN*SCTEMP/ACHSUL
CCCCC     ATEMP2=APPF*2.0*AN*SCTEMP/ACHSLL
CCCCC     XQPLCL(I)=UTEMP + MIN(ATEMP1,ATEMP2)
CCCCC     XQPUCL(I)=UTEMP + MAX(ATEMP1,ATEMP2)
CCCCC     WRITE(IOUNI2,'(3E15.7,2X,E15.7)')
CCCCC1         QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I)
CCCCC     IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLE1')THEN
CCCCC       WRITE(ICOUT,4133)I,QP(I),XQPHAT(I),SEXQP,APPF
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,4135)ACHSUL,ACHSLL,ATEMP1,ATEMP2
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,4137)XQPLCL(I),XQPUCL(I)
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC     ENDIF
C4130   CONTINUE
C
        DSUM1=0.0D0
        DO4140I=1,N
          DSUM1=DSUM1 + DBLE(Y(I))
 4140   CONTINUE
        DS=DSUM1 - DBLE(AN*Y(1))
C
        D1N=DBLE(1.0/AN)
        DN=DBLE(AN)
        D2N=DBLE(1.0D0/(AN-1.0))
        DALPH=DBLE(ALPHAP)
        ALPHL=ALPHAP/2.0
        ALPHU=1.0 - ALPHAP/2.0
C
        WRITE(IOUNI2,4131)
        WRITE(IOUNI2,4132)
        DO4130I=1,NPERC
          QPTEMP=QP(I)/100.0
          CALL EXPPPF(QPTEMP,APPF)
          XQPHAT(I)=UTEMP + SCTEMP*APPF
          DAK=D1N*(1.0D0 - (DBLE(1.0D0 - QPTEMP)**DN/DALPH)**D2N)
          XQPLCL(I)=Y(1) + REAL(DAK*DS)
          WRITE(IOUNI2,'(3E15.7)')
     1         QP(I),XQPHAT(I),XQPLCL(I)
          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLE3')THEN
            WRITE(ICOUT,44133)I,QP(I),XQPHAT(I),DS,DAK
44133       FORMAT('I,QP(I),XQPHAT(I),DS,DAK = ',I8,4G15.7)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,44137)XQPLCL(I)
44137       FORMAT('XQPLCL(I) = ',2G15.7)
            CALL DPWRST('XXX','BUG ')
          ENDIF
 4130   CONTINUE
      ENDIF
C
C               *************************************
C               **   STEP 42--                     **
C               **   WRITE OUT EVERYTHING          **
C               **   FOR EXPONENTIAL MLE ESTIMATE  **
C               *************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE1')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5002   FORMAT('<B>EXPONENTIAL MAXIMUM LIKELIHOOD ESTIMATION:')
 5004   FORMAT('<BR>FULL SAMPLE CASE</B>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>One-Parameter Model (Location = 0)</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=300>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5059   FORMAT('   </TR>')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Minimum Value:')
 5063   FORMAT('         Estimate of Scale Parameter:')
 5064   FORMAT('         Standard Error of Scale Parameter:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Limits for the Scale ',
     1         'Parameter</B>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=3>')
 5162   FORMAT('          <HR>')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        DO5140I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)A2LOWB(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)A2HGHB(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5140   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
C
C  START THE TABLE
C
55317     FORMAT('      <B>Confidence Limits for Selected ',
     1           'Percentiles</B>')
          WRITE(ICOUT,5801)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          WRITE(ICOUT,5811)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5813)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5815)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,55317)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5816)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5819)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5861)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5863)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5864)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5870)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5872)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5847)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          DO55880I=1,NPERC
            WRITE(ICOUT,5841)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)QP(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPHTZ(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPLCZ(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPUCZ(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5859)
            CALL DPWRST('XXX','WRIT')
55880     CONTINUE
C
C  END THE TABLE AND RESET ASIS MODE
C
          WRITE(ICOUT,5891)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5893)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5211   FORMAT('<UL>')
 5213   FORMAT('<TABLE NOBORDER>')
 5215   FORMAT('   <CAPTION ALIGN=CENTER>')
 5217   FORMAT('      <B>Two-Parameter Model (Location Unknown)</B>')
 5219   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5211)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5213)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5215)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5217)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5219)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
C  STEP 4: DEFINE DATA ROW
C
 5241   FORMAT('   <TR>')
 5243   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=350>')
 5247   FORMAT('      </TD>')
 5249   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5251   FORMAT('         ',G15.7)
 5253   FORMAT('         ',I8)
 5255   FORMAT('         ',A8)
 5259   FORMAT('   </TR>')
 5261   FORMAT('         Number of Observations:')
 5262   FORMAT('         Estimate of Location Parameter:')
 5263   FORMAT('         Standard Error of Location Parameter:')
 5264   FORMAT('         Estimate of Scale Parameter:')
 5265   FORMAT('         Standard Error of Scale Parameter:')
 5266   FORMAT('         Bias Corrected Estimate of Location ',
     1           'Parameter:')
 5267   FORMAT('         Standard Error of Bias Corrected Location ',
     1         'Parameter:')
 5268   FORMAT('         Bias Corrected Estimate of Scale ',
     1         'Parameter:')
 5269   FORMAT('         Standard Error of Bias Corrected Scale ',
     1         'Parameter:')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5261)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5253)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5262)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5251)UHAT
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5263)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5251)UHATSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5264)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5251)SCALE2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5265)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5251)SCA2SE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5266)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5251)UHATBC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5267)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5251)UHBCSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5268)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5251)SCA2BC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5269)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5251)SCBCSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5291   FORMAT('</TABLE>')
 5293   FORMAT('</UL>')
        WRITE(ICOUT,5291)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5293)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5311   FORMAT('<UL>')
 5313   FORMAT('<TABLE NOBORDER>')
 5315   FORMAT('   <CAPTION ALIGN=CENTER>')
 5317   FORMAT('      <B>Confidence Limits for the Location ',
     1           'Parameter (Biased Estimate)</B>')
 5318   FORMAT('      <B>Confidence Limits for the Location ',
     1           'Parameter (Bias Corrected Estimate)</B>')
 5319   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5311)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5313)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5315)
        CALL DPWRST('XXX','WRIT')
        IF(IEXPBC.EQ.'OFF')THEN
          WRITE(ICOUT,5317)
        ELSE
          WRITE(ICOUT,5318)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5319)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5321   FORMAT('   <TR>')
 5323   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5325   FORMAT('         Confidence<br>Value (%)')
 5327   FORMAT('      </TH>')
 5329   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5331   FORMAT('         Lower<br>Limit')
 5333   FORMAT('         Upper<br>Limit')
 5339   FORMAT('   </TR>')
 5361   FORMAT('      <TD COLSPAN=3>')
 5362   FORMAT('          <HR>')
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5325)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5329)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5331)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5329)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5333)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5339)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5361)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5362)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5347)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5339)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5341   FORMAT('   <TR>')
 5347   FORMAT('      </TD>')
 5349   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5351   FORMAT('         ',G15.7)
 5359   FORMAT('   </TR>')
        DO5340I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5341)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5351)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5347)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5351)ALOWU(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5347)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5351)AHIGHU(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5347)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5359)
          CALL DPWRST('XXX','WRIT')
 5340   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5391   FORMAT('</TABLE>')
 5393   FORMAT('</UL>')
        WRITE(ICOUT,5391)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5393)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5411   FORMAT('<UL>')
 5413   FORMAT('<TABLE NOBORDER>')
 5415   FORMAT('   <CAPTION ALIGN=CENTER>')
 5417   FORMAT('      <B>Confidence Limits for the Scale ',
     1           'Parameter (Biased Estimate)</B>')
 5418   FORMAT('      <B>Confidence Limits for the Scale ',
     1           'Parameter (Bias Corrected Estimate)</B>')
 5419   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5411)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5413)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5415)
        CALL DPWRST('XXX','WRIT')
        IF(IEXPBC.EQ.'OFF')THEN
          WRITE(ICOUT,5417)
        ELSE
          WRITE(ICOUT,5418)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5419)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5421   FORMAT('   <TR>')
 5423   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5425   FORMAT('         Confidence<br>Value (%)')
 5427   FORMAT('      </TH>')
 5429   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5431   FORMAT('         Lower<br>Limit')
 5433   FORMAT('         Upper<br>Limit')
 5439   FORMAT('   </TR>')
 5461   FORMAT('      <TD COLSPAN=3>')
 5462   FORMAT('          <HR>')
        WRITE(ICOUT,5421)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5423)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5425)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5427)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5429)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5431)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5427)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5429)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5433)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5427)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5439)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5421)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5461)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5462)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5447)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5439)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5441   FORMAT('   <TR>')
 5447   FORMAT('      </TD>')
 5449   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5451   FORMAT('         ',G15.7)
 5459   FORMAT('   </TR>')
        DO5440I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5441)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5449)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5451)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5447)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5449)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5451)ALOWB(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5447)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5449)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5451)AHIGHB(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5447)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5459)
          CALL DPWRST('XXX','WRIT')
 5440   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5491   FORMAT('</TABLE>')
 5493   FORMAT('</UL>')
 5499   FORMAT('<PRE>')
        WRITE(ICOUT,5491)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5493)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5499)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
C
C  START THE TABLE
C
 5801     FORMAT('</PRE>')
 5811     FORMAT('<UL>')
 5813     FORMAT('<TABLE NOBORDER>')
 5815     FORMAT('   <CAPTION ALIGN=CENTER>')
 5816     FORMAT('      <BR><B>Alpha = ',F7.3,'</B>')
 5817     FORMAT('      <B>Confidence Limits for Selected ',
     1           'Percentiles (Biased Estimate)</B>')
 5818     FORMAT('      <B>Confidence Limits for Selected ',
     1           'Percentiles (Bias Corrected Estimate)</B>')
 5819     FORMAT('   </CAPTION>')
          WRITE(ICOUT,5801)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          WRITE(ICOUT,5811)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5813)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5815)
          CALL DPWRST('XXX','WRIT')
          IF(IEXPBC.EQ.'OFF')THEN
            WRITE(ICOUT,5817)
          ELSE
            WRITE(ICOUT,5817)
          ENDIF
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5816)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5819)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5841     FORMAT('   <TR>')
 5843     FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5847     FORMAT('      </TD>')
 5848     FORMAT('      </TH>')
 5849     FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5851     FORMAT('         ',G15.7)
 5859     FORMAT('   </TR>')
 5861     FORMAT('         Percentile')
 5862     FORMAT('         Point <br> Estimate')
 5863     FORMAT('         Lower <br>Confidence Limit')
 5864     FORMAT('         Upper <br>Confidence Limit')
 5870     FORMAT('      <TD COLSPAN=4>')
 5872     FORMAT('         <HR WIDTH=500>')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5861)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5863)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5849)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5864)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5848)
CCCCC     CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5870)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5872)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5847)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          DO5880I=1,NPERC
            WRITE(ICOUT,5841)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)QP(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPHAT(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPLCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,5843)
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,5851)XQPUCL(I)
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,5847)
CCCCC       CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5859)
            CALL DPWRST('XXX','WRIT')
 5880     CONTINUE
C
C  END THE TABLE AND RESET ASIS MODE
C
 5891     FORMAT('</TABLE>')
 5893     FORMAT('</UL>')
 5899     FORMAT('<PRE>')
          WRITE(ICOUT,5891)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5893)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5899)
          CALL DPWRST('XXX','WRIT')
        ENDIF
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001   FORMAT(A1,'end{verbatim}')
 8003   FORMAT(A1,'begin{table}')
 8004   FORMAT(A1,'end{table}')
 8005   FORMAT('{',A1,'bf Exponential Maximum Likelihood ',
     1         'Estimation:}')
 8006   FORMAT('{',A1,'bf Full Sample Case}')
 8007   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009   FORMAT(A1,'begin{center}')
 8011   FORMAT(5X,'{',A1,'bf One-Parameter Model ($',A1,
     1         'mu$ = 0 Case)}')
 8013   FORMAT(A1,'end{center}')
 8015   FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8006)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020   FORMAT(5X,A1,'begin{tabular} {lr}')
 8021   FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022   FORMAT(5X,'Minimum Value: & ',G15.7,2X,A1,A1)
 8023   FORMAT(5X,'Estimate of Scale Parameter: & ',G15.7,2X,A1,A1)
 8024   FORMAT(5X,'Standard Error of Scale Parameter: & ',
     1         G15.7,2X,A1,A1)
 8049   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)SCALE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)SCALSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8093   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for Scale Parameter $',
     1       A1,'beta$}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8111)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper',2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit',2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,2X,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8130I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,A2LOWB(I),A2HGHB(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8130   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8193   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8491)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C WRITE SELECTED PERCENTILES (IF ANY)
C
        IF(NPERC.GT.0)THEN
C
          CALL DPCONA(92,IBASLC)
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8803)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8810)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8812)IBASLC,IBASLC,ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8813)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
88821     FORMAT(5X,' & {',A1,'bf Point} & {',A1,'bf Lower} & {',A1,
     1           'bf Upper}',2X,A1,A1)
88822     FORMAT(5X,'{',A1,'bf Percentile} & {',A1,'bf Estimate} & {',
     1       A1,'bf Confidence Limit} & {',A1,
     1       'bf Confidence Limit}',2X,A1,A1)
88823     FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,' & ',
     1           G15.7,2X,A1,A1)
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8820)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,88821)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,88822)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8840)IBASLC
          CALL DPWRST('XXX','WRIT')
          DO88830I=1,NPERC
            WRITE(ICOUT,88823)QP(I),XQPHTZ(I),XQPLCZ(I),XQPUCZ(I),
     1                       IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
88830     CONTINUE
          WRITE(ICOUT,8849)IBASLC
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8891)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8893)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8207   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8209   FORMAT(A1,'begin{center}')
 8211   FORMAT(5X,'{',A1,'bf Two-Parameter Model ($',
     1         A1,'mu$ Unknown Case)}')
 8213   FORMAT(A1,'end{center}')
 8215   FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8209)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8211)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8207)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8207)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8213)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8220   FORMAT(5X,A1,'begin{tabular} {lr}')
 8221   FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8222   FORMAT(5X,'Estimate of Location Parameter: & ',G15.7,2X,A1,A1)
 8223   FORMAT(5X,'Standard Error of Location Parameter: & ',
     1         G15.7,2X,A1,A1)
 8224   FORMAT(5X,'Estimate of Scale Parameter: & ',G15.7,2X,A1,A1)
 8225   FORMAT(5X,'Standard Error of Scale Parameter: & ',
     1         G15.7,2X,A1,A1)
 8226   FORMAT(5X,'Bias Corrected Estimate of Location Parameter: & ',
     1         G15.7,2X,A1,A1)
 8227   FORMAT(5X,'Standard Error of Bias Corrected Location ',
     1         'Parameter: & ',G15.7,2X,A1,A1)
 8228   FORMAT(5X,'Bias Corrected Estimate of Scale Parameter: & ',
     1         G15.7,2X,A1,A1)
 8229   FORMAT(5X,'Standard Error of Bias Corrected Scale ',
     1         'Parameter: & ',G15.7,2X,A1,A1)
 8249   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8209)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8220)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8221)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8222)UHAT,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8223)UHATSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8224)SCALE2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8225)SCA2SE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8226)UHATBC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8227)UHBCSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8228)SCA2BC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8229)SCBCSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8249)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8293   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8293)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8307   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8309   FORMAT(A1,'begin{center}')
 8311   FORMAT(5X,'{',A1,'bf Confidence Limits for Location ',
     1         'Parameter $',A1,'mu$ (Based on Biased Estimate)}')
 8312   FORMAT(5X,'{',A1,'bf Confidence Limits for Location ',
     1         'Parameter $',A1,
     1         'mu$ (Based on Biased Corrected Estimate)}')
 8313   FORMAT(A1,'end{center}')
 8315   FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8309)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IEXPBC.EQ.'OFF')THEN
          WRITE(ICOUT,8311)IBASLC,IBASLC
        ELSE
          WRITE(ICOUT,8312)IBASLC,IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8307)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8307)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8313)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8320   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8321   FORMAT(5X,'Confidence & Lower & Upper',2X,A1,A1)
 8322   FORMAT(5X,'Value (',A1,'%) & Limit & Limit',2X,A1,A1)
 8331   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,2X,A1,A1)
 8340   FORMAT(5X,A1,'hline')
 8349   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8309)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8320)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8321)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8322)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8340)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8330I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8331)ATEMP,ALOWU(I),AHIGHU(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8330   CONTINUE
        WRITE(ICOUT,8349)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8393   FORMAT(A1,'end{center}')
 8399   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8393)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8403   FORMAT(A1,'begin{table}')
 8407   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8409   FORMAT(A1,'begin{center}')
 8411   FORMAT(5X,'{',A1,'bf Confidence Limits for Scale ',
     1           'Parameter $',A1,'beta$ (Based on Biased Estimate)}')
 8412   FORMAT(5X,'{',A1,'bf Confidence Limits for Scale ',
     1           'Parameter $',A1,
     1           'beta$ (Based on Bias Corrected Estimate)}')
 8413   FORMAT(A1,'end{center}')
 8415   FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8409)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IEXPBC.EQ.'OFF')THEN
          WRITE(ICOUT,8411)IBASLC,IBASLC
        ELSE
          WRITE(ICOUT,8412)IBASLC,IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8407)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8407)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8413)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8420   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8421   FORMAT(5X,'Confidence & Lower & Upper',2X,A1,A1)
 8422   FORMAT(5X,'Value (',A1,'%) & Limit & Limit',2X,A1,A1)
 8431   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,2X,A1,A1)
 8440   FORMAT(5X,A1,'hline')
 8449   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8409)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8420)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8421)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8422)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8440)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8430I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8431)ATEMP,ALOWB(I),AHIGHB(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8430   CONTINUE
        WRITE(ICOUT,8449)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8491   FORMAT(A1,'end{table}')
 8493   FORMAT(A1,'end{center}')
 8499   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8493)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8491)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8801     FORMAT(A1,'end{verbatim}')
 8803     FORMAT(A1,'begin{table}')
 8807     FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8809     FORMAT(A1,'begin{center}')
 8810     FORMAT(5X,'{',A1,'bf Confidence Limits for Selected ',
     1           'Percentiles}')
 8811     FORMAT(5X,'{',A1,'bf (Based on No Bias Correction ',
     1           'Estimate):}')
88811     FORMAT(5X,'{',A1,'bf (Based on Bias Corrected Estimates):}')
 8812     FORMAT(5X,'{',A1,'bf $',A1,'alpha$ = ',F7.3,'}')
 8813     FORMAT(A1,'end{center}')
 8815     FORMAT(5X,'} ',A1,A1)
C
          CALL DPCONA(92,IBASLC)
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8803)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8810)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          IF(IEXPBC.EQ.'OFF')THEN
            WRITE(ICOUT,8811)IBASLC
          ELSE
            WRITE(ICOUT,88811)IBASLC
          ENDIF
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8812)IBASLC,IBASLC,ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8813)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8820     FORMAT(5X,A1,'begin{tabular} {cccc}')
 8821     FORMAT(5X,' & {',A1,'bf Point} & {',A1,'bf Lower}',2X,A1,A1)
 8822     FORMAT(5X,'{',A1,'bf Percentile} & {',A1,'bf Estimate} & {',
     1       A1,'bf Confidence Limit}',
     1       2X,A1,A1)
 8823     FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,
     1           2X,A1,A1)
 8840     FORMAT(5X,A1,'hline')
 8849     FORMAT(A1,'end{tabular}')
C
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8820)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8821)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8822)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8840)IBASLC
          CALL DPWRST('XXX','WRIT')
          DO8830I=1,NPERC
CCCCC       WRITE(ICOUT,8823)QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I),
            WRITE(ICOUT,8823)QP(I),XQPHAT(I),XQPLCL(I),
     1                       IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
 8830     CONTINUE
          WRITE(ICOUT,8849)IBASLC
          CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8891     FORMAT(A1,'end{center}')
 8893     FORMAT(A1,'end{table}')
          WRITE(ICOUT,8891)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8893)IBASLC
          CALL DPWRST('XXX','WRIT')
C
        ENDIF
 8899   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8899)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(6X,'EXPONENTIAL MAXIMUM LIKELIHOOD ESTIMATION: ',
     1         'FULL SAMPLE CASE')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4213)
 4213   FORMAT('ONE-PARAMETER MODEL (LOCATION = 0)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4215)N
 4215   FORMAT('NUMBER OF OBSERVATIONS                = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4217)XMIN
 4217   FORMAT('MINIMUM VALUE                         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4219)SCALE
 4219   FORMAT('ML ESTIMATE OF SCALE PARAMETER        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)SCALSE
 4221   FORMAT('STANDARD ERROR OF SCALE PARAMETER     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4222)
 4222   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)
 4223   FORMAT('   CONFIDENCE           LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)
 4225   FORMAT('   VALUE (%)            LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4226)
 4226   FORMAT('-------------------------------------------')
        CALL DPWRST('XXX','WRIT')
        DO4229I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4227)ATEMP,A2LOWB(I),A2HGHB(I)
 4227     FORMAT('   ',F8.3,10X,3(G12.6,2X))
          CALL DPWRST('XXX','WRIT')
 4229   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,4911)
          CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,4912)
CCCCC     CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4915)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,44921)
44921     FORMAT(10X,'      POINT     ','    LOWER     ',
     1          '       UPPER')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,44922)
44922     FORMAT('PERCENTILE','    ESTIMATE   ',
     1           'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,44916)
44916     FORMAT('---------------',
     1           '-----------------------------------',
     1           '--------')
          CALL DPWRST('XXX','WRIT')
C
          DO4931I=1,NPERC
            WRITE(ICOUT,4932)QP(I),XQPHTZ(I),XQPLCZ(I),XQPUCZ(I)
            CALL DPWRST('XXX','WRIT')
 4931     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,4251)
 4251     FORMAT('THE MINIMUM VALUE WILL BE SAVED AS THE INTERNAL ',
     1           'PARAMETER U1')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4253)
 4253     FORMAT('THE SCALE PARAMETER WILL BE SAVED AS THE ',
     1           'INTERNAL PARAMETER B1')
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4261)
 4261   FORMAT('TWO-PARAMETER MODEL (LOCATION UNKNOWN)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4262)N
 4262   FORMAT('NUMBER OF OBSERVATIONS = ',I8)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4264)UHAT
 4264   FORMAT('ESTIMATE OF LOCATION PARAMETER                      = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4265)UHATSE
 4265   FORMAT('STANDARD ERROR OF LOCATION PARAMETER                = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4266)UHATBC
 4266   FORMAT('BIAS CORRECTED ESTIMATE OF LOCATION PARAMETER       = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4268)UHBCSE
 4268   FORMAT('STANDARD ERROR OF BIAS CORRECTED LOCATION PARAMETER = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4271)SCALE2
 4271   FORMAT('ESTIMATE OF SCALE PARAMETER                         = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4276)SCA2SE
 4276   FORMAT('STANDARD ERROR OF SCALE PARAMETER                   = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4273)SCA2BC
 4273   FORMAT('BIAS CORRECTED ESTIMATE OF SCALE PARAMETER          = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4275)SCBCSE
 4275   FORMAT('STANDARD ERROR OF BIAS CORRECTED SCALE PARAMETER    = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4267)
        CALL DPWRST('XXX','WRIT')
        IF(IEXPBC.EQ.'ON')THEN
          WRITE(ICOUT,44267)
          CALL DPWRST('XXX','WRIT')
        ENDIF
 4267   FORMAT('CONFIDENCE INTERVAL FOR LOCATION PARAMETER')
44267   FORMAT('(BASED ON BIAS CORRECTED ESTIMATES)')
C
        WRITE(ICOUT,4223)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4226)
        CALL DPWRST('XXX','WRIT')
        DO4269I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4227)ATEMP,ALOWU(I),AHIGHU(I)
          CALL DPWRST('XXX','WRIT')
 4269   CONTINUE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4277)
 4277   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        IF(IEXPBC.EQ.'ON')THEN
          WRITE(ICOUT,44277)
44277     FORMAT('(BASED ON BIAS CORRECTED ESTIMATES)')
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,4223)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4226)
        CALL DPWRST('XXX','WRIT')
        DO4279I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4227)ATEMP,ALOWB(I),AHIGHB(I)
          CALL DPWRST('XXX','WRIT')
 4279   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,4911)
 4911     FORMAT('CONFIDENCE LIMITS FOR SELECTED PERCENTILES:')
          CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,4912)
C4912     FORMAT('FULL SAMPLE CASE')
CCCCC     CALL DPWRST('XXX','WRIT')
          IF(IEXPBC.EQ.'OFF')THEN
            WRITE(ICOUT,4913)
          ELSE
            WRITE(ICOUT,4914)
          ENDIF
 4913     FORMAT('(BASED ON BIASED ESTIMATES)')
 4914     FORMAT('(BASED ON BIAS CORRECTED ESTIMATES)')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4915)ALPHAP
 4915     FORMAT('ALPHA = ',F7.4)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4921)
 4921     FORMAT(10X,'      POINT     ','     LOWER     ')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4922)
 4922     FORMAT('PERCENTILE','   ESTIMATE     ',
CCCCC1           'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
     1           'CONFIDENCE LIMIT ')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4916)
 4916     FORMAT('---------------',
     1           '---------------------------')
          CALL DPWRST('XXX','WRIT')
C
          DO4930I=1,NPERC
CCCCC       WRITE(ICOUT,4932)QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I)
            WRITE(ICOUT,4932)QP(I),XQPHAT(I),XQPLCL(I)
 4932       FORMAT(2X,F8.4,G15.7,2X,G15.7,2X,G15.7)
            CALL DPWRST('XXX','WRIT')
 4930     CONTINUE
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IF(IFEEDB.EQ.'ON')THEN
          IF(NPERC.GT.0)THEN
            WRITE(ICOUT,4943)
 4943       FORMAT('PERCENTILE CONFIDENCE LIMITS BASED ON 1-PARAMETER',
     1             ' WRITTEN TO FILE  dpst1f.dat')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4944)
 4944       FORMAT('PERCENTILE CONFIDENCE LIMITS BASED ON 2-PARAMETER',
     1             ' WRITTEN TO FILE  dpst2f.dat')
            CALL DPWRST('XXX','BUG ')
          ENDIF
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4281)
 4281     FORMAT('THE LOCATION PARAMETER WILL BE SAVED AS THE ',
     1           'INTERNAL PARAMETER U2')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4283)
 4283     FORMAT('THE SCALE PARAMETER WILL BE SAVED AS THE ',
     1           'INTERNAL PARAMETER B2')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE1')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLE1--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLE2(Y,TAG,N,
     1XTEMP,MAXNXT,
     1XMIN,SCALE,SCALE2,NUMV,ICENTY,TEND,
     1ICAPSW,ICAPTY,
     1QP,XQPHAT,XQPLCL,XQPUCL,NPERC,
     1XQPHTZ,XQPLCZ,XQPUCZ,
     1IOUNI1,IOUNI2,ALPHAP,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR EXPONENTIAL DISTRIBUTION
C              FOR THE TIME CENSORED (TYPE I, EITHER SINGLY OR
C              MULTIPLY CENSORED) CASE.
C     EXAMPLE--EXPONENTIAL MAXIMUM LIKELIHOOD Y X
C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
C                1999, CHAPTER 12.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/3
C     ORIGINAL VERSION--MARCH     1998.
C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML/LATEX OUTPUT
C     UPDATED         --OCTOBER   2004. SUPPORT FOR BOTH TIME AND
C                                       NUMBER OF FAILURES CENSORING,
C                                       MULTIPLY CENSORED DATA FOR
C                                       TIME CENSORED DATA
C     UPDATED         --OCTOBER   2004. CONFIDENCE INTERVALS FOR
C                                       SELECT PERCENTILES
C     UPDATED         --OCTOBER   2004. SPLIT FULL SAMPLE AND CENSORED
C                                       CASES INTO DISTINCT
C                                       SUBROUTINES
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICENTY
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 ICASE
C
C---------------------------------------------------------------------
C
      PARAMETER (NUMALP=6)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWU(NUMALP)
      DIMENSION AHIGHU(NUMALP)
      DIMENSION ALOWB(NUMALP)
      DIMENSION AHIGHB(NUMALP)
      DIMENSION A2LOWB(NUMALP)
      DIMENSION A2HGHB(NUMALP)
      DIMENSION A3LOWB(NUMALP)
      DIMENSION A3HGHB(NUMALP)
C
      DIMENSION Y(*)
      DIMENSION TAG(*)
      DIMENSION XTEMP(*)
      DIMENSION XQPHTZ(*)
      DIMENSION XQPLCZ(*)
      DIMENSION XQPUCZ(*)
      DIMENSION QP(*)
      DIMENSION XQPHAT(*)
      DIMENSION XQPLCL(*)
      DIMENSION XQPUCL(*)
C
      DOUBLE PRECISION DN
      DOUBLE PRECISION D1N
      DOUBLE PRECISION D2R
      DOUBLE PRECISION DS
      DOUBLE PRECISION DAK
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DALPH
      DOUBLE PRECISION XLOW
      DOUBLE PRECISION XUP
C
      DOUBLE PRECISION AE
      DOUBLE PRECISION RE
C
      DOUBLE PRECISION DK
      DOUBLE PRECISION DR
      DOUBLE PRECISION SHAT
      DOUBLE PRECISION XSUM
      DOUBLE PRECISION DC
      COMMON/EXPCOM/DK,DR,SHAT,XSUM,DC
      DOUBLE PRECISION EXPFUN
      EXTERNAL EXPFUN
C
      EXTERNAL SUM
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
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='E1  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLE2--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,NUMV
   55   FORMAT('N,NUMV,NPERC = ',3I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I),TAG(I)
   57     FORMAT('I,Y(I),TAG(I) = ',I8,2E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
        WRITE(ICOUT,59)ICENTY
   59   FORMAT('ICENTY = ',A4)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN EXPONENTIAL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)
 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 1 ',
     1         'IS <= 1')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)N
 1113   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** WARNING FROM EXPONENTIAL MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1132)HOLD
 1132 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
      IF(NPERC.GT.0)THEN
        DO1145I=1,NPERC
          IF(QP(I).LE.0.0 .OR. QP(I).GE.100.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1141)
 1141       FORMAT('***** WARNING IN EXPONENTIAL MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1143)QP(I)
 1143       FORMAT('      REQUESTED PERCENTILE (',G15.7,') IS ',
     1             'OUTSIDE THE (0,100) INTERVAL')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1144)
 1144       FORMAT('      NO PERCENTILE CONFIDENCE LIMITS WILL BE ',
     1             'COMPUTED.')
            CALL DPWRST('XXX','WRIT')
            NPERC=0
          ENDIF
 1145   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 21--                             **
C               **  CHECK THE CENSORING VARIABLE: SHOULD  **
C               **  BE AT MOST 2 DISTINCT VALUES, 1       **
C               **  INDICATES FAILURE TIME, 0 INDICATES   **
C               **  CENSORING TIME.                       **
C               ********************************************
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC OCTOBER 2004.  FOR CENSORED CASE, CHECK THAT SECOND VARIABLE
CCCCC                CONTAINS TWO DISTINCT VALUES, SET TO 1 AND 0.
C
      CALL DISTIN(TAG,N,IWRITE,XTEMP,NDIST,IBUGA3,IERROR)
      IF(NDIST.EQ.1)THEN
        DO2102I=1,N
          TAG(I)=1.0
 2102   CONTINUE
      ELSEIF(NDIST.EQ.2)THEN
        IF(XTEMP(1).EQ.1.0 .OR. XTEMP(2).EQ.1.0)THEN
          DO2103I=1,N
            IF(TAG(I).NE.1.0)TAG(I)=0.0
 2103     CONTINUE
        ELSE
          ATEMP1=MIN(XTEMP(1),XTEMP(2))
          ATEMP2=MAX(XTEMP(1),XTEMP(2))
          DO2108I=1,N
            IF(TAG(I).EQ.ATEMP1)TAG(I)=1.0
            IF(TAG(I).EQ.ATEMP2)TAG(I)=0.0
 2108     CONTINUE
        ENDIF
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2104)
 2104   FORMAT('***** ERROR IN EXPONENTIAL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2105)
 2105   FORMAT('      FOR CENSORED DATA, THE CENSORING VARIABLE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2106)
 2106   FORMAT('      SHOULD CONTAIN AT MOST TWO DISTINCT VALUES.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2107)NDIST
 2107   FORMAT('      ',I8,' DISTINCT VALUES FOUND.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      CALL SORTC(Y,TAG,N,Y,TAG)
      IR=0
      DO2120I=1,N
        IF(TAG(I).EQ.1.0)IR=IR+1
 2120 CONTINUE
      IM=N-IR
C
      DR=DBLE(IR)
C
      IF(IM.EQ.0)THEN
        ICASE='NONE'
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2131)
 2131   FORMAT('***** WARNING FROM EXPONENTIAL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2133)
 2133   FORMAT('      NO CENSORING TIMES DETECTED.  IT IS RECOMMENDED')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2135)
 2135   FORMAT('      THAT THE FULL SAMPLE SYNTAX BE USED:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2137)
 2137   FORMAT('      EXPONENTIAL MAXIMUM LIKELIHOOD  Y')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSE
        ICASE='SING'
        AHOLD=Y(IR+1)
        DO2140I=IR+1,N
          IF(Y(I).NE.AHOLD)THEN
            ICASE='MULT'
            GOTO2149
          ENDIF
 2140   CONTINUE
 2149   CONTINUE
      ENDIF
C
C               ************************************
C               **  STEP 41--                     **
C               **  CARRY OUT CALCULATIONS        **
C               **  FOR EXPONENTIAL MLE           **
C               **  ESTIMATE (TIME CENSORED CASE) **
C               ************************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      AN=REAL(N)
      AR=REAL(IR)
      AM=REAL(IM)
C
      CALL SUM(Y,N,IWRITE,YSUM,IBUGA3,IERROR)
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
C
C  ESTIMATES FOR 1-PARAMETER MODEL
C
      SCALE=YSUM/AR
      SCALSE=SCALE/SQRT(AR)
      SHAT=DBLE(SCALE)
      NUTEMP=1
      AE=1.D-7
      RE=1.D-7
      XSUM=DBLE(YSUM)
      DC=2.0D0*(-DR*DLOG(SHAT) - XSUM/SHAT)
C
      DO4110I=1,NUMALP
        ALP=ALPHA(I)
        P=1.0-(ALP/2.0)
        CALL NORPPF(P,ZP)
        CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
        DK=DBLE(APPF)
C
C  NOW COMPUTE NORMAL APPROXIMATION INTERVAL (USE AS
C  STARTING VALUE FOR LIKELIHOOD RATIO METHOD).
C
        SLNOR=SCALE - ZP*SCALSE
        SUNOR=SCALE + ZP*SCALSE
C
C  NOW COMPUTE LIKELIHOOD RATIO BASED INTERVAL
C
        XLOW=DBLE(XMIN)
        XUP=DBLE(SCALE)
        CALL DFZERO(EXPFUN,XLOW,XUP,DBLE(SLNOR),RE,AE,IFLAG)
        A3LOWB(I)=XLOW
        A2LOWB(I)=SLNOR
C
        XLOW=DBLE(SCALE)
        XUP=1.3D0*DBLE(SUNOR)
        CALL DFZERO(EXPFUN,XLOW,XUP,DBLE(SUNOR),RE,AE,IFLAG)
        A3HGHB(I)=XLOW
        A2HGHB(I)=SUNOR
 4110 CONTINUE
C
C               **********************************************
C               **  STEP 41A--                              **
C               **  ESTIMATE CONFIDENCE LIMITS FOR SELECTED **
C               **  PERCENTILES.  COMPUTE THE LOWER         **
C               **  CONFIDENCE INTERVAL GIVEN ON PP. 190-191**
C               **  OF BURY.  NOTE THAT THIS APPROXIMATION  **
C               **  IS FOR THE SINGLY CENSORED CASE ONLY.   **
C               **  NO FORMULA IS GIVEN FOR THE MULTIPLY    **
C               **  CENSORED CASE.  USE THE 2-PARAMETER     **
C               **  CASE WITH X(1) = 0.                     **
C               **********************************************
C
      ISTEPN='41A'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NPERC.GE.1)THEN
C
        DSUM1=0.0D0
        DO4112I=1,N
          DSUM1=DSUM1 + DBLE(Y(I))
 4112   CONTINUE
        DS=DSUM1 + DBLE(AN*XMIN)
C
        D1N=DBLE(1.0/AN)
        DN=DBLE(AN)
        DR=DBLE(AR)
        D2R=DBLE(1.0D0/(AR+0.5-1.0))
        DALPH=DBLE(ALPHAP)
        ALPHL=ALPHAP/2.0
        ALPHU=1.0 - ALPHAP/2.0
C
        WRITE(IOUNI1,4131)
        WRITE(IOUNI1,4132)
        DO4115I=1,NPERC
          QPTEMP=QP(I)/100.0
          CALL EXPPPF(QPTEMP,APPF)
          XQPHTZ(I)=SCALE*APPF
          DAK=D1N*(1.0D0 - (DBLE(1.0D0 - QPTEMP)**DN/DALPH)**D2R)
          XQPLCZ(I)=REAL(DAK*DS)
          WRITE(IOUNI1,'(3E15.7)')
     1         QP(I),XQPHTZ(I),XQPLCZ(I)
          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLE2')THEN
            WRITE(ICOUT,4133)I,QP(I),XQPHTZ(I),DS,DAK
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4137)XQPLCZ(I)
            CALL DPWRST('XXX','BUG ')
          ENDIF
 4115   CONTINUE
      ENDIF
C
C  ESTIMATES FOR 2-PARAMETER MODEL
C
C  NOTE THAT THERE IS NO SIMPLE FORMULA FOR THE STANDARD ERROR
C  OF LOCATION PARAMETER.
C
      UHAT=XMIN
      UHATSE=CPUMIN
      DSUM1=0.0D0
      DO4120I=1,N
        DSUM1=DSUM1 + DBLE(Y(I) - XMIN)
 4120 CONTINUE
      SCALE2=REAL(DSUM1/DBLE(IR))
      SCA2SE=SCALE2/SQRT(AR)
C
      NU2=2*IR-1
      DO4125I=1,NUMALP
        ALP=ALPHA(I)
        P=1.0-(ALP/2.0)
        CALL CHSPPF(P,NU2,PPF3)
        P=ALP/2.0
        CALL CHSPPF(P,NU2,PPF4)
        ALOWB(I)=2.0*AR*SCALE2/PPF3
        AHIGHB(I)=2.0*AR*SCALE2/PPF4
        ACONS1=(ALP/2.0)**(2.0/(1.0-2.0*AR)) - 1.0
        ACONS2=(1.0 - ALP/2.0)**(2.0/(1.0-2.0*AR)) - 1.0
        ATEMP1=XMIN - SCALE2*(AR/AN)*ACONS1
        ATEMP2=XMIN - SCALE2*(AR/AN)*ACONS2
        ALOWU(I)=MIN(ATEMP1,ATEMP2)
        AHIGHU(I)=MAX(ATEMP1,ATEMP2)
 4125 CONTINUE
C
C               **********************************************
C               **  STEP 41B--                              **
C               **  ESTIMATE CONFIDENCE LIMITS FOR SELECTED **
C               **  PERCENTILES.  COMPUTE THE LOWER         **
C               **  CONFIDENCE INTERVAL GIVEN ON PP. 190-191**
C               **  OF BURY.  NOTE THAT THIS APPROXIMATION  **
C               **  IS FOR THE SINGLY CENSORED CASE ONLY.   **
C               **  NO FORMULA IS GIVEN FOR THE MULTIPLY    **
C               **  CENSORED CASE.                          **
C               **********************************************
C
      ISTEPN='41B'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NPERC.GE.1)THEN
C
        DSUM1=0.0D0
        DO4140I=1,N
          DSUM1=DSUM1 + DBLE(Y(I))
 4140   CONTINUE
        DS=DSUM1 - DBLE(AN*XMIN)
C
        D1N=DBLE(1.0/AN)
        DN=DBLE(AN)
        DR=DBLE(AR)
        D2R=DBLE(1.0D0/(AR+0.5-1.0))
        DALPH=DBLE(ALPHAP)
        ALPHL=ALPHAP/2.0
        ALPHU=1.0 - ALPHAP/2.0
C
        WRITE(IOUNI2,4131)
 4131   FORMAT(15X,'       POINT     ','     LOWER     ')
C4131   FORMAT(15X,'       POINT     ','     LOWER     ',
CCCCC1         '     UPPER')
        WRITE(IOUNI2,4132)
 4132   FORMAT('    PERCENTILE ','     ESTIMATE   ',
CCCCC1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
     1         'CONFIDENCE LIMIT ')
        DO4130I=1,NPERC
          QPTEMP=QP(I)/100.0
          CALL EXPPPF(QPTEMP,APPF)
          XQPHAT(I)=UHAT + SCALE2*APPF
          DAK=D1N*(1.0D0 - (DBLE(1.0D0 - QPTEMP)**DN/DALPH)**D2R)
          XQPLCL(I)=UHAT + REAL(DAK*DS)
CCCCC     XQPUCL(I)=UHAT + MAX(ATEMP1,ATEMP2)
          WRITE(IOUNI2,'(3E15.7)')QP(I),XQPHAT(I),XQPLCL(I)
          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLE2')THEN
            WRITE(ICOUT,4133)I,QP(I),XQPHAT(I),DS,DAK
 4133       FORMAT('I,QP(I),XQPHAT(I),DS,DAK = ',I8,4G15.7)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4137)XQPLCL(I)
 4137       FORMAT('XQPLCL(I) = ',2G15.7)
            CALL DPWRST('XXX','BUG ')
          ENDIF
 4130   CONTINUE
      ENDIF
C
C               *************************************
C               **   STEP 42--                     **
C               **   WRITE OUT EVERYTHING          **
C               **   FOR EXPONENTIAL MLE ESTIMATE  **
C               *************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE2')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5002   FORMAT('<B>EXPONENTIAL MAXIMUM LIKELIHOOD ESTIMATION:')
 5004   FORMAT('<BR>MULTIPLY TIME CENSORED CASE</B>')
 5005   FORMAT('<BR>SINGLY TIME CENSORED CASE</B>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
        CALL DPWRST('XXX','WRIT')
        IF(ICASE.EQ.'MULT')THEN
          WRITE(ICOUT,5004)
        ELSE
          WRITE(ICOUT,5005)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>One-Parameter Model (Location = 0)</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=300>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=200>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5059   FORMAT('   </TR>')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Minimum Value:')
 5063   FORMAT('         Estimate of Scale Parameter:')
 5064   FORMAT('         Standard Error of Scale Parameter:')
 5065   FORMAT('         Number of Failure Times:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)IR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Limits for the Scale ',
     1         'Parameter</B>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5134   FORMAT('         &nbsp;')
 5136   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM COLSPAN=2>')
 5137   FORMAT('         Normal Approximation')
 5138   FORMAT('         Likelihood Ratio')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=5>')
 5162   FORMAT('          <HR>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5138)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        DO5140I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)A2LOWB(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)A2HGHB(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)A3LOWB(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)A3HGHB(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5140   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
C
C  START THE TABLE
C
          WRITE(ICOUT,999)
          WRITE(ICOUT,5811)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5813)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5815)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5817)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5816)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5819)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5861)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5863)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5849)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5864)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5848)
CCCCC     CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5870)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5872)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5847)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          DO55880I=1,NPERC
            WRITE(ICOUT,5841)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)QP(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPHTZ(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPLCZ(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,5843)
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,5851)XQPUCZ(I)
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,5847)
CCCCC       CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5859)
            CALL DPWRST('XXX','WRIT')
55880     CONTINUE
C
C  END THE TABLE AND RESET ASIS MODE
C
          WRITE(ICOUT,5891)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5893)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5211   FORMAT('<UL>')
 5213   FORMAT('<TABLE NOBORDER>')
 5215   FORMAT('   <CAPTION ALIGN=CENTER>')
 5217   FORMAT('      <B>Two-Parameter Model (Location Unknown)</B>')
 5219   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5211)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5213)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5215)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5217)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5219)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
C  STEP 4: DEFINE DATA ROW
C
 5241   FORMAT('   <TR>')
 5243   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=300>')
 5247   FORMAT('      </TD>')
 5249   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=200>')
 5251   FORMAT('         ',G15.7)
 5253   FORMAT('         ',I8)
 5255   FORMAT('         ',A8)
 5259   FORMAT('   </TR>')
 5261   FORMAT('         Number of Observations:')
 5262   FORMAT('         Estimate of Location Parameter:')
 5263   FORMAT('         Standard Error of Location Parameter:')
 5264   FORMAT('         Estimate of Scale Parameter:')
 5265   FORMAT('         Standard Error of Scale Parameter:')
 5266   FORMAT('         Number of Failure Times:')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5261)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5253)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5266)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5253)IR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5262)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5251)UHAT
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5241)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5243)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5263)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5247)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5249)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5251)UHATSE
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5247)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5259)
CCCCC   CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5264)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5251)SCALE2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5265)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5251)SCA2SE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5241)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5243)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5266)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5247)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5249)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5251)UHATBC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5247)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5259)
CCCCC   CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5241)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5243)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5267)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5247)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5249)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5251)UHBCSE
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5247)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5259)
CCCCC   CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5241)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5243)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5268)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5247)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5249)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5251)SCA2BC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5247)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5259)
CCCCC   CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5241)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5243)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5269)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5247)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5249)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5251)SCBCSE
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5247)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5259)
CCCCC   CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5291   FORMAT('</TABLE>')
 5293   FORMAT('</UL>')
        WRITE(ICOUT,5291)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5293)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5311   FORMAT('<UL>')
 5313   FORMAT('<TABLE NOBORDER>')
 5315   FORMAT('   <CAPTION ALIGN=CENTER>')
 5317   FORMAT('      <B>Confidence Limits for the Location ',
     1           'Parameter</B>')
 5319   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5311)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5313)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5315)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5317)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5319)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5321   FORMAT('   <TR>')
 5323   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5325   FORMAT('         Confidence<br>Value (%)')
 5327   FORMAT('      </TH>')
 5329   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5331   FORMAT('         Lower<br>Limit')
 5333   FORMAT('         Upper<br>Limit')
 5339   FORMAT('   </TR>')
 5361   FORMAT('      <TD COLSPAN=3>')
 5362   FORMAT('          <HR>')
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5325)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5329)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5331)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5329)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5333)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5339)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5361)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5362)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5347)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5339)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5341   FORMAT('   <TR>')
 5347   FORMAT('      </TD>')
 5349   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5351   FORMAT('         ',G15.7)
 5359   FORMAT('   </TR>')
        DO5340I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5341)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5351)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5347)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5351)ALOWU(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5347)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5351)AHIGHU(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5347)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5359)
          CALL DPWRST('XXX','WRIT')
 5340   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5391   FORMAT('</TABLE>')
 5393   FORMAT('</UL>')
        WRITE(ICOUT,5391)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5393)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5411   FORMAT('<UL>')
 5413   FORMAT('<TABLE NOBORDER>')
 5415   FORMAT('   <CAPTION ALIGN=CENTER>')
 5417   FORMAT('      <B>Confidence Limits for the Scale ',
     1           'Parameter</B>')
 5419   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5411)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5413)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5415)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5417)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5419)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5421   FORMAT('   <TR>')
 5423   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5425   FORMAT('         Confidence<br>Value (%)')
 5427   FORMAT('      </TH>')
 5429   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5431   FORMAT('         Lower<br>Limit')
 5433   FORMAT('         Upper<br>Limit')
 5439   FORMAT('   </TR>')
 5461   FORMAT('      <TD COLSPAN=3>')
 5462   FORMAT('          <HR>')
        WRITE(ICOUT,5421)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5423)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5425)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5427)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5429)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5431)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5427)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5429)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5433)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5427)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5439)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5421)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5461)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5462)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5447)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5439)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5441   FORMAT('   <TR>')
 5447   FORMAT('      </TD>')
 5449   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5451   FORMAT('         ',G15.7)
 5459   FORMAT('   </TR>')
        DO5440I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5441)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5449)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5451)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5447)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5449)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5451)ALOWB(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5447)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5449)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5451)AHIGHB(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5447)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5459)
          CALL DPWRST('XXX','WRIT')
 5440   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5491   FORMAT('</TABLE>')
 5493   FORMAT('</UL>')
        WRITE(ICOUT,5491)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5493)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
C
C  START THE TABLE
C
 5801     FORMAT('</PRE>')
 5811     FORMAT('<UL>')
 5813     FORMAT('<TABLE NOBORDER>')
 5815     FORMAT('   <CAPTION ALIGN=CENTER>')
 5816     FORMAT('      <BR><B>Alpha = ',F7.3,'</B>')
 5817     FORMAT('      <B>Confidence Limits for Selected ',
     1           'Percentiles</B>')
 5819     FORMAT('   </CAPTION>')
          WRITE(ICOUT,999)
          WRITE(ICOUT,5811)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5813)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5815)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5817)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5816)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5819)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5841     FORMAT('   <TR>')
 5843     FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5847     FORMAT('      </TD>')
 5848     FORMAT('      </TH>')
 5849     FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5851     FORMAT('         ',G15.7)
 5859     FORMAT('   </TR>')
 5861     FORMAT('         Percentile')
 5862     FORMAT('         Point <br> Estimate')
 5863     FORMAT('         Lower <br>Confidence Limit')
C5864     FORMAT('         Upper <br>Confidence Limit')
 5870     FORMAT('      <TD COLSPAN=4>')
 5872     FORMAT('         <HR WIDTH=500>')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5861)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5863)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5849)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5864)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5848)
CCCCC     CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5870)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5872)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5847)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          DO5880I=1,NPERC
            WRITE(ICOUT,5841)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)QP(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPHAT(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPLCL(I)
            CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,5847)
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,5843)
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,5851)XQPUCL(I)
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,5847)
CCCCC       CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5859)
            CALL DPWRST('XXX','WRIT')
 5880     CONTINUE
C
C  END THE TABLE AND RESET ASIS MODE
C
 5891     FORMAT('</TABLE>')
 5893     FORMAT('</UL>')
 5899     FORMAT('<PRE>')
          WRITE(ICOUT,5891)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5893)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5899)
          CALL DPWRST('XXX','WRIT')
        ENDIF
 5499   FORMAT('<PRE>')
        WRITE(ICOUT,5499)
        CALL DPWRST('XXX','WRIT')
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001   FORMAT(A1,'end{verbatim}')
 8003   FORMAT(A1,'begin{table}')
 8004   FORMAT(A1,'end{table}')
 8005   FORMAT('{',A1,'bf Exponential Maximum Likelihood Estimation:}')
 8006   FORMAT('{',A1,'bf Time (Singly) Censored Case}')
88006   FORMAT('{',A1,'bf Time (Multiply) Censored Case}')
 8007   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009   FORMAT(A1,'begin{center}')
 8011   FORMAT(5X,'{',A1,'bf One-Parameter Model ($',A1,
     1         'mu$ = 0 Case)}')
 8013   FORMAT(A1,'end{center}')
 8015   FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(ICASE.EQ.'SING')THEN
          WRITE(ICOUT,8006)IBASLC
        ELSE
          WRITE(ICOUT,88006)IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020   FORMAT(5X,A1,'begin{tabular} {lr}')
 8021   FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022   FORMAT(5X,'Minimum Value: & ',G15.7,2X,A1,A1)
 8023   FORMAT(5X,'Estimate of Scale Parameter: & ',G15.7,2X,A1,A1)
 8024   FORMAT(5X,'Standard Error of Scale Parameter: & ',
     1         G15.7,2X,A1,A1)
 8025   FORMAT(5X,'Number of Failure Times: & ',I8,2X,A1,A1)
 8049   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)IR,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)SCALE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)SCALSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8093   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for Scale Parameter $',
     1       A1,'beta$}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8111)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8116   FORMAT(5X,'& ',A1,'multicolumn{2}{c}{Normal Approximation}',
     1         ' & ',A1,'multicolumn{2}{c}{Likelihood Ratio}',
     1         2X,A1,A1)
 8120   FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper & Lower & Upper ',
     1         2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit & Limit & Limit',
     1         2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,' & ',G15.7,' & ',
     1         G15.7,2X,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8116)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8130I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,A2LOWB(I),A2HGHB(I),A3LOWB(I),
     1                     A3HGHB(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8130   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8193)IBASLC
 8193   FORMAT(A1,'end{center}')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C WRITE SELECTED PERCENTILES (IF ANY)
C
        IF(NPERC.GT.0)THEN
C
          CALL DPCONA(92,IBASLC)
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8803)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8810)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8812)IBASLC,IBASLC,ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8813)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8820)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8821)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8822)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8840)IBASLC
          CALL DPWRST('XXX','WRIT')
          DO88830I=1,NPERC
CCCCC       WRITE(ICOUT,8823)QP(I),XQPHTZ(I),XQPLCZ(I),XQPUCZ(I),
            WRITE(ICOUT,8823)QP(I),XQPHTZ(I),XQPLCZ(I),
     1                       IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
88830     CONTINUE
          WRITE(ICOUT,8849)IBASLC
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8891)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8893)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8207   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8209   FORMAT(A1,'begin{center}')
 8211   FORMAT(5X,'{',A1,'bf Two-Parameter Model ($',
     1         A1,'mu$ Unknown Case)}')
 8213   FORMAT(A1,'end{center}')
 8215   FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8209)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8211)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8207)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8207)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8213)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8220   FORMAT(5X,A1,'begin{tabular} {lr}')
 8221   FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8222   FORMAT(5X,'Estimate of Location Parameter: & ',G15.7,2X,A1,A1)
C8223   FORMAT(5X,'Standard Error of Location Parameter: & ',
C    1         G15.7,2X,A1,A1)
 8224   FORMAT(5X,'Estimate of Scale Parameter: & ',G15.7,2X,A1,A1)
 8225   FORMAT(5X,'Standard Error of Scale Parameter: & ',
     1         G15.7,2X,A1,A1)
 8226   FORMAT(5X,'Number of Failure Times: & ',I8,2X,A1,A1)
 8249   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8209)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8220)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8221)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8226)IR,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8222)UHAT,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8223)UHATSE,IBASLC,IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8224)SCALE2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8225)SCA2SE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8249)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8293   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8293)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8307   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8309   FORMAT(A1,'begin{center}')
 8311   FORMAT(5X,'{',A1,'bf Confidence Limits for Location ',
     1         'Parameter $',A1,'mu$}')
 8313   FORMAT(A1,'end{center}')
 8315   FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8309)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8311)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8307)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8307)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8313)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8320   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8321   FORMAT(5X,'Confidence & Lower & Upper',2X,A1,A1)
 8322   FORMAT(5X,'Value (',A1,'%) & Limit & Limit',2X,A1,A1)
 8331   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,2X,A1,A1)
 8340   FORMAT(5X,A1,'hline')
 8349   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8309)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8320)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8321)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8322)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8340)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8330I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8331)ATEMP,ALOWU(I),AHIGHU(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8330   CONTINUE
        WRITE(ICOUT,8349)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8393   FORMAT(A1,'end{center}')
 8399   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8393)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8403   FORMAT(A1,'begin{table}')
 8407   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8409   FORMAT(A1,'begin{center}')
 8411   FORMAT(5X,'{',A1,'bf Confidence Limits for Scale ',
     1           'Parameter $',A1,'beta$}')
 8413   FORMAT(A1,'end{center}')
 8415   FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8409)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8411)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8407)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8407)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8413)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8420   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8421   FORMAT(5X,'Confidence & Lower & Upper',2X,A1,A1)
 8422   FORMAT(5X,'Value (',A1,'%) & Limit & Limit',2X,A1,A1)
 8431   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,2X,A1,A1)
 8440   FORMAT(5X,A1,'hline')
 8449   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8409)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8420)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8421)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8422)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8440)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8430I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8431)ATEMP,ALOWB(I),AHIGHB(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8430   CONTINUE
        WRITE(ICOUT,8449)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8491   FORMAT(A1,'end{table}')
 8493   FORMAT(A1,'end{center}')
 8499   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8493)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8491)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8801     FORMAT(A1,'end{verbatim}')
 8803     FORMAT(A1,'begin{table}')
 8807     FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8809     FORMAT(A1,'begin{center}')
 8810     FORMAT(5X,'{',A1,'bf Confidence Limits for Selected ',
     1           'Percentiles:}',2X,A1,A1)
 8812     FORMAT(5X,'{',A1,'bf $',A1,'alpha$ = ',F7.3,'}')
 8813     FORMAT(A1,'end{center}')
 8815     FORMAT(5X,'} ',A1,A1)
C
          CALL DPCONA(92,IBASLC)
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8803)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8810)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8812)IBASLC,IBASLC,ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8813)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8820     FORMAT(5X,A1,'begin{tabular} {cccc}')
 8821     FORMAT(5X,' & {',A1,'bf Point} & {',A1,'bf Lower}',
     1           2X,A1,A1)
 8822     FORMAT(5X,'{',A1,'bf Percentile} & {',A1,'bf Estimate} & {',
     1       A1,'bf Confidence Limit}',2X,A1,A1)
C8823     FORMAT(5X,G15.7,' & ',G15.7,' & ',G15.7,' & ',
C    1           G15.7,2X,A1,A1)
 8823     FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,' & ',
     1           2X,A1,A1)
 8840     FORMAT(5X,A1,'hline')
 8849     FORMAT(A1,'end{tabular}')
C
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8820)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8821)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8822)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8840)IBASLC
          CALL DPWRST('XXX','WRIT')
          DO8830I=1,NPERC
CCCCC       WRITE(ICOUT,8823)QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I),
            WRITE(ICOUT,8823)QP(I),XQPHAT(I),XQPLCL(I),
     1                       IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
 8830     CONTINUE
          WRITE(ICOUT,8849)IBASLC
          CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8891     FORMAT(A1,'end{center}')
 8893     FORMAT(A1,'end{table}')
          WRITE(ICOUT,8891)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8893)IBASLC
          CALL DPWRST('XXX','WRIT')
C
        ENDIF
 8899   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8899)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(6X,'EXPONENTIAL MAXIMUM LIKELIHOOD ESTIMATION:')
        CALL DPWRST('XXX','WRIT')
        IF(ICASE.EQ.'SING')THEN
          WRITE(ICOUT,4212)
        ELSE
          WRITE(ICOUT,44212)
        ENDIF
 4212   FORMAT(6X,'TIME (SINGLY) CENSORED CASE')
44212   FORMAT(6X,'TIME (MULTIPLY) CENSORED CASE')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4213)
 4213   FORMAT('ONE-PARAMETER MODEL (LOCATION = 0)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4215)N
 4215   FORMAT('NUMBER OF OBSERVATIONS                = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4216)IR
 4216   FORMAT('NUMBER OF FAILURE TIMES               = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4217)XMIN
 4217   FORMAT('MINIMUM VALUE                         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4219)SCALE
 4219   FORMAT('ESTIMATE OF SCALE PARAMETER           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)SCALSE
 4221   FORMAT('STANDARD ERROR OF SCALE PARAMETER     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4222)
 4222   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)
 4242   FORMAT('                       NORMAL APPROXIMATION',
     1         '            LIKELIHOOD RATIO')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)
 4243   FORMAT('   CONFIDENCE           LOWER         UPPER',
     1         '         LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)
 4245   FORMAT('   VALUE (%)            LIMIT         LIMIT',
     1         '         LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,44226)
44226   FORMAT('--------------------------------------------',
     1         '----------------------------')
        CALL DPWRST('XXX','WRIT')
        DO4229I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4227)ATEMP,A2LOWB(I),A2HGHB(I),A3LOWB(I),
     1                     A3HGHB(I)
 4227     FORMAT('   ',F8.3,10X,5(G12.6,2X))
          CALL DPWRST('XXX','WRIT')
 4229   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,4911)
          CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,4912)
CCCCC     CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4915)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4921)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4922)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4916)
 4916     FORMAT('---------------',
     1           '-------------------------')
          CALL DPWRST('XXX','WRIT')
C
          DO4931I=1,NPERC
CCCCC       WRITE(ICOUT,4932)QP(I),XQPHTZ(I),XQPLCZ(I),XQPUCZ(I)
            WRITE(ICOUT,4932)QP(I),XQPHTZ(I),XQPLCZ(I)
            CALL DPWRST('XXX','WRIT')
 4931     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,4251)
 4251     FORMAT('THE MINIMUM VALUE WILL BE SAVED AS THE INTERNAL ',
     1           'PARAMETER U1')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4253)
 4253     FORMAT('THE SCALE PARAMETER WILL BE SAVED AS THE ',
     1           'INTERNAL PARAMETER B1')
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4261)
 4261   FORMAT('TWO-PARAMETER MODEL (LOCATION UNKNOWN)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4262)N
 4262   FORMAT('NUMBER OF OBSERVATIONS     = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4263)IR
 4263   FORMAT('NUMBER OF FAILURE TIMES    = ',I8)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4264)UHAT
 4264   FORMAT('ESTIMATE OF LOCATION PARAMETER                      = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,4265)UHATSE
C4265   FORMAT('STANDARD ERROR OF LOCATION PARAMETER                = ',
CCCCC1         G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4267)
 4267   FORMAT('CONFIDENCE INTERVAL FOR LOCATION PARAMETER ')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4223)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4226)
        CALL DPWRST('XXX','WRIT')
        DO4269I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4227)ATEMP,ALOWU(I),AHIGHU(I)
          CALL DPWRST('XXX','WRIT')
 4269   CONTINUE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4271)SCALE2
 4271   FORMAT('ESTIMATE OF SCALE PARAMETER                         = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4276)SCA2SE
 4276   FORMAT('STANDARD ERROR OF SCALE PARAMETER                   = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4277)
 4277   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER ')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4223)
 4223   FORMAT('   CONFIDENCE           LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)
 4225   FORMAT('   VALUE (%)            LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4226)
 4226   FORMAT('-------------------------------------------')
        CALL DPWRST('XXX','WRIT')
        DO4279I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4227)ATEMP,ALOWB(I),AHIGHB(I)
          CALL DPWRST('XXX','WRIT')
 4279   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,4911)
 4911     FORMAT('CONFIDENCE LIMITS FOR SELECTED PERCENTILES:')
          CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,4912)
C4912     FORMAT('FULL SAMPLE CASE')
CCCCC     CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4915)ALPHAP
 4915     FORMAT('ALPHA = ',F7.4)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4921)
C4921     FORMAT(15X,'       POINT     ','     LOWER     ',
CCCCC1          '       UPPER')
 4921     FORMAT(10X,'      POINT     ','      LOWER     ')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4922)
C4922     FORMAT('    PERCENTILE ','     ESTIMATE   ',
CCCCC1           'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
 4922     FORMAT('PERCENTILE','   ESTIMATE    ',
     1           'CONFIDENCE LIMIT ')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4916)
          CALL DPWRST('XXX','WRIT')
C
          DO4930I=1,NPERC
CCCCC       WRITE(ICOUT,4932)QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I)
            WRITE(ICOUT,4932)QP(I),XQPHAT(I),XQPLCL(I)
 4932       FORMAT(2X,F8.4,G15.7,2X,G15.7)
            CALL DPWRST('XXX','WRIT')
 4930     CONTINUE
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IF(IFEEDB.EQ.'ON')THEN
          IF(NPERC.GT.0)THEN
            WRITE(ICOUT,4943)
 4943       FORMAT('PERCENTILE CONFIDENCE LIMITS BASED ON 1-PARAMETER',
     1             ' WRITTEN TO FILE  dpst1f.dat')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4944)
 4944       FORMAT('PERCENTILE CONFIDENCE LIMITS BASED ON 2-PARAMETER',
     1             ' WRITTEN TO FILE  dpst2f.dat')
            CALL DPWRST('XXX','BUG ')
          ENDIF
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4281)
 4281     FORMAT('THE LOCATION PARAMETER WILL BE SAVED AS THE ',
     1           'INTERNAL PARAMETER U2')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4283)
 4283     FORMAT('THE SCALE PARAMETER WILL BE SAVED AS THE ',
     1           'INTERNAL PARAMETER B2')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLE2--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLE3(Y,TAG,N,
     1XTEMP,MAXNXT,
     1XMIN,SCALE,SCALE2,NUMV,ICENTY,TEND,
     1ICAPSW,ICAPTY,
     1QP,XQPHAT,XQPLCL,XQPUCL,NPERC,
     1XQPHTZ,XQPLCZ,XQPUCZ,
     1IOUNI1,IOUNI2,ALPHAP,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR EXPONENTIAL DISTRIBUTION
C              FOR THE FAILURE CENSORED (TYPE II, EITHER SINGLY OR
C              MULTIPLY CENSORED) CASE.
C     EXAMPLE--EXPONENTIAL MAXIMUM LIKELIHOOD Y X
C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
C                1999, CHAPTER 12.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/3
C     ORIGINAL VERSION--MARCH     1998.
C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML/LATEX OUTPUT
C     UPDATED         --OCTOBER   2004. SUPPORT FOR BOTH TIME AND
C                                       NUMBER OF FAILURES CENSORING,
C                                       MULTIPLY CENSORED DATA FOR
C                                       TIME CENSORED DATA
C     UPDATED         --OCTOBER   2004. CONFIDENCE INTERVALS FOR
C                                       SELECT PERCENTILES
C     UPDATED         --OCTOBER   2004. SPLIT FULL SAMPLE AND CENSORED
C                                       CASES INTO DISTINCT
C                                       SUBROUTINES
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICENTY
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 ICASE
C
C---------------------------------------------------------------------
C
      PARAMETER (NUMALP=6)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWU(NUMALP)
      DIMENSION AHIGHU(NUMALP)
      DIMENSION ALOWB(NUMALP)
      DIMENSION AHIGHB(NUMALP)
      DIMENSION A2LOWB(NUMALP)
      DIMENSION A2HGHB(NUMALP)
      DIMENSION A3LOWB(NUMALP)
      DIMENSION A3HGHB(NUMALP)
C
      DIMENSION Y(*)
      DIMENSION TAG(*)
      DIMENSION XTEMP(*)
      DIMENSION XQPHTZ(*)
      DIMENSION XQPLCZ(*)
      DIMENSION XQPUCZ(*)
      DIMENSION QP(*)
      DIMENSION XQPHAT(*)
      DIMENSION XQPLCL(*)
      DIMENSION XQPUCL(*)
C
      DOUBLE PRECISION DN
      DOUBLE PRECISION D1N
      DOUBLE PRECISION D2R
      DOUBLE PRECISION DS
      DOUBLE PRECISION DAK
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DALPH
      DOUBLE PRECISION XLOW
      DOUBLE PRECISION XUP
C
      DOUBLE PRECISION AE
      DOUBLE PRECISION RE
C
      DOUBLE PRECISION DK
      DOUBLE PRECISION DR
      DOUBLE PRECISION SHAT
      DOUBLE PRECISION XSUM
      DOUBLE PRECISION DC
      COMMON/EXPCOM/DK,DR,SHAT,XSUM,DC
      DOUBLE PRECISION EXPFUN
      EXTERNAL EXPFUN
C
      EXTERNAL SUM
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
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='E3  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE3')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLE3--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,NUMV
   55   FORMAT('N,NUMV,NPERC = ',3I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I),TAG(I)
   57     FORMAT('I,Y(I),TAG(I) = ',I8,2E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
        WRITE(ICOUT,59)ICENTY
   59   FORMAT('ICENTY = ',A4)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE3')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN EXPONENTIAL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)
 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 1 ',
     1         'IS <= 1')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)N
 1113   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** WARNING FROM EXPONENTIAL MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1132)HOLD
 1132 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
      IF(NPERC.GT.0)THEN
        DO1145I=1,NPERC
          IF(QP(I).LE.0.0 .OR. QP(I).GE.100.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1141)
 1141       FORMAT('***** WARNING IN EXPONENTIAL MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1143)QP(I)
 1143       FORMAT('      REQUESTED PERCENTILE (',G15.7,') IS ',
     1             'OUTSIDE THE (0,100) INTERVAL')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1144)
 1144       FORMAT('      NO PERCENTILE CONFIDENCE LIMITS WILL BE ',
     1             'COMPUTED.')
            CALL DPWRST('XXX','WRIT')
            NPERC=0
          ENDIF
 1145   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 21--                             **
C               **  CHECK THE CENSORING VARIABLE: SHOULD  **
C               **  BE AT MOST 2 DISTINCT VALUES, 1       **
C               **  INDICATES FAILURE TIME, 0 INDICATES   **
C               **  CENSORING TIME.                       **
C               ********************************************
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE3')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC OCTOBER 2004.  FOR CENSORED CASE, CHECK THAT SECOND VARIABLE
CCCCC                CONTAINS TWO DISTINCT VALUES, SET TO 1 AND 0.
C
      CALL DISTIN(TAG,N,IWRITE,XTEMP,NDIST,IBUGA3,IERROR)
      IF(NDIST.EQ.1)THEN
        DO2102I=1,N
          TAG(I)=1.0
 2102   CONTINUE
      ELSEIF(NDIST.EQ.2)THEN
        IF(XTEMP(1).EQ.1.0 .OR. XTEMP(2).EQ.1.0)THEN
          DO2103I=1,N
            IF(TAG(I).NE.1.0)TAG(I)=0.0
 2103     CONTINUE
        ELSE
          ATEMP1=MIN(XTEMP(1),XTEMP(2))
          ATEMP2=MAX(XTEMP(1),XTEMP(2))
          DO2108I=1,N
            IF(TAG(I).EQ.ATEMP1)TAG(I)=1.0
            IF(TAG(I).EQ.ATEMP2)TAG(I)=0.0
 2108     CONTINUE
        ENDIF
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2104)
 2104   FORMAT('***** ERROR IN EXPONENTIAL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2105)
 2105   FORMAT('      FOR CENSORED DATA, THE CENSORING VARIABLE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2106)
 2106   FORMAT('      SHOULD CONTAIN AT MOST TWO DISTINCT VALUES.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2107)NDIST
 2107   FORMAT('      ',I8,' DISTINCT VALUES FOUND.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      CALL SORTC(Y,TAG,N,Y,TAG)
      IR=0
      DSUM1=0.0D0
      DO2120I=1,N
        IF(TAG(I).EQ.1.0)IR=IR+1
 2120 CONTINUE
      IM=N-IR
      DR=DBLE(IR)
C
      IF(IM.EQ.0)THEN
        ICASE='NONE'
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2131)
 2131   FORMAT('***** WARNING FROM EXPONENTIAL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2133)
 2133   FORMAT('      NO CENSORING TIMES DETECTED.  IT IS RECOMMENDED')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2135)
 2135   FORMAT('      THAT THE FULL SAMPLE SYNTAX BE USED:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2137)
 2137   FORMAT('      EXPONENTIAL MAXIMUM LIKELIHOOD  Y')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSE
        ICASE='SING'
        AHOLD=Y(IR+1)
        DO2140I=IR+1,N
          IF(Y(I).NE.AHOLD)THEN
            ICASE='MULT'
            GOTO2149
          ENDIF
 2140   CONTINUE
 2149   CONTINUE
      ENDIF
C
C               ************************************
C               **  STEP 41--                     **
C               **  CARRY OUT CALCULATIONS        **
C               **  FOR EXPONENTIAL MLE           **
C               **  ESTIMATE (TIME CENSORED CASE) **
C               ************************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE3')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      AN=REAL(N)
      AR=REAL(IR)
      AM=REAL(IM)
C
      CALL SUM(Y,N,IWRITE,YSUM,IBUGA3,IERROR)
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
C
C  ESTIMATES FOR 1-PARAMETER MODEL
C
C  SIGMAHAT = (1/R)*SUM[i=1 to r][(1 + b(i)X(i)]
C
C  WHERE b(i) = NUMBER OF ITEMS CENSORED AT TIME i.
C
      DO4103I=1,N
        IF(TAG(I).EQ.1.0)THEN
          AHOLD=Y(I)
          NCEN=0
          DO4105J=1,N
            IF(J.NE.I .AND. TAG(J).EQ.0.0 .AND. Y(J).EQ.AHOLD)THEN
              NCEN=NCEN+1
            ENDIF
 4105     CONTINUE
          XTEMP(I)=REAL(NCEN)
        ELSE
          XTEMP(I)=0.0
        ENDIF
 4103 CONTINUE
C
      DSUM1=0.0D0
      DO4107I=1,N
        IF(TAG(I).EQ.1.0)THEN
          DSUM1=DSUM1 + DBLE(1.0 + XTEMP(I))*DBLE(Y(I))
        ENDIF
 4107 CONTINUE
      SCALE=REAL(DSUM1/DR)
      SCALSE=SCALE/SQRT(AR)
C
      IF(ICASE.EQ.'SING')THEN
        NUTEMP=2*IR
        DO4110I=1,NUMALP
          ALP=ALPHA(I)
          P=1.0-(ALP/2.0)
          CALL CHSPPF(P,NUTEMP,APPF1)
          P=ALP/2.0
          CALL CHSPPF(P,NUTEMP,APPF2)
          SLNOR=SCALE - ZP*SCALSE
          SUNOR=SCALE + ZP*SCALSE
          A2LOWB(I)=2.0*AR*SCALE/APPF1
          A2HGHB(I)=2.0*AR*SCALE/APPF2
 4110   CONTINUE
      ELSE
        SHAT=DBLE(SCALE)
        NUTEMP=1
        AE=1.D-7
        RE=1.D-7
        XSUM=DBLE(YSUM)
        DC=2.0D0*(-DR*DLOG(SHAT) - XSUM/SHAT)
C
        DO4120I=1,NUMALP
          ALP=ALPHA(I)
          P=1.0-(ALP/2.0)
          CALL NORPPF(P,ZP)
          CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
          DK=DBLE(APPF)
C
C  NOW COMPUTE NORMAL APPROXIMATION INTERVAL (USE AS
C  STARTING VALUE FOR LIKELIHOOD RATIO METHOD).
C
          SLNOR=SCALE - ZP*SCALSE
          SUNOR=SCALE + ZP*SCALSE
C
C  NOW COMPUTE LIKELIHOOD RATIO BASED INTERVAL
C
          XLOW=DBLE(XMIN)
          XUP=DBLE(SCALE)
          CALL DFZERO(EXPFUN,XLOW,XUP,DBLE(SLNOR),RE,AE,IFLAG)
          A3LOWB(I)=XLOW
          A2LOWB(I)=SLNOR
C
          XLOW=DBLE(SCALE)
          XUP=1.3D0*DBLE(SUNOR)
          CALL DFZERO(EXPFUN,XLOW,XUP,DBLE(SUNOR),RE,AE,IFLAG)
          A3HGHB(I)=XLOW
          A2HGHB(I)=SUNOR
 4120   CONTINUE
      ENDIF
C
C               **********************************************
C               **  STEP 41A--                              **
C               **  ESTIMATE CONFIDENCE LIMITS FOR SELECTED **
C               **  PERCENTILES.  BASED ON FORMULAS GIVEN   **
C               **  ON PAGE 186 OF BURY FOR SINGLY CENSORED **
C               **  CASE.  FOR MULTIPLY CENSORED DATA, USE  **
C               **  FORMULA ON PAGE 190-191 FOR TWO         **
C               **  MODEL (IN THIS CASE, OBTAIN LOWER       **
C               **  CONFIDENCE INTERVAL ONLY, SET U = 0 IN  **
C               **  FORMUALA).                              **
C               **********************************************
C
      ISTEPN='41A'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NPERC.GE.1 .AND. ICASE.EQ.'SING')THEN
C
        NU2=2*IR
        ALPHL=ALPHAP/2.0
        ALPHU=1.0 - ALPHAP/2.0
        CALL CHSPPF(ALPHL,NU2,ACHSLL)
        CALL CHSPPF(ALPHU,NU2,ACHSUL)
C
        WRITE(IOUNI1,4131)
        WRITE(IOUNI1,4132)
        DO4119I=1,NPERC
          QPTEMP=QP(I)/100.0
          CALL EXPPPF(QPTEMP,APPF)
          XQPHTZ(I)=SCALE*APPF
          SEXQP=APPF*SCALSE
          ATEMP1=APPF*2.0*IR*SCALE/ACHSUL
          ATEMP2=APPF*2.0*IR*SCALE/ACHSLL
          XQPLCZ(I)=MIN(ATEMP1,ATEMP2)
          XQPUCZ(I)=MAX(ATEMP1,ATEMP2)
          WRITE(IOUNI1,'(3E15.7,2X,E15.7)')
     1         QP(I),XQPHTZ(I),XQPLCZ(I),XQPUCZ(I)
          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLE1')THEN
            WRITE(ICOUT,4133)I,QP(I),XQPHTZ(I),SEXQP,APPF
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4135)ACHSUL,ACHSLL,ATEMP1,ATEMP2
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4137)XQPLCZ(I),XQPUCZ(I)
            CALL DPWRST('XXX','BUG ')
          ENDIF
 4119   CONTINUE
      ELSEIF(NPERC.GE.1 .AND. ICASE.EQ.'MULT')THEN
C
C  NOTE: THE FIRST AND THIRD TERMS OF S (P. 191 OF BURY) ARE
C        SUM[i=1 to r][X(i)] AND (n-r)*X(r)
C        THIS IS SIMPLY THE SUM OF THE FAILURE TIMES AND THE SUM
C        OF THE CENSORING TIMES (FOR SINGLY CENSORED DATA),
C        RESPECTIVELY.  THIS IS SIMPLY THE SUM OF THE COMBINED
C        FAILURE AND CENSORING TIMES, SO JUST NEED TO TAKE THE
C        SUM OF ALL THE DATA.  FOR 1-PARAMETER MODEL, JUST SET
C        LOCATION PARAMETER TO 0.
C      
        DSUM1=0.0D0
        DO44140I=1,N
          DSUM1=DSUM1 + DBLE(Y(I))
44140   CONTINUE
        DS=DSUM1 - DBLE(AN*XMIN)
C
        D1N=DBLE(1.0/AN)
        DN=DBLE(AN)
        DR=DBLE(AR)
        D2R=DBLE(1.0D0/(AR-1.0))
        DALPH=DBLE(ALPHAP)
        ALPHL=ALPHAP/2.0
        ALPHU=1.0 - ALPHAP/2.0
C
        WRITE(IOUNI2,4131)
        WRITE(IOUNI2,4132)
        DO44130I=1,NPERC
          QPTEMP=QP(I)/100.0
          CALL EXPPPF(QPTEMP,APPF)
          XQPHAT(I)=SCALE2*APPF
          DAK=D1N*(1.0D0 - (DBLE(1.0D0 - QPTEMP)**DN/DALPH)**D2R)
          XQPLCL(I)=REAL(DAK*DS)
CCCCC     XQPUCL(I)=MAX(ATEMP1,ATEMP2)
          WRITE(IOUNI2,'(3E15.7)')
     1         QP(I),XQPHAT(I),XQPLCL(I)
          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLE3')THEN
            WRITE(ICOUT,4133)I,QP(I),XQPHAT(I),DS,DAK
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4137)XQPLCL(I)
            CALL DPWRST('XXX','BUG ')
          ENDIF
44130   CONTINUE
      ENDIF
 4135 FORMAT('ACHSUL,ACHSLL,ATEMP1,ATEMP2 = ',4G15.7)
C
C  ESTIMATES FOR 2-PARAMETER MODEL
C
      IF(ICASE.EQ.'SING')THEN
        DSUM1=0.0D0
        DO4145I=1,IR
          DSUM1=DSUM1 + DBLE(Y(I))
 4145   CONTINUE
        YSUMR=REAL(DSUM1)
C
        UHAT=(1.0/(AN*(AR-1.0)))*(AN*AR*XMIN - YSUMR + AM*Y(IR))
        SCALE2=(1.0/(AR-1.0))*(YSUMR - AN*Y(1) + AM*Y(IR))
        UHATSE=(SCALE2/AN)*SQRT(AR/(AR-1.0))
        SCA2SE=SCALE2/SQRT(AR-1.0)
C
        NU2=2*IR-1
        DO4125I=1,NUMALP
          ALP=ALPHA(I)
          P=1.0-(ALP/2.0)
          CALL CHSPPF(P,NU2,PPF3)
          P=ALP/2.0
          CALL CHSPPF(P,NU2,PPF4)
          ALOWB(I)=2.0*AR*SCALE2/PPF3
          AHIGHB(I)=2.0*AR*SCALE2/PPF4
          ACONS1=(ALP/2.0)**(2.0/(1.0-2.0*AR)) - 1.0
          ACONS2=(1.0 - ALP/2.0)**(2.0/(1.0-2.0*AR)) - 1.0
          ATEMP1=XMIN - SCALE2*(AR/AN)*ACONS1
          ATEMP2=XMIN - SCALE2*(AR/AN)*ACONS2
          ALOWU(I)=MIN(ATEMP1,ATEMP2)
          AHIGHU(I)=MAX(ATEMP1,ATEMP2)
 4125   CONTINUE
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4126)
 4126   FORMAT('***** NOTE FROM EXPONENTIAL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4127)
 4127   FORMAT('      TWO-PARAMETER MODEL NOT SUPPORTED FOR')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4128)
 4128   FORMAT('      MULTIPLY FAILURE CENSORED DATA.')
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C               **********************************************
C               **  STEP 41B--                              **
C               **  ESTIMATE CONFIDENCE LIMITS FOR SELECTED **
C               **  PERCENTILES.  COMPUTE THE LOWER         **
C               **  CONFIDENCE INTERVAL GIVEN ON PP. 190-191**
C               **  OF BURY.  NOTE THAT THIS APPROXIMATION  **
C               **  IS FOR THE SINGLY CENSORED CASE ONLY.   **
C               **  NO FORMULA IS GIVEN FOR THE MULTIPLY    **
C               **  CENSORED CASE.                          **
C               **********************************************
C
      ISTEPN='41B'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NPERC.GE.1)THEN
C
C  NOTE: THE FIRST AND THIRD TERMS OF S (P. 191 OF BURY) ARE
C        SUM[i=1 to r][X(i)] AND (n-r)*X(r)
C        THIS IS SIMPLY THE SUM OF THE FAILURE TIMES AND THE SUM
C        OF THE CENSORING TIMES (FOR SINGLY CENSORED DATA),
C        RESPECTIVELY.  THIS IS SIMPLY THE SUM OF THE COMBINED
C        FAILURE AND CENSORING TIMES, SO JUST NEED TO TAKE THE
C        SUM OF ALL THE DATA.
C      
        DSUM1=0.0D0
        DO4140I=1,N
          DSUM1=DSUM1 + DBLE(Y(I))
 4140   CONTINUE
        DS=DSUM1 - DBLE(AN*XMIN)
C
        D1N=DBLE(1.0/AN)
        DN=DBLE(AN)
        DR=DBLE(AR)
        D2R=DBLE(1.0D0/(AR+0.5-1.0))
        DALPH=DBLE(ALPHAP)
        ALPHL=ALPHAP/2.0
        ALPHU=1.0 - ALPHAP/2.0
C
        WRITE(IOUNI2,4131)
 4131   FORMAT(15X,'       POINT     ','     LOWER     ')
C4131   FORMAT(15X,'       POINT     ','     LOWER     ',
CCCCC1         '     UPPER')
        WRITE(IOUNI2,4132)
 4132   FORMAT('    PERCENTILE ','     ESTIMATE   ',
CCCCC1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
     1         'CONFIDENCE LIMIT ')
        DO4130I=1,NPERC
          QPTEMP=QP(I)/100.0
          CALL EXPPPF(QPTEMP,APPF)
          XQPHAT(I)=UHAT + SCALE2*APPF
          DAK=D1N*(1.0D0 - (DBLE(1.0D0 - QPTEMP)**DN/DALPH)**D2R)
          XQPLCL(I)=UHAT + REAL(DAK*DS)
CCCCC     XQPUCL(I)=UHAT + MAX(ATEMP1,ATEMP2)
          WRITE(IOUNI2,'(3E15.7)')
     1         QP(I),XQPHAT(I),XQPLCL(I)
          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLE3')THEN
            WRITE(ICOUT,4133)I,QP(I),XQPHAT(I),DS,DAK
 4133       FORMAT('I,QP(I),XQPHAT(I),DS,DAK = ',I8,4G15.7)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4137)XQPLCL(I)
 4137       FORMAT('XQPLCL(I) = ',2G15.7)
            CALL DPWRST('XXX','BUG ')
          ENDIF
 4130   CONTINUE
      ENDIF
C
C               *************************************
C               **   STEP 42--                     **
C               **   WRITE OUT EVERYTHING          **
C               **   FOR EXPONENTIAL MLE ESTIMATE  **
C               *************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE3')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5002   FORMAT('<B>EXPONENTIAL MAXIMUM LIKELIHOOD ESTIMATION:')
 5004   FORMAT('<BR>MULTIPLY FAILURE CENSORED CASE</B>')
 5005   FORMAT('<BR>SINGLY FAILURE CENSORED CASE</B>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
        CALL DPWRST('XXX','WRIT')
        IF(ICASE.EQ.'MULT')THEN
          WRITE(ICOUT,5004)
        ELSE
          WRITE(ICOUT,5005)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>One-Parameter Model (Location = 0)</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=300>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=200>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5059   FORMAT('   </TR>')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Minimum Value:')
 5063   FORMAT('         Estimate of Scale Parameter:')
 5064   FORMAT('         Standard Error of Scale Parameter:')
 5065   FORMAT('         Number of Failure Times:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)IR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Limits for the Scale ',
     1         'Parameter<BR>(Based on Normal Approximation)</B>')
 5118   FORMAT('      <B>Confidence Limits for the Scale ',
     1         'Parameter<BR>(Based on Chi-Square Interval)</B>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        IF(ICASE.EQ.'SING')THEN
          WRITE(ICOUT,5118)
        ELSE
          WRITE(ICOUT,5117)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=3>')
 5162   FORMAT('          <HR>')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        DO5140I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)A2LOWB(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)A2HGHB(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5140   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
55117   FORMAT('      <B>Confidence Limits for the Scale ',
     1         'Parameter (Based on Likelihood Ratio)</B>')
        IF(ICASE.NE.'SING')THEN
          WRITE(ICOUT,5111)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5113)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5115)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,55117)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5119)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5123)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5125)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5129)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5131)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5129)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5133)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5139)
          CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5161)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5162)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5139)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
          DO55140I=1,NUMALP
            ATEMP=100.0*(1.0 - ALPHA(I))
            WRITE(ICOUT,5141)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5149)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5151)ATEMP
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5147)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5149)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5151)A3LOWB(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5147)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5149)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5151)A3HGHB(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5147)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5159)
            CALL DPWRST('XXX','WRIT')
55140     CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
          WRITE(ICOUT,5191)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5193)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
        ENDIF
C
        IF(NPERC.GT.0)THEN
C
C  START THE TABLE
C
          WRITE(ICOUT,5801)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          WRITE(ICOUT,5811)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5813)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5815)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5817)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5816)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5819)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5861)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5863)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          IF(ICASE.EQ.'SING')THEN
            WRITE(ICOUT,5849)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5864)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5848)
            CALL DPWRST('XXX','WRIT')
          ENDIF
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          NJUNK=4
          IF(ICASE.EQ.'MULT')NJUNK=3
          WRITE(ICOUT,5870)NJUNK
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5872)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5847)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          DO55880I=1,NPERC
            WRITE(ICOUT,5841)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)QP(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPHTZ(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            IF(ICASE.EQ.'SING')THEN
              WRITE(ICOUT,5843)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,5851)XQPLCZ(I)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,5847)
              CALL DPWRST('XXX','WRIT')
            ENDIF
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPUCZ(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5859)
            CALL DPWRST('XXX','WRIT')
55880     CONTINUE
C
C  END THE TABLE AND RESET ASIS MODE
C
          WRITE(ICOUT,5891)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5893)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5211   FORMAT('<UL>')
 5213   FORMAT('<TABLE NOBORDER>')
 5215   FORMAT('   <CAPTION ALIGN=CENTER>')
 5217   FORMAT('      <B>Two-Parameter Model (Location Unknown)</B>')
 5219   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5211)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5213)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5215)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5217)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5219)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
C  STEP 4: DEFINE DATA ROW
C
 5241   FORMAT('   <TR>')
 5243   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=300>')
 5247   FORMAT('      </TD>')
 5249   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=200>')
 5251   FORMAT('         ',G15.7)
 5253   FORMAT('         ',I8)
 5255   FORMAT('         ',A8)
 5259   FORMAT('   </TR>')
 5261   FORMAT('         Number of Observations:')
 5262   FORMAT('         Estimate of Location Parameter:')
 5263   FORMAT('         Standard Error of Location Parameter:')
 5264   FORMAT('         Estimate of Scale Parameter:')
 5265   FORMAT('         Standard Error of Scale Parameter:')
 5266   FORMAT('         Number of Failure Times:')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5261)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5253)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5265)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5253)IR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5262)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5251)UHAT
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5263)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5251)UHATSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5264)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5251)SCALE2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5265)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5251)SCA2SE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5241)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5243)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5266)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5247)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5249)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5251)UHATBC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5247)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5259)
CCCCC   CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5241)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5243)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5267)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5247)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5249)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5251)UHBCSE
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5247)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5259)
CCCCC   CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5241)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5243)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5268)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5247)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5249)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5251)SCA2BC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5247)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5259)
CCCCC   CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5241)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5243)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5269)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5247)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5249)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5251)SCBCSE
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5247)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5259)
CCCCC   CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5291   FORMAT('</TABLE>')
 5293   FORMAT('</UL>')
        WRITE(ICOUT,5291)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5293)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5311   FORMAT('<UL>')
 5313   FORMAT('<TABLE NOBORDER>')
 5315   FORMAT('   <CAPTION ALIGN=CENTER>')
 5317   FORMAT('      <B>Confidence Limits for the Location ',
     1           'Parameter</B>')
 5319   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5311)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5313)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5315)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5317)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5319)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5321   FORMAT('   <TR>')
 5323   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5325   FORMAT('         Confidence<br>Value (%)')
 5327   FORMAT('      </TH>')
 5329   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5331   FORMAT('         Lower<br>Limit')
 5333   FORMAT('         Upper<br>Limit')
 5339   FORMAT('   </TR>')
 5361   FORMAT('      <TD COLSPAN=3>')
 5362   FORMAT('          <HR>')
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5325)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5329)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5331)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5329)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5333)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5339)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5361)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5362)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5347)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5339)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5341   FORMAT('   <TR>')
 5347   FORMAT('      </TD>')
 5349   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5351   FORMAT('         ',G15.7)
 5359   FORMAT('   </TR>')
        DO5340I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5341)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5351)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5347)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5351)ALOWU(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5347)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5351)AHIGHU(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5347)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5359)
          CALL DPWRST('XXX','WRIT')
 5340   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5391   FORMAT('</TABLE>')
 5393   FORMAT('</UL>')
        WRITE(ICOUT,5391)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5393)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5411   FORMAT('<UL>')
 5413   FORMAT('<TABLE NOBORDER>')
 5415   FORMAT('   <CAPTION ALIGN=CENTER>')
 5417   FORMAT('      <B>Confidence Limits for the Scale ',
     1           'Parameter</B>')
 5419   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5411)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5413)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5415)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5417)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5419)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5421   FORMAT('   <TR>')
 5423   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5425   FORMAT('         Confidence<br>Value (%)')
 5427   FORMAT('      </TH>')
 5429   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5431   FORMAT('         Lower<br>Limit')
 5433   FORMAT('         Upper<br>Limit')
 5439   FORMAT('   </TR>')
 5461   FORMAT('      <TD COLSPAN=3>')
 5462   FORMAT('          <HR>')
        WRITE(ICOUT,5421)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5423)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5425)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5427)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5429)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5431)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5427)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5429)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5433)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5427)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5439)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5421)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5461)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5462)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5447)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5439)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5441   FORMAT('   <TR>')
 5447   FORMAT('      </TD>')
 5449   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5451   FORMAT('         ',G15.7)
 5459   FORMAT('   </TR>')
        DO5440I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5441)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5449)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5451)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5447)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5449)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5451)ALOWB(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5447)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5449)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5451)AHIGHB(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5447)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5459)
          CALL DPWRST('XXX','WRIT')
 5440   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5491   FORMAT('</TABLE>')
 5493   FORMAT('</UL>')
 5499   FORMAT('<PRE>')
        WRITE(ICOUT,5491)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5493)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5499)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
C
C  START THE TABLE
C
 5801     FORMAT('</PRE>')
 5811     FORMAT('<UL>')
 5813     FORMAT('<TABLE NOBORDER>')
 5815     FORMAT('   <CAPTION ALIGN=CENTER>')
 5816     FORMAT('      <BR><B>Alpha = ',F7.3,'</B>')
 5817     FORMAT('      <B>Confidence Limits for Selected ',
     1           'Percentiles</B>')
 5819     FORMAT('   </CAPTION>')
          WRITE(ICOUT,5801)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          WRITE(ICOUT,5811)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5813)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5815)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5817)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5816)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5819)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5841     FORMAT('   <TR>')
 5843     FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5847     FORMAT('      </TD>')
 5848     FORMAT('      </TH>')
 5849     FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5851     FORMAT('         ',G15.7)
 5859     FORMAT('   </TR>')
 5861     FORMAT('         Percentile')
 5862     FORMAT('         Point <br> Estimate')
 5863     FORMAT('         Lower <br>Confidence Limit')
 5864     FORMAT('         Upper <br>Confidence Limit')
 5870     FORMAT('      <TD COLSPAN=',I1,'>')
 5872     FORMAT('         <HR WIDTH=500>')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5861)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5863)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5849)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5864)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5848)
CCCCC     CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          NJUNK=3
          WRITE(ICOUT,5870)NJUNK
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5872)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5847)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          DO5880I=1,NPERC
            WRITE(ICOUT,5841)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)QP(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPHAT(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPLCL(I)
            CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,5847)
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,5843)
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,5851)XQPUCL(I)
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,5847)
CCCCC       CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5859)
            CALL DPWRST('XXX','WRIT')
 5880     CONTINUE
C
C  END THE TABLE AND RESET ASIS MODE
C
 5891     FORMAT('</TABLE>')
 5893     FORMAT('</UL>')
 5899     FORMAT('<PRE>')
          WRITE(ICOUT,5891)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5893)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5899)
          CALL DPWRST('XXX','WRIT')
        ENDIF
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001   FORMAT(A1,'end{verbatim}')
 8003   FORMAT(A1,'begin{table}')
 8004   FORMAT(A1,'end{table}')
 8005   FORMAT('{',A1,'bf Exponential Maximum Likelihood ',
     1         'Estimation:}')
 8006   FORMAT('{',A1,'bf Failure (Singly) Censored Case}')
88006   FORMAT('{',A1,'bf Failure (Multiply) Censored Case}')
 8007   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009   FORMAT(A1,'begin{center}')
 8011   FORMAT(5X,'{',A1,'bf One-Parameter Model ($',A1,
     1         'mu$ = 0 Case)}')
 8013   FORMAT(A1,'end{center}')
 8015   FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(ICASE.EQ.'SING')THEN
          WRITE(ICOUT,8006)IBASLC
        ELSE
          WRITE(ICOUT,88006)IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020   FORMAT(5X,A1,'begin{tabular} {lr}')
 8021   FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022   FORMAT(5X,'Minimum Value: & ',G15.7,2X,A1,A1)
 8023   FORMAT(5X,'Estimate of Scale Parameter: & ',G15.7,2X,A1,A1)
 8024   FORMAT(5X,'Standard Error of Scale Parameter: & ',
     1         G15.7,2X,A1,A1)
 8025   FORMAT(5X,'Number of Failure Times: & ',I8,2X,A1,A1)
 8049   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)IR,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)SCALE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)SCALSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8093   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for Scale Parameter $',
     1       A1,'beta$ (Based on Normal Approximation)}')
 8112 FORMAT(5X,'{',A1,'bf Confidence Limits for Scale Parameter $',
     1       A1,'beta$ (Based on Chi-Square Interval)}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(ICASE.EQ.'SING')THEN
          WRITE(ICOUT,8112)IBASLC,IBASLC
        ELSE
          WRITE(ICOUT,8111)IBASLC,IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper',2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit',2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,2X,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8130I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,A2LOWB(I),A2HGHB(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8130   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
88111 FORMAT(5X,'{',A1,'bf Confidence Limits for Scale Parameter $',
     1       A1,'beta$ (Based on Likelihood Ratio)}')
C
        IF(ICASE.NE.'SING')THEN
          WRITE(ICOUT,8109)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,88111)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8113)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
          WRITE(ICOUT,8109)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8120)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8121)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8140)IBASLC
          CALL DPWRST('XXX','WRIT')
          DO88130I=1,NUMALP
            ATEMP=100.0*(1.0-ALPHA(I))
            WRITE(ICOUT,8131)ATEMP,A3LOWB(I),A3HGHB(I),IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
88130     CONTINUE
          WRITE(ICOUT,8149)IBASLC
          CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8193     FORMAT(A1,'end{center}')
          WRITE(ICOUT,8193)IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8491)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C WRITE SELECTED PERCENTILES (IF ANY)
C
        IF(NPERC.GT.0 .AND. ICASE.EQ.'SING')THEN
C
          CALL DPCONA(92,IBASLC)
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8803)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8810)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8812)IBASLC,IBASLC,ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8813)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
88821     FORMAT(5X,' & {',A1,'bf Point} & {',A1,'bf Lower} & {',A1,
     1           'bf Upper}',2X,A1,A1)
88822     FORMAT(5X,'{',A1,'bf Percentile} & {',A1,'bf Estimate} & {',
     1       A1,'bf Confidence Limit} & {',A1,
     1       'bf Confidence Limit}',2X,A1,A1)
88823     FORMAT(5X,G15.7,' & ',G15.7,' & ',G15.7,' & ',
     1           G15.7,2X,A1,A1)
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8820)IBASLC
          CALL DPWRST('XXX','WRIT')
          IF(ICASE.EQ.'SING')THEN
            WRITE(ICOUT,88821)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,88822)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
          ELSE
            WRITE(ICOUT,8821)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,8822)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
          ENDIF
          WRITE(ICOUT,8840)IBASLC
          CALL DPWRST('XXX','WRIT')
          DO88830I=1,NPERC
            IF(ICASE.EQ.'SING')THEN
              WRITE(ICOUT,88823)QP(I),XQPHTZ(I),XQPLCZ(I),XQPUCZ(I),
     1                         IBASLC,IBASLC
            ELSE
              WRITE(ICOUT,8823)QP(I),XQPHTZ(I),XQPLCZ(I),
     1                         IBASLC,IBASLC
            ENDIF
            CALL DPWRST('XXX','WRIT')
88830     CONTINUE
          WRITE(ICOUT,8849)IBASLC
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8891)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8893)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8207   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8209   FORMAT(A1,'begin{center}')
 8211   FORMAT(5X,'{',A1,'bf Two-Parameter Model ($',
     1         A1,'mu$ Unknown Case)}')
 8213   FORMAT(A1,'end{center}')
 8215   FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8209)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8211)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8207)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8207)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8213)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8220   FORMAT(5X,A1,'begin{tabular} {lr}')
 8221   FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8222   FORMAT(5X,'Estimate of Location Parameter: & ',G15.7,2X,A1,A1)
 8223   FORMAT(5X,'Standard Error of Location Parameter: & ',
     1         G15.7,2X,A1,A1)
 8224   FORMAT(5X,'Estimate of Scale Parameter: & ',G15.7,2X,A1,A1)
 8225   FORMAT(5X,'Standard Error of Scale Parameter: & ',
     1         G15.7,2X,A1,A1)
 8226   FORMAT(5X,'Number of Failure Times: & ',I8,2X,A1,A1)
 8249   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8209)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8220)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8221)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8226)IR,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8222)UHAT,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8223)UHATSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8224)SCALE2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8225)SCA2SE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8249)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8293   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8293)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8307   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8309   FORMAT(A1,'begin{center}')
 8311   FORMAT(5X,'{',A1,'bf Confidence Limits for Location ',
     1         'Parameter $',A1,'mu$}')
 8313   FORMAT(A1,'end{center}')
 8315   FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8309)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8311)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8307)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8307)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8313)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8320   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8321   FORMAT(5X,'Confidence & Lower & Upper',2X,A1,A1)
 8322   FORMAT(5X,'Value (',A1,'%) & Limit & Limit',2X,A1,A1)
 8331   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,2X,A1,A1)
 8340   FORMAT(5X,A1,'hline')
 8349   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8309)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8320)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8321)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8322)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8340)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8330I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8331)ATEMP,ALOWU(I),AHIGHU(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8330   CONTINUE
        WRITE(ICOUT,8349)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8393   FORMAT(A1,'end{center}')
 8399   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8393)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8403   FORMAT(A1,'begin{table}')
 8407   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8409   FORMAT(A1,'begin{center}')
 8411   FORMAT(5X,'{',A1,'bf Confidence Limits for Scale ',
     1           'Parameter $',A1,'beta$}')
 8413   FORMAT(A1,'end{center}')
 8415   FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8409)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8411)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8407)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8407)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8413)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8420   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8421   FORMAT(5X,'Confidence & Lower & Upper',2X,A1,A1)
 8422   FORMAT(5X,'Value (',A1,'%) & Limit & Limit',2X,A1,A1)
 8431   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,2X,A1,A1)
 8440   FORMAT(5X,A1,'hline')
 8449   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8409)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8420)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8421)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8422)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8440)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8430I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8431)ATEMP,ALOWB(I),AHIGHB(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8430   CONTINUE
        WRITE(ICOUT,8449)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8491   FORMAT(A1,'end{table}')
 8493   FORMAT(A1,'end{center}')
 8499   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8493)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8491)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8801     FORMAT(A1,'end{verbatim}')
 8803     FORMAT(A1,'begin{table}')
 8807     FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8809     FORMAT(A1,'begin{center}')
 8810     FORMAT(5X,'{',A1,'bf Confidence Limits for Selected ',
     1           'Percentiles:}')
 8812     FORMAT(5X,'{',A1,'bf $',A1,'alpha$ = ',F7.3,'}')
 8813     FORMAT(A1,'end{center}')
 8815     FORMAT(5X,'} ',A1,A1)
C
          CALL DPCONA(92,IBASLC)
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8803)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8810)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8812)IBASLC,IBASLC,ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8813)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8820     FORMAT(5X,A1,'begin{tabular} {cccc}')
 8821     FORMAT(5X,' & {',A1,'bf Point} & {',A1,'bf Lower} ',
     1           2X,A1,A1)
 8822     FORMAT(5X,'{',A1,'bf Percentile} & {',A1,'bf Estimate} & {',
     1       A1,'bf Confidence Limit} ',2X,A1,A1)
C8823     FORMAT(5X,G15.7,' & ',G15.7,' & ',G15.7,' & ',
C    1           G15.7,2X,A1,A1)
 8823     FORMAT(5X,G15.7,' & ',G15.7,' & ',G15.7,' & ',
     1           2X,A1,A1)
 8840     FORMAT(5X,A1,'hline')
 8849     FORMAT(A1,'end{tabular}')
C
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8820)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8821)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8822)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8840)IBASLC
          CALL DPWRST('XXX','WRIT')
          DO8830I=1,NPERC
CCCCC       WRITE(ICOUT,8823)QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I),
            WRITE(ICOUT,8823)QP(I),XQPHAT(I),XQPLCL(I),
     1                       IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
 8830     CONTINUE
          WRITE(ICOUT,8849)IBASLC
          CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8891     FORMAT(A1,'end{center}')
 8893     FORMAT(A1,'end{table}')
          WRITE(ICOUT,8891)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8893)IBASLC
          CALL DPWRST('XXX','WRIT')
C
        ENDIF
 8899   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8899)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4205)
 4205   FORMAT(6X,'EXPONENTIAL MAXIMUM LIKELIHOOD ESTIMATION: ')
        CALL DPWRST('XXX','WRIT')
        IF(ICASE.EQ.'SING')THEN
          WRITE(ICOUT,4207)
        ELSE
          WRITE(ICOUT,4208)
        ENDIF
 4207   FORMAT(6X,'FAILURE (SINGLY) CENSORED CASE')
 4208   FORMAT(6X,'FAILURE (MULTIPLY) CENSORED CASE')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4213)
 4213   FORMAT('ONE-PARAMETER MODEL (LOCATION = 0)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4215)N
 4215   FORMAT('NUMBER OF OBSERVATIONS                = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4216)IR
 4216   FORMAT('NUMBER OF FAILURE TIMES               = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4217)XMIN
 4217   FORMAT('MINIMUM VALUE                         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4219)SCALE
 4219   FORMAT('ESTIMATE OF SCALE PARAMETER           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)SCALSE
 4221   FORMAT('STANDARD ERROR OF SCALE PARAMETER     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(ICASE.EQ.'SING')THEN
          WRITE(ICOUT,44222)
44222     FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,44223)
44223     FORMAT('(BASED ON CHI-SQUARE INTERVAL)')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4223)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4225)
 4225     FORMAT('   VALUE (%)            LIMIT         LIMIT')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4226)
          CALL DPWRST('XXX','WRIT')
          DO44229I=1,NUMALP
            ATEMP=100.0*(1.0 - ALPHA(I))
            WRITE(ICOUT,4227)ATEMP,A2LOWB(I),A2HGHB(I)
            CALL DPWRST('XXX','WRIT')
44229     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4222)
 4222     FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER (BASED ON ',
     1           'NORMAL APPROXIMATION)')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4223)
 4223     FORMAT('   CONFIDENCE           LOWER         UPPER')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4225)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4226)
 4226     FORMAT('-------------------------------------------')
          CALL DPWRST('XXX','WRIT')
          DO4229I=1,NUMALP
            ATEMP=100.0*(1.0 - ALPHA(I))
            WRITE(ICOUT,4227)ATEMP,A2LOWB(I),A2HGHB(I)
 4227       FORMAT('   ',F8.3,10X,5(G12.6,2X))
            CALL DPWRST('XXX','WRIT')
 4229     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,45222)
45222     FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER (BASED ON ',
     1           'LIKELIHOOD RATIO)')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4223)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4225)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4226)
          CALL DPWRST('XXX','WRIT')
          DO45229I=1,NUMALP
            ATEMP=100.0*(1.0 - ALPHA(I))
            WRITE(ICOUT,4227)ATEMP,A3LOWB(I),A3HGHB(I)
            CALL DPWRST('XXX','WRIT')
45229     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,4911)
          CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,4912)
CCCCC     CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4915)ALPHAP
          CALL DPWRST('XXX','WRIT')
          IF(ICASE.EQ.'SING')THEN
            WRITE(ICOUT,44921)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,44922)
            CALL DPWRST('XXX','WRIT')
          ELSE
            WRITE(ICOUT,4921)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,4922)
            CALL DPWRST('XXX','WRIT')
          ENDIF
          WRITE(ICOUT,44916)
          CALL DPWRST('XXX','WRIT')
44921     FORMAT(10X,'      POINT     ','    LOWER     ',
     1          '       UPPER')
44922     FORMAT('PERCENTILE','    ESTIMATE   ',
     1           'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
44916     FORMAT('---------------',
     1           '-----------------------------------',
     1           '--------')
C
          DO4931I=1,NPERC
            IF(ICASE.EQ.'SING')THEN
              WRITE(ICOUT,4932)QP(I),XQPHTZ(I),XQPLCZ(I),XQPUCZ(I)
            ELSE
              WRITE(ICOUT,4932)QP(I),XQPHTZ(I),XQPLCZ(I)
            ENDIF
            CALL DPWRST('XXX','WRIT')
 4931     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,4251)
 4251     FORMAT('THE MINIMUM VALUE WILL BE SAVED AS THE INTERNAL ',
     1           'PARAMETER U1')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4253)
 4253     FORMAT('THE SCALE PARAMETER WILL BE SAVED AS THE ',
     1           'INTERNAL PARAMETER B1')
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4261)
 4261   FORMAT('TWO-PARAMETER MODEL (LOCATION UNKNOWN)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4262)N
 4262   FORMAT('NUMBER OF OBSERVATIONS     = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4263)IR
 4263   FORMAT('NUMBER OF FAILURE TIMES    = ',I8)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4264)UHAT
 4264   FORMAT('ESTIMATE OF LOCATION PARAMETER                      = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4265)UHATSE
 4265   FORMAT('STANDARD ERROR OF LOCATION PARAMETER                = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4271)SCALE2
 4271   FORMAT('ESTIMATE OF SCALE PARAMETER                         = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4276)SCA2SE
 4276   FORMAT('STANDARD ERROR OF SCALE PARAMETER                   = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4267)
 4267   FORMAT('CONFIDENCE INTERVAL FOR LOCATION PARAMETER ')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4223)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4226)
        CALL DPWRST('XXX','WRIT')
        DO4269I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4227)ATEMP,ALOWU(I),AHIGHU(I)
          CALL DPWRST('XXX','WRIT')
 4269   CONTINUE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4277)
 4277   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4223)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4226)
        CALL DPWRST('XXX','WRIT')
        DO4279I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4227)ATEMP,ALOWB(I),AHIGHB(I)
          CALL DPWRST('XXX','WRIT')
 4279   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,4911)
 4911     FORMAT('CONFIDENCE LIMITS FOR SELECTED PERCENTILES:')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4915)ALPHAP
 4915     FORMAT('ALPHA = ',F7.4)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4921)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4922)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4916)
          CALL DPWRST('XXX','WRIT')
 4921     FORMAT(10X,'      POINT     ','     LOWER     ')
 4922     FORMAT('PERCENTILE','   ESTIMATE     ',
     1           'CONFIDENCE LIMIT ')
 4916     FORMAT('---------------',
     1           '---------------------------')
C
          DO4930I=1,NPERC
CCCCC       WRITE(ICOUT,4932)QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I)
            WRITE(ICOUT,4932)QP(I),XQPHAT(I),XQPLCL(I)
 4932       FORMAT(2X,F8.4,G15.7,2X,G15.7,2X,G15.7)
            CALL DPWRST('XXX','WRIT')
 4930     CONTINUE
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IF(IFEEDB.EQ.'ON')THEN
          IF(NPERC.GT.0)THEN
            WRITE(ICOUT,4943)
 4943       FORMAT('PERCENTILE CONFIDENCE LIMITS BASED ON 1-PARAMETER',
     1             ' MODEL WRITTEN TO FILE  dpst1f.dat')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4944)
 4944       FORMAT('PERCENTILE CONFIDENCE LIMITS BASED ON 2-PARAMETER',
     1             ' MODEL WRITTEN TO FILE  dpst2f.dat')
            CALL DPWRST('XXX','BUG ')
          ENDIF
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4281)
 4281     FORMAT('THE LOCATION PARAMETER WILL BE SAVED AS THE ',
     1           'INTERNAL PARAMETER U2')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4283)
 4283     FORMAT('THE SCALE PARAMETER WILL BE SAVED AS THE ',
     1           'INTERNAL PARAMETER B2')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE3')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLE3--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLE4(Y,X1,X2,N,
     1XTEMP,MAXNXT,
     1XMIN,SCALE,SCALE2,NUMV,ICENTY,TEND,
     1ICAPSW,ICAPTY,
     1QP,XQPHAT,XQPLCL,XQPUCL,NPERC,
     1XQPHTZ,XQPLCZ,XQPUCZ,
     1IOUNI1,IOUNI2,ALPHAP,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR EXPONENTIAL DISTRIBUTION
C              FOR THE FULL SAMPLE CASE WHEN THE DATA ARE BINNED.
C              CURRENTLY, ONLY THE ONE-PARAMETER MODEL IS
C              ESTIMATED.
C
C              THE ML ESTIMATE IS BASED ON KNOWING THE END POINTS
C              OF THE GROUPS (I.E., THE BIN WIDTHS NEED NOT BE
C              EQUAL).  SO TWO SYNTAXES ARE ALLOWED: IF ONE GROUPING
C              VARIABLE, THEN IT IS ASSUMED THIS REPRESENTS THE
C              BIN MID-POINTS AND BINS ARE EQUAL WIDTH.  IF THERE
C              ARE TWO GROUPING VARIABLES, THEN IT IS ASSUMED THAT
C              THE FIRST REPRESENTS THE LOWER BOUNDARY OF THE BIN
C              AND THE SECOND REPRESENTS THE UPPER BOUNDARY OF THE
C              BIN.
C
C              THE CURRENT IMPLEMENTATION PROVIDES A POINT ESTIMATE
C              AND THE STANDARD ERROR, BUT NO EXPLICIT CONFIDENCE
C              INTERVAL.
C
C     EXAMPLE--SET CENSORING TYPE GROUPED
C              EXPONENTIAL MAXIMUM LIKELIHOOD Y X
C
C              EXPONENTIAL MAXIMUM LIKELIHOOD Y XLOW XHIGH
C
C     REFERENCE--JOHNSON, KOTZ, AND BALAKRISHNAN, "CONTINUOUS
C                UNIVARIATE DISTRIBUTIONS--Volume 1", SECOND EDITION,
C                WILEY, 1994, PP. 509-510.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/10
C     ORIGINAL VERSION--OCTOBER   2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICENTY
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DSIGMA
      DOUBLE PRECISION DX1
      DOUBLE PRECISION DX2
C
C---------------------------------------------------------------------
C
      PARAMETER (NUMALP=6)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWU(NUMALP)
      DIMENSION AHIGHU(NUMALP)
      DIMENSION ALOWB(NUMALP)
      DIMENSION AHIGHB(NUMALP)
      DIMENSION A2LOWB(NUMALP)
      DIMENSION A2HGHB(NUMALP)
C
      DIMENSION Y(*)
      DIMENSION X1(*)
      DIMENSION X2(*)
      DIMENSION XTEMP(*)
      DIMENSION XQPHTZ(*)
      DIMENSION XQPLCZ(*)
      DIMENSION XQPUCZ(*)
      DIMENSION QP(*)
      DIMENSION XQPHAT(*)
      DIMENSION XQPLCL(*)
      DIMENSION XQPUCL(*)
C
      COMMON/EX2COM/NK
      EXTERNAL EXPFU2
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
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='E4  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE4')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLE4--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,NUMV,NPERC
   55   FORMAT('N,NUMV,NPERC = ',3I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I),X1(I),X2(I)
   57     FORMAT('I,Y(I),X1(I),X2(I) = ',I8,3E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
        WRITE(ICOUT,59)ICENTY
   59   FORMAT('ICENTY = ',A4)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE4')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN EXPONENTIAL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)
 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 1 ',
     1         'IS <= 1')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)N
 1113   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(NUMV.EQ.3)THEN
        DO1120I=1,N
          IF(X1(I).GT.X2(I))THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1121)
 1121       FORMAT('***** ERROR IN EXPONENTIAL MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1122)
 1122       FORMAT('      FOR THE TWO GROUPING VARIABLES CASE, THE')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1123)
 1123       FORMAT('      VALUE FOR THE GROUP ONE VARIABLE MUST BE')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1124)
 1124       FORMAT('      LESS THAN THE CORRESPONDING VALUE OF THE')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1125)
 1125       FORMAT('      SECOND GROUP VARIABLE.')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1126)I,X1(I),X2(I)
 1126       FORMAT('      FOR ROW ',I8,' GROUP 1 (I) = ',G15.7,
     1             ' AND GROUP 2 (I) = ',G15.7)
            CALL DPWRST('XXX','WRIT')
            IERROR='YES'
            GOTO9000
          ENDIF
          IF(X1(I).LT.0.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1121)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1132)
 1132       FORMAT('      THE GROUPED EXPONENTIAL CASE CURRENTLY ONLY')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1133)
 1133       FORMAT('      SUPPORTED FOR THE 1-PARAMETER MODEL.  THIS')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1134)
 1134       FORMAT('      REQUIRES THAT THE GROUPING VARIABLE CONTAIN')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1135)I,X1(I)
 1135       FORMAT('      NON-NEGATIVE VALUES.  ROW ',I8,' = ',G15.7)
            CALL DPWRST('XXX','WRIT')
            IERROR='YES'
            GOTO9000
          ENDIF
 1120   CONTINUE
      ELSEIF(NUMV.EQ.2)THEN
        DO1160I=1,N
          IF(X1(I).LT.0.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1121)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1162)
 1162       FORMAT('      THE GROUPED EXPONENTIAL CASE CURRENTLY ONLY')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1163)
 1163       FORMAT('      SUPPORTED FOR THE 1-PARAMETER MODEL.  THIS')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1164)
 1164       FORMAT('      REQUIRES THAT THE GROUPING VARIABLE CONTAIN')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1165)I,X1(I)
 1165       FORMAT('      NON-NEGATIVE VALUES.  ROW ',I8,' = ',G15.7)
            CALL DPWRST('XXX','WRIT')
            IERROR='YES'
            GOTO9000
          ENDIF
 1160   CONTINUE
      ENDIF
C
      DO1170I=1,N
        IF(Y(I).LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1172)
 1172     FORMAT('      FOR THE GROUPED EXPONENTIAL MAXIMUM ',
     1           'LIKELIHOOD CASE,')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1173)
 1173       FORMAT('      THE FIRST VARIABLE SPECIFIED SHOULD CONTAIN')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1174)
 1174       FORMAT('      BIN COUNTS AND SHOULD THEREFORE BE ',
     1             'NON-NEGATIVE.')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1175)I,Y(I)
 1175       FORMAT('      ROW ',I8,' = ',G15.7)
            CALL DPWRST('XXX','WRIT')
            IERROR='YES'
            GOTO9000
          ENDIF
 1170   CONTINUE
C
C               *****************************************
C               **  STEP 21--                          **
C               **  CARRY OUT CALCULATIONS FOR GROUPED **
C               **  EXPONENTIAL MLE (GROUPED, FULL     **
C               **  SAMPLE CASE).  ML ESTIMATE GIVEN   **
C               **  ON PAGE 509 OF JOHNSON, KOTZ, AND  **
C               **  BALAKRISHNAN.                      **
C               *****************************************
C
 2100 CONTINUE
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE4')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IERROR='NO'
      IWRITE='OFF'
C
C  STEP 1: PUT DATA IN RIGHT FORM:
C          X(I) = DIVIDING POINTS OF INTERVAL.
C
      IF(NUMV.EQ.2)THEN
C
C  MAKE SURE DATA IS SORTED BY GROUPING VARIABLE, CALCULATE GROUPED
C  MEAN.
C
        CALL SORTC(X1,Y,N,X1,Y)
        DSUM1=0.0D0
        NTOT=0
        DO2103I=1,N
          DSUM1=DSUM1 + DBLE(X1(I))*DBLE(Y(I))
          NTOT=NTOT + INT(Y(I)+0.5)
 2103   CONTINUE
        XMEAN=REAL(DSUM1/DBLE(NTOT))
        XMIN=X1(1)
C
C  DEFINE INTERVALS
C
        DELTA=(X1(2)-X1(1))/2.0
        ICNT=1
        XTEMP(ICNT)=0.0
        ICNT=2
        XTEMP(ICNT)=X1(1)+DELTA
        DO2110I=2,N
          DELTA=(X1(I)-X1(I-1))/2.0
          ICNT=ICNT+1
          XTEMP(ICNT)=X1(I)+DELTA
 2110   CONTINUE
        NK=ICNT
        ICNT=ICNT+1
        XTEMP(ICNT)=CPUMAX
        Y(NK)=0.0
C
      ELSE
C
C  MAKE SURE DATA IS SORTED BY FIRST GROUPING VARIABLE
C
        DO2120I=1,N
          XTEMP(I)=X1(I)
 2120   CONTINUE
        CALL SORTC(X1,X2,N,X1,X2)
        CALL SORTC(XTEMP,Y,N,XTEMP,Y)
        DSUM1=0.0D0
        NTOT=0
        DO2123I=1,N
          DSUM1=DSUM1 + DBLE(Y(I))*DBLE((X2(I)-X1(I))/2.0)
          NTOT=NTOT + INT(Y(I)+0.5)
 2123   CONTINUE
        XMEAN=REAL(DSUM1/DBLE(NTOT))
        XMIN=X1(1)
C
C  DEFINE INTERVALS
C
        ICNT=1
        XTEMP(ICNT)=X1(1)
        DO2130I=1,N
          ICNT=ICNT+1
          XTEMP(ICNT)=X2(ICNT)
 2130   CONTINUE
        ICNT=ICNT+1
        XTEMP(ICNT)=CPUMAX
        NK=ICNT
        Y(N+1)=0.0
C
      ENDIF
C
      DO2140I=1,NK
        X1(I)=XTEMP(I)
 2140 CONTINUE
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE4')THEN
        WRITE(ICOUT,2155)NUMV,NK
 2155   FORMAT('NUMV,NK = ',2I8)
        CALL DPWRST('XXX','WRIT')
        DO2157I=1,NK+1
          WRITE(ICOUT,2156)I,X1(I),Y(I)
 2156     FORMAT('I,X1(I),Y(I) =',I8,2G15.7)
          CALL DPWRST('XXX','WRIT')
 2157   CONTINUE
      ENDIF
C
C  ESTIMATES FOR 1-PARAMETER MODEL.  USE FZEROY TO FIND ROOT OF
C  EQUATION GIVEN IN EXPFU2 (COMMENTS IN THAT ROUTINE GIVE
C  ACTUAL EQUATION).  USE OVERALL MEAN AS STARTING VALUE.
C
      AE=1.E-6
      RE=1.E-6
      IFLAG=0
      XLOW=X1(1)
      XUP=X1(NK-1)
      CALL FZEROY(EXPFU2,XLOW,XUP,XMEAN,RE,AE,IFLAG,X1,Y)
      SCALE=XLOW
C
      IF(IFLAG.EQ.2)THEN
C
C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,111)
CC111   FORMAT('***** WARNING FROM GROUPED EXPONENTIAL MAXIMUM ',
CCCCC1         'LIKELIHOOD--')
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,113)
CC113   FORMAT('      ESTIMATE OF SIGMA MAY NOT BE COMPUTED TO ',
CCCCC1         'DESIRED 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 GROUPED EXPONENTIAL MAXIMUM ',
     1         'LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,123)
  123   FORMAT('      ESTIMATE OF SIGMA 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 GROUPED EXPONENTIAL MAXIMUM ',
     1         'LIKELIHOOD--')
        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 GROUPED EXPONENTIAL MAXIMUM ',
     1         'LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,143)
  143   FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      AN=REAL(NTOT)
      DSIGMA=DBLE(SCALE)
      DSUM1=0.0D0
      DO150I=2,NK
        DX1=DBLE(X1(I))
        DX2=DBLE(X1(I-1))
        DTERM1=(DX1-DX2)**2/(DEXP(DX1/DSIGMA) - DEXP(DX2/DSIGMA))
        DSUM1=DSUM1 + DTERM1
  150 CONTINUE
      SCALSE=SQRT(AN*REAL(DSUM1))
CCCCC print *,'scalse=',scalse
C
      IF(NPERC.GE.1)THEN
C
        NU2=2*NTOT
        ALPHL=ALPHAP/2.0
        ALPHU=1.0 - ALPHAP/2.0
        CALL CHSPPF(ALPHL,NU2,ACHSLL)
        CALL CHSPPF(ALPHU,NU2,ACHSUL)
C
        WRITE(IOUNI1,4131)
        WRITE(IOUNI1,4132)
        DO4119I=1,NPERC
          QPTEMP=QP(I)/100.0
          CALL EXPPPF(QPTEMP,APPF)
          XQPHTZ(I)=SCALE*APPF
          SEXQP=APPF*SCALSE
          ATEMP1=APPF*2.0*AN*SCALE/ACHSUL
          ATEMP2=APPF*2.0*AN*SCALE/ACHSLL
          XQPLCZ(I)=MIN(ATEMP1,ATEMP2)
          XQPUCZ(I)=MAX(ATEMP1,ATEMP2)
          WRITE(IOUNI1,'(3E15.7,2X,E15.7)')
     1         QP(I),XQPHTZ(I),XQPLCZ(I),XQPUCZ(I)
          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLE4')THEN
            WRITE(ICOUT,4133)I,QP(I),XQPHTZ(I),SEXQP,APPF
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4135)ACHSUL,ACHSLL,ATEMP1,ATEMP2
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4137)XQPLCZ(I),XQPUCZ(I)
            CALL DPWRST('XXX','BUG ')
          ENDIF
 4119   CONTINUE
 4131   FORMAT(15X,'       POINT     ','     LOWER     ',
     1         '     UPPER')
 4132   FORMAT('    PERCENTILE ','     ESTIMATE   ',
     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
 4133   FORMAT('I,QP(I),XQPHAT(I),SEXQP,APPF = ',I8,4G15.7)
 4135   FORMAT('ACHSUL,ACHSLL,ATEMP1,ATEMP2 = ',4G15.7)
 4137   FORMAT('XQPLCL(I),XQPUCL(I) = ',2G15.7)
      ENDIF
C
C               *************************************
C               **   STEP 42--                     **
C               **   WRITE OUT EVERYTHING          **
C               **   FOR EXPONENTIAL MLE ESTIMATE  **
C               *************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE4')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5002   FORMAT('<B>EXPONENTIAL MAXIMUM LIKELIHOOD ESTIMATION:')
 5004   FORMAT('<BR>GROUPED DATA, FULL SAMPLE CASE</B>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>One-Parameter Model (Location = 0)</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=200>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=200>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5059   FORMAT('   </TR>')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Minimum Value:')
 5063   FORMAT('         Estimate of Scale Parameter:')
 5064   FORMAT('         Standard Error of Scale Parameter:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5041)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5043)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5064)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5047)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5049)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5051)SCALSE
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5047)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5059)
CCCCC   CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
C
C  START THE TABLE
C
          WRITE(ICOUT,5801)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          WRITE(ICOUT,5811)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5813)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5815)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5817)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5816)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5819)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5861)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5863)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5864)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5870)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5872)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5847)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          DO55880I=1,NPERC
            WRITE(ICOUT,5841)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)QP(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPHTZ(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPLCZ(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPUCZ(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5859)
            CALL DPWRST('XXX','WRIT')
55880     CONTINUE
C
C  END THE TABLE AND RESET ASIS MODE
C
          WRITE(ICOUT,5891)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5893)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
 5891     FORMAT('</TABLE>')
 5893     FORMAT('</UL>')
C
 5801   FORMAT('</PRE>')
 5811   FORMAT('<UL>')
 5813   FORMAT('<TABLE NOBORDER>')
 5815   FORMAT('   <CAPTION ALIGN=CENTER>')
 5816   FORMAT('      <BR><B>Alpha = ',F7.3,'</B>')
 5817   FORMAT('      <B>Confidence Limits for Selected ',
     1           'Percentiles</B>')
 5819   FORMAT('   </CAPTION>')
 5841   FORMAT('   <TR>')
 5843   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5847   FORMAT('      </TD>')
 5848   FORMAT('      </TH>')
 5849   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5851   FORMAT('         ',G15.7)
 5859   FORMAT('   </TR>')
 5861   FORMAT('         Percentile')
 5862   FORMAT('         Point <br> Estimate')
 5863   FORMAT('         Lower <br>Confidence Limit')
 5864   FORMAT('         Upper <br>Confidence Limit')
 5870   FORMAT('      <TD COLSPAN=4>')
 5872   FORMAT('         <HR WIDTH=500>')
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001   FORMAT(A1,'end{verbatim}')
 8003   FORMAT(A1,'begin{table}')
 8004   FORMAT(A1,'end{table}')
 8005   FORMAT('{',A1,'bf Exponential Maximum Likelihood ',
     1         'Estimation: Full Sample Case, Grouped Data}')
 8007   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009   FORMAT(A1,'begin{center}')
 8011   FORMAT(5X,'{',A1,'bf One-Parameter Model ($',A1,
     1         'mu$ = 0 Case)}')
 8013   FORMAT(A1,'end{center}')
 8015   FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020   FORMAT(5X,A1,'begin{tabular} {lr}')
 8021   FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022   FORMAT(5X,'Minimum Value: & ',G15.7,2X,A1,A1)
 8023   FORMAT(5X,'Estimate of Scale Parameter: & ',G15.7,2X,A1,A1)
 8024   FORMAT(5X,'Standard Error of Scale Parameter: & ',
     1         G15.7,2X,A1,A1)
 8049   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)SCALE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8024)SCALSE,IBASLC,IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8093)IBASLC
 8093   FORMAT(A1,'end{center}')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C WRITE SELECTED PERCENTILES (IF ANY)
C
        IF(NPERC.GT.0)THEN
C
          CALL DPCONA(92,IBASLC)
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8803)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8810)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8812)IBASLC,IBASLC,ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8813)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8820)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8821)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8822)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8840)IBASLC
          CALL DPWRST('XXX','WRIT')
          DO88830I=1,NPERC
            WRITE(ICOUT,8823)QP(I),XQPHTZ(I),XQPLCZ(I),XQPUCZ(I),
     1                       IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
88830     CONTINUE
          WRITE(ICOUT,8849)IBASLC
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8891)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8893)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
 8801   FORMAT(A1,'end{verbatim}')
 8803   FORMAT(A1,'begin{table}')
 8807   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8809   FORMAT(A1,'begin{center}')
 8810   FORMAT(5X,'{',A1,'bf Confidence Limits for Selected ',
     1           'Percentiles:}')
 8812   FORMAT(5X,'{',A1,'bf $',A1,'alpha$ = ',F7.3,'}')
 8813   FORMAT(A1,'end{center}')
 8815   FORMAT(5X,'} ',A1,A1)
 8820   FORMAT(5X,A1,'begin{tabular} {cccc}')
 8821   FORMAT(5X,' & {',A1,'bf Point} & {',A1,'bf Lower} & {',A1,
     1           'bf Upper}',2X,A1,A1)
 8822   FORMAT(5X,'{',A1,'bf Percentile} & {',A1,'bf Estimate} & {',
     1       A1,'bf Confidence Limit} & {',A1,
     1       'bf Confidence Limit}',2X,A1,A1)
 8823   FORMAT(5X,G15.7,' & ',G15.7,' & ',G15.7,' & ',
     1           G15.7,2X,A1,A1)
 8840   FORMAT(5X,A1,'hline')
 8849   FORMAT(A1,'end{tabular}')
 8891   FORMAT(A1,'end{center}')
 8893   FORMAT(A1,'end{table}')
 8899   FORMAT(A1,'begin{verbatim}')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8899)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(6X,'EXPONENTIAL MAXIMUM LIKELIHOOD ESTIMATION: ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4212)
 4212   FORMAT(6X,'FULL SAMPLE CASE, GROUPED DATA')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4213)
 4213   FORMAT('ONE-PARAMETER MODEL (LOCATION = 0)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4215)N
 4215   FORMAT('NUMBER OF GROUPS                      = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4216)NTOT
 4216   FORMAT('TOTAL NUMBER OF OBSERVATIONS          = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4217)XMIN
 4217   FORMAT('MINIMUM VALUE                         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4219)SCALE
 4219   FORMAT('ESTIMATE OF SCALE PARAMETER           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,4221)SCALSE
C4221   FORMAT('STANDARD ERROR OF SCALE PARAMETER     = ',G15.7)
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,4911)
          CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,4912)
CCCCC     CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4915)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4921)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4922)
          CALL DPWRST('XXX','WRIT')
C
          DO4931I=1,NPERC
            WRITE(ICOUT,4932)QP(I),XQPHTZ(I),XQPLCZ(I),XQPUCZ(I)
            CALL DPWRST('XXX','WRIT')
 4931     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
 4911   FORMAT('CONFIDENCE LIMITS FOR SELECTED PERCENTILES:')
 4915     FORMAT('ALPHA = ',F7.4)
 4921     FORMAT(15X,'       POINT     ','     LOWER     ',
     1          '       UPPER')
 4922     FORMAT('    PERCENTILE ','     ESTIMATE   ',
     1           'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
 4932       FORMAT(3E15.7,2X,E15.7)
C
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,4251)
 4251     FORMAT('THE MINIMUM VALUE WILL BE SAVED AS THE INTERNAL ',
     1           'PARAMETER U1')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4253)
 4253     FORMAT('THE SCALE PARAMETER WILL BE SAVED AS THE ',
     1           'INTERNAL PARAMETER B1')
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IF(IFEEDB.EQ.'ON')THEN
          IF(NPERC.GT.0)THEN
            WRITE(ICOUT,4943)
 4943       FORMAT('PERCENTILE CONFIDENCE LIMITS BASED ON 1-PARAMETER',
     1             ' WRITTEN TO FILE  dpst1f.dat')
            CALL DPWRST('XXX','BUG ')
          ENDIF
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE4')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLE4--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N,NTOT
 9015   FORMAT('NNTOT = ',2I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLFL(Y,N,
     1XTEMP,MAXNXT,
     1GAMMA1,SCALE1,GAMMA2,SCALE2,
     1ICAPSW,ICAPTY,DTEMP1,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE METHOD OF MOMENT AND
C              MAXIMUM LIKELIHOOD ESTIMATES FOR THE FATIGUE LIFE
C              DISTRIBUTION
C     EXAMPLE--FATIGUE LIFE MAXIMUM LIKELIHOOD Y
C     REFERENCE--JOHNSON, KOTZ, AND BALAKRISHNAN.  "CONTINUOUS
C                UNIVARIATE DISTRIBUTIONS, VOLUME I", SECOND
C                EDITION, WILEY, 1994, PP. 614-619.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBUG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/3
C     ORIGINAL VERSION--MARCH     2004.
C     UPDATED         --AUGUST    2005. ORDER OF SCALE/SHAPE WERE
C                                       INVERTED.  FIXED.
C     UPDATED         --AUGUST    2005. AESTHETIC FIXES TO OUTOUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
      DOUBLE PRECISION DTEMP1(*)
C
      DOUBLE PRECISION DGAMM1
      DOUBLE PRECISION DGAMM2
      DOUBLE PRECISION DALPHA
      DOUBLE PRECISION DALPH2
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION DSUM3
      DOUBLE PRECISION DSUM4
      DOUBLE PRECISION DX
      DOUBLE PRECISION DN
      DOUBLE PRECISION TBAR
      DOUBLE PRECISION H
      DOUBLE PRECISION DK
      DOUBLE PRECISION TOL
      DOUBLE PRECISION XPAR(1)
      DOUBLE PRECISION FVEC(1)
C
      EXTERNAL FLFUN
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='DPML'
      ISUBN2='FL  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLFL')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLFL--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLFL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN FATIGUE LIFE MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS LESS THAN 3')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)N
 1112   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** EROR FROM FATIGUE LIFE MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
      DO1145I=1,N
        IF(Y(I).LE.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1147)
 1147     FORMAT('***** ERROR FROM FATIGUE LIFE MAXIMUM LIKELIHOOD ',
     1           'ESTIMATION')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1148)I,Y(I)
 1148     FORMAT('      ROW ',I8,' IS NON-POSITIVE (VALUE = ',
     1           G15.7,')')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
 1145 CONTINUE
C
C               ***************************************************
C               **  STEP 21--                                    **
C               **  CARRY OUT CALCULATIONS                       **
C               **  FOR FATIGUE LIFE MOMENT/MLE ESTIMATION       **
C               ***************************************************
C
 2100 CONTINUE
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
C
      IERROR='NO'
      IWRITE='OFF'
      DN=DBLE(N)
      DSUM1=0.0D0
      DSUM2=0.0D0
      DSUM3=0.0D0
      DSUM4=0.0D0
      DO2110I=1,N
        DX=DBLE(Y(I))
        DSUM1=DSUM1 + DSQRT(DX)
        DSUM2=DSUM2 + 1.0D0/DSQRT(DX)
        DSUM3=DSUM3 + DX
        DSUM4=DSUM4 + 1.0D0/DX
 2110 CONTINUE
      DGAMM1=DSUM1/DSUM2
      XPAR(1)=DSQRT(DSUM3/DSUM4)
C
      DSUM1=0.0D0
      DO2120I=1,N
        DX=DBLE(Y(I))
        DSUM1=DSUM1 + (DSQRT(DX/DGAMM1) - DSQRT(DGAMM1/DX))**2
 2120 CONTINUE
      DALPHA=DSQRT(DSUM1/DN)
      SCALE1=REAL(DGAMM1)
      GAMMA1=REAL(DALPHA)
C
      XPAR(1)=DGAMM1
C
      IOPT=2
      TOL=1.0D-6
      NVAR=1
      NPRINT=-1
      INFO=0
      LWA=MAXNXT
      CALL DNSQE(FLFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1           DTEMP1,MAXNXT,Y,N)
C
      DSUM1=0.0D0
      DSUM2=0.0D0
      DSUM3=0.0D0
C
      DO200I=1,N
        DX=DBLE(Y(I))
        DSUM1=DSUM1 + DX
        DSUM2=DSUM2 + 1.0D0/DX
        DSUM3=DSUM3 + 1.0D0/(DX + XPAR(1))
  200 CONTINUE
      TBAR=DSUM1/DN
      H=DN/DSUM2
      DK=DN/DSUM3
      DALPH2=2.0D0*DSQRT(0.5D0*((TBAR/XPAR(1)) + XPAR(1)/H) - 1.0D0)
      SCALE2=REAL(XPAR(1))
      GAMMA2=REAL(DALPH2)
C
C               ***********************************************
C               **   STEP 42--                               **
C               **   WRITE OUT EVERYTHING                    **
C               **   FOR FATIGUE LIFE MLE ESTIMATION         **
C               ***********************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLFL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Fatigue Life Parameter Estimation</b>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=350>')
 5045   FORMAT('         Number of Observations:')
 5061   FORMAT('         Sample Mean:')
 5062   FORMAT('         Sample Standard Deviation:')
 5063   FORMAT('         Sample Minimum:')
 5064   FORMAT('         Sample Maximum:')
 5065   FORMAT('         Estimate of Gamma:')
 5066   FORMAT('         Estimate of Scale:')
 5067   FORMAT('         Estimate of Gamma:')
 5068   FORMAT('         Estimate of Scale:')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5071   FORMAT('         Summary Statistics:')
 5072   FORMAT('         Method of Moment Estimates:')
 5073   FORMAT('         Maximum Likelihood Estimates:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5045)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5072)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMA1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALE1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5073)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMA2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALE2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Fatigue Life Parameter Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Estimate of $',A1,'gamma$: & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,'Estimate of Scale: & ',G15.7,2X,A1,A1)
 8028 FORMAT(5X,'Estimate of $',A1,'gamma$: & ',G15.7,2X,A1,A1)
 8029 FORMAT(5X,'Estimate of Scale: & ',G15.7,2X,A1,A1)
 8030 FORMAT(5X,'Summary Statistics: & ',2X,A1,A1)
 8031 FORMAT(5X,'Method of Moment Estimates: & ',2X,A1,A1)
 8032 FORMAT(5X,'Maximum Likelihood Estimates: & ',2X,A1,A1)
 8033 FORMAT(5X,' & ',2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8033)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)IBASLC,GAMMA1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)SCALE1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8033)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,GAMMA2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)SCALE2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{table}')
 8093 FORMAT(A1,'end{center}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(12X,
     1  'FATIGUE LIFE MAXIMUM LIKELIHOOD ESTIMATION')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4220)
 4220   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)N
 4221   FORMAT('NUMBER OF OBSERVATIONS                  = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4222)XMEAN
 4222   FORMAT('SAMPLE MEAN                             = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)XSD
 4223   FORMAT('SAMPLE STANDARD DEVIATION               = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4224)XMIN
 4224   FORMAT('SAMPLE MINIMUM                          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)XMAX
 4225   FORMAT('SAMPLE MAXIMUM                          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4230)
 4230   FORMAT('METHOD OF MOMENT ESTIMATES:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4231)GAMMA1
 4231   FORMAT('ESTIMATE OF GAMMA                       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4233)SCALE1 
 4233   FORMAT('ESTIMATE OF SCALE                       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4240)
 4240   FORMAT('METHOD OF MAXIMUM LIKELIHOOD:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4241)GAMMA2
 4241   FORMAT('ESTIMATE OF GAMMA                       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)SCALE2
 4243   FORMAT('ESTIMATE OF SCALE                       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4251)
 4251   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES WILL BE SAVED AS ',
     1         'INTERNAL PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4252)
 4252   FORMAT('GAMMAML, AND SCALEML.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4256)
 4256   FORMAT('METHOD OF MOMENT ESTIMATES WILL BE SAVED AS ',
     1         'INTERNAL PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4257)
 4257   FORMAT('GAMMAMOM, AND SCALEMOM.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLFL')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLFL--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLFN(Y,N,
     1XTEMP,MAXNXT,
     1ALOC,SCALE,
     1ICAPSW,ICAPTY,DTEMP1,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
C              FOR THE FOLDED NORMAL DISTRIBUTION.
C              THE MAXIMUM LIKELIHOOD ESTIMATES ARE THE SOLUTION TO
C              THE FOLLOWING SIMULTANEOUS NONLINEAR EQUATIONS:
C              EQUATIONS.
C
C              LOC**2 + SCALE**2 - SUM[i=1 to n][X(i)**2]/N
C
C              LOC - SUM[i=1 to n][X(i)*tanh(LOC*X(i)/SCALE**2)]/n
C
C              WITH LOC AND SCALE DENOTING THE SHAPE PARAMETERS.
C
C     EXAMPLE--FOLDED NORMAL MAXIMUM LIKELIHOOD Y
C     REFERENCE--"CONTINUOUS UNIVARIATE DISTRIBUTIONS-VVOLUME II",
C                SECOND EDITION, JOHNSON, KOTZ, AND BALAKRISHNAN,
C                1994, WILEY, P. 454.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBUG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/3
C     ORIGINAL VERSION--MARCH     2004.
C     UPDATED         --AUGUST    2005. REFORMAT OUTPUT FOR CONSISTENCY
C                                       WITH OTHER ML ROUTINES
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
      DOUBLE PRECISION DTEMP1(*)
C
      DOUBLE PRECISION TOL
      DOUBLE PRECISION XPAR(2)
      DOUBLE PRECISION FVEC(2)
C
      EXTERNAL FNRFUN
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='DPML'
      ISUBN2='FN  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLFN')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLFN--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLFN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN FOLDED NORMAL ',
     1         'MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS LESS THAN 3')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN FOLDED NORMAL ',
     1       'MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
      DO1145I=1,N
        IF(Y(I).LE.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1147)
 1147     FORMAT('***** ERROR IN FOLDED NORMAL ',
     1           'MAXIMUM LIKELIHOOD ESTIMATION--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1148)I,Y(I)
 1148     FORMAT('      ROW ',I8,' IS NON-POSITIVE (VALUE = ',G15.7,')')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
 1145 CONTINUE
C
C               ********************************************
C               **  STEP 21--                             **
C               **  CARRY OUT CALCULATIONS                **
C               **  FOR FOLDED NORMAL MLE ESTIMATION      **
C               ********************************************
C
 2100 CONTINUE
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLFN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
C
      XPAR(1)=DBLE(XMEAN)
      XPAR(2)=DBLE(XSD*XSD)
C
      IOPT=2
      TOL=1.0D-5
      NVAR=2
      NPRINT=-1
      INFO=0
      LWA=MAXNXT
      CALL DNSQE(FNRFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1           DTEMP1,MAXNXT,Y,N)
C
      ALOC=REAL(XPAR(1))
      SCALE=REAL(XPAR(2))
      SCALE=SQRT(SCALE)
C
C               ***********************************************
C               **   STEP 42--                               **
C               **   WRITE OUT EVERYTHING                    **
C               **   FOR FOLDED NORMAL MLE                   **
C               **   ESTIMATION                              **
C               ***********************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLFN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Folded Normal Parameter ',
     1         'Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=350>')
 5060   FORMAT('         Summary Statistics:')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Mean:')
 5063   FORMAT('         Sample Standard Deviation:')
 5064   FORMAT('         Sample Minimum:')
 5065   FORMAT('         Sample Maximum:')
 5066   FORMAT('         Maximum Likelihood Estimates:')
 5067   FORMAT('         Estimate of MU:')
 5068   FORMAT('         Estimate of SIGMA:')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALOC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Folded Normal ',
     1       'Parameter Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Summary Statistics: & ',2X,A1,A1)
 8022 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8023 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,' & ',2X,A1,A1)
 8028 FORMAT(5X,'Maximum Likelihood Estimates: & ',2X,A1,A1)
 8029 FORMAT(5X,'Estimate of $',A1,'mu$: & ',G15.7,2X,A1,A1)
 8030 FORMAT(5X,'Estimate of $',A1,'sigma$: & ',G15.7,2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC,ALOC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC,SCALE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{table}')
 8093 FORMAT(A1,'end{center}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4201)
 4201   FORMAT(12X,'FOLDED NORMAL PARAMETER ESTIMATION')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4210)
 4210   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)N
 4211   FORMAT('NUMBER OF OBSERVATIONS                   = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4213)XMEAN
 4213   FORMAT('SAMPLE MEAN                              = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4215)XSD
 4215   FORMAT('SAMPLE STANDARD DEVIATION                = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4217)XMIN
 4217   FORMAT('SAMPLE MINIMUM                           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4219)XMAX
 4219   FORMAT('SAMPLE MAXIMUM                           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4230)
 4230   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4231)ALOC
 4231   FORMAT('ESTIMATE OF MU                           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4233)SCALE
 4233   FORMAT('ESTIMATE OF SIGMA                        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4241)
 4241   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES WILL BE SAVED AS ',
     1         'INTERNAL PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4242)
 4242   FORMAT('MUML, AND SIGMAML.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      END                   IF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLFN')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLFN--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLFR(Y,TAG,N,
     1XTEMP,DTEMP,MAXNXT,
     1SCALE,SCALSE,GAMMA,GAMMSE,GAMMBC,GABCSE,COVSE,COBCSE,
     1NUMV,ICENTY,TEND,
     1ICAPSW,ICAPTY,IFREBC,
     1QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
     1IOUNI1,IOUNI2,ALPHAP,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR FRECHET DISTRIBUTION
C              FOR THE FULL SAMPLE CASE.
C     EXAMPLE--FRECHET MAXIMUM LIKELIHOOD Y
C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
C                1999, CHAPTER 16.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/5
C     ORIGINAL VERSION--MAY       2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICENTY
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IFREBC
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      PARAMETER (NUMALP=6)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWSC(NUMALP)
      DIMENSION AUPPSC(NUMALP)
      DIMENSION ALOWGA(NUMALP)
      DIMENSION AUPPGA(NUMALP)
      DIMENSION ALOWS2(NUMALP)
      DIMENSION AUPPS2(NUMALP)
      DIMENSION ALOWG2(NUMALP)
      DIMENSION AUPPG2(NUMALP)
C
      DIMENSION Y(*)
      DIMENSION TAG(*)
      DIMENSION XTEMP(*)
      DIMENSION QP(*)
      DIMENSION XQPHAT(*)
      DIMENSION XQPSE(*)
      DIMENSION XQPLCL(*)
      DIMENSION XQPUCL(*)
      DOUBLE PRECISION DTEMP(*)
C
      DOUBLE PRECISION EV2FUN
      DOUBLE PRECISION EV2FU2
      DOUBLE PRECISION EV2FU3
      EXTERNAL SUM
      EXTERNAL EV2FUN
      EXTERNAL EV2FU2
      EXTERNAL EV2FU3
C
      INTEGER IN
      DOUBLE PRECISION DEV2SM
      COMMON/EV2COM/DEV2SM,IN
C
      INTEGER IN2
      DOUBLE PRECISION DK
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DTERM2
      COMMON/EV2CO2/DK,DTERM1,DTERM2,IN2
      INTEGER IN3
      DOUBLE PRECISION DK2
      DOUBLE PRECISION DTERM6
      DOUBLE PRECISION DTERM7
      DOUBLE PRECISION DGAMMA
      COMMON/EV2CO3/DK2,DTERM6,DTERM7,DGAMMA,IN3
C
      DOUBLE PRECISION DN
      DOUBLE PRECISION DAE
      DOUBLE PRECISION DRE
      DOUBLE PRECISION DG
      DOUBLE PRECISION DS
      DOUBLE PRECISION DT1
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION DXSTRT
      DOUBLE PRECISION DXLOW
      DOUBLE PRECISION DXUP
      DOUBLE PRECISION XLOWSV
      DOUBLE PRECISION XUPSV
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
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='FR  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLFR')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLFR--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,NUMV
   55   FORMAT('N,NUMV,NPERC = ',3I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I),TAG(I)
   57     FORMAT('I,Y(I),TAG(I) = ',I8,2E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
        WRITE(ICOUT,59)ICENTY,IFREBC
   59   FORMAT('ICENTY,IFREBC = ',2A4)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLFR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN FRECHET MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)
 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 1 ',
     1         'IS <= 1')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)N
 1113   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      DO1125I=1,N
        IF(Y(I).LE.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1121)
 1121     FORMAT('***** ERROR FROM FRECHET MAXIMUM LIKELIHOOD--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1122)I,Y(I)
 1122     FORMAT('      ROW ',I8,' HAS THE VALUE = ',E15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSE
          XTEMP(I)=LOG(Y(I))
        ENDIF
 1125 CONTINUE
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR FROM FRECHET MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1132)HOLD
 1132 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
      IF(NPERC.GT.0)THEN
        DO1145I=1,NPERC
          IF(QP(I).LE.0.0 .OR. QP(I).GE.100.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1141)
 1141       FORMAT('***** WARNING IN FRECHET MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1143)QP(I)
 1143       FORMAT('      REQUESTED PERCENTILE (',G15.7,') IS ',
     1             'OUTSIDE THE (0,100) INTERVAL')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1144)
 1144       FORMAT('      NO PERCENTILE CONFIDENCE LIMITS WILL BE ',
     1             'COMPUTED.')
            CALL DPWRST('XXX','WRIT')
            NPERC=0
          ENDIF
 1145   CONTINUE
      ENDIF
C
C               **********************************
C               **  STEP 41--                   **
C               **  CARRY OUT CALCULATIONS      **
C               **  FOR FRECHET MLE             **
C               **  ESTIMATE (FULL SAMPLE CASE) **
C               **********************************
C
 4100 CONTINUE
C
C  FOR THE SHAPE PARAMETER, SOLVE THE EQUATION:
C
C      (1/GHAT) +
C      SUM[i=1 to n][Y(I)**(-GHAT)*LN(Y(I))]/
C      SUM[i=1 to n][[Y(I)**(-GHAT)] -
C      (1/N)*SUM[i=1 to n][LN(Y(I))] = 0
C
C  THEN
C
C    SCALE = {((1/N)*SUM[i=1 to n][Y(I)**(-GHAT)])}**(-1/GHAT)
C
C  FOR STARTING VALUE, USE FACT THAT FRECHET = EXPONENTIAL OF
C  GUMBEL DISTRIBUTION.  THEN GHAT = 1/SCALE WITH SCALE DENOTING
C  THE SCALE ESTIMATE OF THE GUMBEL DISTRIBUTION.
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLFR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      AN=REAL(N)
C
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL SD(XTEMP,N,IWRITE,XLOGSD,IBUGA3,IERROR)
      CALL SUM(XTEMP,N,IWRITE,XLOGSM,IBUGA3,IERROR)
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
C
C  ESTIMATES FOR 2-PARAMETER MODEL.  USE DFZER2 TO FIND ROOT OF
C  THE EQUATION GIVEN ABOVE.
C
      DO4101I=1,N
        DTEMP(I)=DBLE(Y(I))
 4101 CONTINUE
      DEV2SM=DBLE(XLOGSM/AN)
      DXSTRT=DBLE(SQRT(1.645)*XSD)
      DAE=2.0*0.000001D0*DXSTRT
      DRE=DAE
      IN=N
      IFLAG=0
      DXLOW=DXSTRT/5.0D0
      DXUP=5.0D0*DXSTRT
      ITBRAC=0
 4105 CONTINUE
      XLOWSV=DXLOW
      XUPSV=DXUP
      CALL DFZER2(EV2FUN,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
C
      IF(IFLAG.EQ.4 .AND. ITBRAC.LE.100)THEN
        DXLOW=XLOWSV/2.0D0
        DXUP=2.0D0*XUPSV
        ITBRAC=ITBRAC+1
        GOTO4105
      ENDIF
C
      IF(IFLAG.EQ.2)THEN
C
C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,111)
CC111   FORMAT('***** WARNING FROM FRECHET MAXIMUM ',
CCCCC1         'LIKELIHOOD--')
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,113)
CC113   FORMAT('      ESTIMATE OF SIGMA MAY NOT BE COMPUTED TO ',
CCCCC1         'DESIRED 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 FRECHET MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,123)
  123   FORMAT('      ESTIMATE OF GAMMA 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 FRECHET MAXIMUM LIKELIHOOD--')
        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 FRECHET MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,143)
  143   FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      GAMMA=REAL(DXLOW)
      DSUM=0.0D0
      DO4108I=1,N
        DSUM=DSUM + DBLE(Y(I)**(-GAMMA))
 4108 CONTINUE
      DSUM=(DSUM/DBLE(N))**(1.0D0/DBLE(-GAMMA))
      SCALE=REAL(DSUM)
      BN=1.0 + 2.2/AN**1.13
      GAMMBC=GAMMA/BN
C
C  COMPUTE STANDARD ERRORS (CAN BASE ON EITHER THE NORMAL BIASED
C  ESTIMATORS OR THE BIAS CORRECTED ESTIMATORS)
C
      SCALSE=1.05293*SCALE/(GAMMA*SQRT(AN))
      GAMMSE=0.77970*GAMMA/SQRT(AN)
      GABCSE=0.77970*GAMMA/(BN*SQRT(AN))
      COVSE=0.50697*SQRT(SCALE/AN)
      COBCSE=0.50697*SQRT(SCALE/(AN*BN))
C
C  CONFIDENCE INTERVALS FOR PARAMETERS.  CAN BASE ON EITHER NORMAL
C  APPROXIMATION OR ON LIKELIHOOD RATIO APPROXIMATION.
C
C  NORMAL APPROXIMATION FIRST.
C
      DO4110I=1,NUMALP
        ALP=ALPHA(I)
        P=1.0-(ALP/2.0)
        CALL NORPPF(P,PPF)
        ALOWSC(I)=SCALE - PPF*SCALSE
        AUPPSC(I)=SCALE + PPF*SCALSE
        IF(IFREBC.EQ.'ON')THEN
          ALOWGA(I)=GAMMBC - PPF*GABCSE
          AUPPGA(I)=GAMMBC + PPF*GABCSE
        ELSE
          ALOWGA(I)=GAMMA - PPF*GAMMSE
          AUPPGA(I)=GAMMA + PPF*GAMMSE
        ENDIF
 4110 CONTINUE
C
C  NOW DO LIKELIHOOD RATIO APPROXIMATION.
C
      IN2=N
      IN3=N
      DN=DBLE(N)
      DAE=1.D-7
      DRE=1.D-7
      NUTEMP=1
C
      DN=DBLE(N)
      DG=DBLE(GAMMA)
      DS=DBLE(SCALE)
      DT1=DN*DLOG(DBLE(GAMMA)) + DN*DG*DLOG(DS)
      DSUM1=0.0D0
      DSUM2=0.0D0
      DO4125I=1,N
        DTEMP(I)=DBLE(Y(I))
        DSUM1=DSUM1 + DLOG(DBLE(Y(I)))
        DSUM2=DSUM2 + DBLE(Y(I))**(-DG)
 4125 CONTINUE
      DTERM2=DSUM1
      DTERM1=2.0D0*(DT1 - (DG+1.0D0)*DTERM2 - DS**DG*DSUM2)
      DTERM7=DTERM2
      DTERM6=DTERM1
      DGAMMA=DBLE(GAMMA)
C
      DO4120I=1,NUMALP
        ALP=ALPHA(I)
        CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
        DK=DBLE(APPF)
        DK2=DK
C
        DXSTRT=DBLE(ALOWGA(I))
        DXLOW=DXSTRT/5.0D0
        DXUP=DBLE(GAMMA)
        CALL DFZER2(EV2FU2,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
        ALOWG2(I)=REAL(DXLOW)
C
        DXSTRT=DBLE(AUPPGA(I))
        DXUP=DXSTRT*5.0D0
        DXLOW=DBLE(GAMMA)
        CALL DFZER2(EV2FU2,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
        AUPPG2(I)=REAL(DXLOW)
C
        DXSTRT=DBLE(ALOWSC(I))
        DXLOW=DXSTRT/5.0D0
        DXUP=DBLE(SCALE)
        CALL DFZER2(EV2FU3,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
        ALOWS2(I)=REAL(DXLOW)
C
        DXSTRT=DBLE(AUPPSC(I))
        DXUP=DXSTRT*5.0D0
        DXLOW=DBLE(SCALE)
        CALL DFZER2(EV2FU3,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
        AUPPS2(I)=REAL(DXLOW)
 4120 CONTINUE
C
C  CONFIDENCE INTERVALS FOR SELECTED PERCENTILES.
C
C  1. STANDARD ERROR USES TECHNIQUE DEMONSTRATED IN EXAMPLE 17.4
C     (P. 344) OF BURY.  THIS IS BASED ON PROPOGATION OF ERROR.
C 
C  2. CONFIDENCE INTERVAL IS THEN GENERATED USING NORMAL
C     APPROXIMATION (EXAMPLE 17.7 OF BURY).  BURY ALSO DEMONSTRATES
C     A LIKELIHOOD RATIO APPROACH, BUT OMIT THIS FOR NOW.
C
      IF(NPERC.GE.1)THEN
C
        ALPHL=ALPHAP/2.0
        ALPHU=1.0 - ALPHAP/2.0
        CALL NORPPF(ALPHU,Z95)
        MINMAX=2
C
        IF(IFREBC.EQ.'ON')THEN
          G=GAMMBC
          GSE=GABCSE
          COV=COBCSE
        ELSE
          G=GAMMA
          GSE=GAMMSE
          COV=COVSE
        ENDIF
C
        WRITE(IOUNI1,4131)
        WRITE(IOUNI1,4132)
        DO4129I=1,NPERC
          QPTEMP=QP(I)/100.0
          CALL EV2PPF(QPTEMP,G,MINMAX,APPF)
          XQPHAT(I)=SCALE*APPF
C
          C=LOG(1.0/QPTEMP)
          DA=C**(-1.0/G)
          DB=(SCALE*C**(-1.0/G)*LOG(C)/(G**2))
          TERM1=(DA*SCALSE)**2
          TERM2=(DB*GSE)**2
          TERM3=2.0*DA*DB*COV*COV
          SEXQP=SQRT(TERM1 + TERM2 + TERM3)
          XQPSE(I)=SEXQP
          XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
          XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
          WRITE(IOUNI1,'(5E15.7)')
     1         QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
 4129   CONTINUE
 4131   FORMAT(15X,'       POINT     ','     LOWER     ',
     1         '     UPPER')
 4132   FORMAT('    PERCENTILE ','     ESTIMATE   ',
     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
      ENDIF
C
C               *************************************
C               **   STEP 42--                     **
C               **   WRITE OUT EVERYTHING          **
C               **   FOR FRECHET MLE ESTIMATE      **
C               *************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLFR')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5002   FORMAT('<B>FRECHET MAXIMUM LIKELIHOOD ESTIMATION:')
 5004   FORMAT('<BR>FULL SAMPLE CASE</B>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Two-Parameter Model (Location = 0)</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=350>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Minimum Value:')
 5063   FORMAT('         Sample Mean:')
 5064   FORMAT('         Sample Standard Deviation:')
 5065   FORMAT('         Estimate of Scale Parameter:')
 5066   FORMAT('         Standard Error of Scale Parameter:')
 5067   FORMAT('         Estimate of Shape Parameter:')
 5068   FORMAT('         Standard Error of Shape Parameter:')
55067   FORMAT('         Estimate of Bias Corrected Shape Parameter:')
55068   FORMAT('         Standard Error of Bias Corrected Shape ',
     1         'Parameter:')
 5069   FORMAT('         Standard Error of Covariance of Scale and ',
     1         'Shape Parameter:')
55069   FORMAT('         Standard Error of Bias Corrected Covariance ',
     1         'of Scale and Shape Parameter:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMA
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMBC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GABCSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)COVSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)COBCSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Limits for the Shape ',
     1         'Parameter</B><BR>')
 5118   FORMAT('      <B>(Based on Biased Estimate)</B>')
55118   FORMAT('      <B>(Based on Bias Corrected Estimate)</B>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        IF(IFREBC.EQ.'ON')THEN
          WRITE(ICOUT,55118)
        ELSE
          WRITE(ICOUT,5118)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5134   FORMAT('         &nbsp;')
 5136   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM COLSPAN=2>')
 5137   FORMAT('         Normal Approximation')
 5138   FORMAT('         Likelihood Ratio')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=5>')
 5162   FORMAT('          <HR>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5138)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        DO5140I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWGA(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPGA(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWG2(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPG2(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5140   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5217   FORMAT('      <B>Confidence Limits for the Scale ',
     1         'Parameter</B>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5217)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5138)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
        DO5240I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWSC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPSC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWS2(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPS2(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5240   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  START THE TABLE FOR PERCENTILE CONFIDENCE INTERVALS
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,999)
          WRITE(ICOUT,5811)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5813)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5815)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5817)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5816)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5819)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5861)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,55862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5863)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5864)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5870)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5872)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5847)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          DO55880I=1,NPERC
            WRITE(ICOUT,5841)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)QP(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPHAT(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPSE(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPLCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPUCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5859)
            CALL DPWRST('XXX','WRIT')
55880     CONTINUE
C
C  END THE TABLE AND RESET ASIS MODE
C
          WRITE(ICOUT,5191)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5193)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,5801)
        CALL DPWRST('XXX','WRIT')
C
 5801     FORMAT('<PRE>')
 5811     FORMAT('<UL>')
 5813     FORMAT('<TABLE NOBORDER>')
 5815     FORMAT('   <CAPTION ALIGN=CENTER>')
 5816     FORMAT('      <BR><B>Alpha = ',F7.3,'</B>')
 5817     FORMAT('      <B>Confidence Limits (Normal Approximation) ',
     1           'for Selected ',
     1           'Percentiles<br>(No Bias Correction Estimates)</B>')
 5818     FORMAT('      <B>Confidence Limits (Normal Approximation)',
     1           ' for Selected ',
     1           'Percentiles<br>(Bias Corrected Estimates)</B>')
 5819     FORMAT('   </CAPTION>')
 5841     FORMAT('   <TR>')
 5843     FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5847     FORMAT('      </TD>')
 5848     FORMAT('      </TH>')
 5849     FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5851     FORMAT('         ',G15.7)
 5859     FORMAT('   </TR>')
 5861     FORMAT('         Percentile')
 5862     FORMAT('         Point <br> Estimate')
55862     FORMAT('         Standard <br> Error')
 5863     FORMAT('         Lower <br>Confidence Limit')
 5864     FORMAT('         Upper <br>Confidence Limit')
 5870     FORMAT('      <TD COLSPAN=5>')
 5872     FORMAT('         <HR WIDTH=600>')
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001   FORMAT(A1,'end{verbatim}')
 8003   FORMAT(A1,'begin{table}')
 8004   FORMAT(A1,'end{table}')
 8005   FORMAT('{',A1,'bf FRECHET Maximum Likelihood ',
     1         'Estimation: Full Sample Case}')
 8007   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009   FORMAT(A1,'begin{center}')
 8011   FORMAT(5X,'{',A1,'bf Two-Parameter Model ($',A1,
     1         'mu$ = 0 Case)}')
 8013   FORMAT(A1,'end{center}')
 8015   FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020   FORMAT(5X,A1,'begin{tabular} {lr}')
 8021   FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022   FORMAT(5X,'Minimum Value: & ',G15.7,2X,A1,A1)
 8023   FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8024   FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8025   FORMAT(5X,'Estimate of Scale Parameter: & ',G15.7,2X,A1,A1)
 8026   FORMAT(5X,'Standard Error of Scale Parameter: & ',
     1         G15.7,2X,A1,A1)
 8027   FORMAT(5X,'Estimate of Shape Parameter: & ',G15.7,2X,A1,A1)
 8028   FORMAT(5X,'Standard Error of Shape Parameter: & ',
     1         G15.7,2X,A1,A1)
 8029   FORMAT(5X,'Estimate of Bias Corrected Shape Parameter: & ',
     1         G15.7,2X,A1,A1)
 8030   FORMAT(5X,'Standard Error of Bias Corrected Shape ',
     1         'Parameter: & ',G15.7,2X,A1,A1)
 8031   FORMAT(5X,'Standard Error of Covariance of Scale and Shape ',
     1         'Parameter: & ',G15.7,2X,A1,A1)
 8032   FORMAT(5X,'Standard Error of Bias Corrected Covariance of ',
     1         'Scale and Shape  Parameter: & ',G15.7,2X,A1,A1)
 8035   FORMAT(5X,'  & ',2X,A1,A1)
 8049   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8035)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)SCALE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)SCALSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8035)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)GAMMA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)GAMMSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)GAMMBC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)GABCSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8035)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)COVSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)COBCSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8093   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for Shape Parameter ',
     1       '(Based on No Bias Correction Estimate)}')
 8112 FORMAT(5X,'{',A1,'bf Confidence Limits for Shape Parameter ',
     1       '(Based on Bias Corrected Estimate)}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IFREBC.EQ.'ON')THEN
          WRITE(ICOUT,8112)IBASLC
        ELSE
          WRITE(ICOUT,8111)IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120   FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper & Lower & Upper ',
     1         2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit & Limit & Limit',
     1         2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,' & ',G15.7,' & ',
     1         G15.7,2X,A1,A1)
 8126   FORMAT(5X,'& ',A1,'multicolumn{2}{c}{Normal Approximation}',
     1         ' & ',A1,'multicolumn{2}{c}{Likelihood Ratio}',
     1         2X,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8126)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8130I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWGA(I),AUPPGA(I),ALOWG2(I),
     1                     AUPPG2(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8130   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8191   FORMAT(A1,'end{table}')
 8193   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8211 FORMAT(5X,'{',A1,'bf Confidence Limits for Scale Parameter}')
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8211)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8126)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8230I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWSC(I),AUPPSC(I),ALOWS2(I),
     1                     AUPPS2(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8230   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8191)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C WRITE SELECTED PERCENTILES (IF ANY)
C
        IF(NPERC.GT.0)THEN
C
          CALL DPCONA(92,IBASLC)
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8803)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8810)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          IF(IFREBC.EQ.'ON')THEN
            WRITE(ICOUT,88811)IBASLC
          ELSE
            WRITE(ICOUT,8811)IBASLC
          ENDIF
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8812)IBASLC,IBASLC,ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8813)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8820)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8821)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8822)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,
     1                     IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8840)IBASLC
          CALL DPWRST('XXX','WRIT')
          DO8830I=1,NPERC
            WRITE(ICOUT,8823)QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),
     1                       XQPUCL(I),IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
 8830     CONTINUE
          WRITE(ICOUT,8849)IBASLC
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8891)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8893)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
 8801   FORMAT(A1,'end{verbatim}')
 8803   FORMAT(A1,'begin{table}')
 8807   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8809   FORMAT(A1,'begin{center}')
 8810   FORMAT(5X,'{',A1,'bf Confidence Limits (Normal Approximation)',
     1         'for Selected Percentiles}')
 8811   FORMAT(5X,'{',A1,'bf (Based on No Bias Correction Estimates:}')
88811   FORMAT(5X,'{',A1,'bf (Based on Bias Corrected Estimates:}')
 8812   FORMAT(5X,'{',A1,'bf $',A1,'alpha$ = ',F7.3,'}')
 8813   FORMAT(A1,'end{center}')
 8815   FORMAT(5X,'} ',A1,A1)
 8820   FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8821   FORMAT(5X,' & {',A1,'bf Point} & {',A1,'bf Standard} & {',
     1         A1,'bf Lower} & {',A1,'bf Upper}',2X,A1,A1)
 8822   FORMAT(5X,'{',A1,'bf Percentile} & {',A1,'bf Estimate} & {',
     1         A1,'bf Error} & {',A1,'bf Confidence Limit} & {',
     1         A1,'bf Confidence Limit}',
     1         2X,A1,A1)
 8823   FORMAT(5X,G15.7,' & ',G15.7,' & ',G15.7,' & ',G15.7,
     1         ' & ',G15.7,2X,A1,A1)
 8840   FORMAT(5X,A1,'hline')
 8849   FORMAT(A1,'end{tabular}')
 8891   FORMAT(A1,'end{center}')
 8893   FORMAT(A1,'end{table}')
C
 8899   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8899)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(6X,'FRECHET MAXIMUM LIKELIHOOD ESTIMATION: ',
     1         'FULL SAMPLE CASE')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4213)
 4213   FORMAT('TWO-PARAMETER MODEL (LOCATION = 0)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4215)N
 4215   FORMAT('NUMBER OF OBSERVATIONS                            = ',
     1         I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4217)XMIN
 4217   FORMAT('MINIMUM VALUE                                     = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4219)XMEAN
 4219   FORMAT('SAMPLE MEAN VALUE                                 = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)XSD
 4221   FORMAT('SAMPLE STANDARD DEVIATION VALUE                   = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)SCALE
 4223   FORMAT('ESTIMATE OF SCALE PARAMETER                       = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)SCALSE
 4225   FORMAT('STANDARD ERROR OF SCALE PARAMETER                 = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4227)GAMMA
 4227   FORMAT('ESTIMATE OF SHAPE PARAMETER                       = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4231)GAMMSE
 4231   FORMAT('STANDARD ERROR OF SHAPE PARAMETER                 = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4229)GAMMBC
 4229   FORMAT('BIAS CORRECTED ESTIMATE OF SHAPE PARAMETER        = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4232)GABCSE
 4232   FORMAT('STANDARD ERROR OF BIAS CORRECTED SHAPE PARAMETER  = ',
     1        G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4233)COVSE
 4233   FORMAT('STANDARD ERROR OF SHAPE/SCALE COVARIANCE          = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4234)COBCSE
 4234   FORMAT('STD ERR OF BIAS CORRECTED SHAPE/SCALE COVARIANCE  = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4240)
 4240   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)
 4242   FORMAT('                       NORMAL APPROXIMATION',
     1         '            LIKELIHOOD RATIO')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)
 4243   FORMAT('   CONFIDENCE           LOWER         UPPER',
     1         '         LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)
 4245   FORMAT('   VALUE (%)            LIMIT         LIMIT',
     1         '         LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4246)
 4246   FORMAT('---------------------------------------------------',
     1         '--------------------')
        CALL DPWRST('XXX','WRIT')
        DO4249I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4247)ATEMP,ALOWSC(I),AUPPSC(I),ALOWS2(I),
     1                     AUPPS2(I)
 4247     FORMAT('   ',F8.3,10X,4(G12.6,2X))
          CALL DPWRST('XXX','WRIT')
 4249   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4252)
 4252   FORMAT('CONFIDENCE INTERVAL FOR SHAPE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        IF(IFREBC.EQ.'ON')THEN
          WRITE(ICOUT,4254)
 4254     FORMAT('(BASED ON BIAS CORRECTED ESTIMATES)')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4256)
 4256     FORMAT('(BASED ON NO BIAS CORRECTION ESTIMATES)')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4246)
        CALL DPWRST('XXX','WRIT')
        DO4259I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4247)ATEMP,ALOWGA(I),AUPPGA(I),ALOWG2(I),
     1                     AUPPG2(I)
          CALL DPWRST('XXX','WRIT')
 4259   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,4911)
          CALL DPWRST('XXX','WRIT')
          IF(IFREBC.EQ.'ON')THEN
            WRITE(ICOUT,4913)
          ELSE
            WRITE(ICOUT,4914)
          ENDIF
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4915)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4921)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4922)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4346)
          CALL DPWRST('XXX','WRIT')
C
 4911   FORMAT('CONFIDENCE LIMITS (NORMAL APPROXIMATION) FOR ',
     1         'SELECTED PERCENTILES:')
 4913   FORMAT('(BASED ON BIAS CORRECTED ESTIMATES)')
 4914   FORMAT('(BASED ON NO BIAS CORRECTION ESTIMATES)')
 4915   FORMAT('ALPHA = ',F7.4)
 4921   FORMAT(10X,'      POINT     ','  STANDARD   ',
     1             '        LOWER     ', '       UPPER')
 4922   FORMAT('PERCENTILE','   ESTIMATE   ','      ERROR     ',
     1         'CONFIDENCE LIMIT ',' CONFIDENCE LIMIT')
 4346   FORMAT('-----------------------------------',
     1         '-----------------------------------')
C
          DO4981I=1,NPERC
            WRITE(ICOUT,4932)QP(I),XQPHAT(I),XQPSE(I),
     1                       XQPLCL(I),XQPUCL(I)
 4932       FORMAT(2X,F8.4,2G15.7,2X,G15.7,2X,G15.7)
            CALL DPWRST('XXX','WRIT')
 4981     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,4291)
 4291     FORMAT('THE FOLLOWING INTERNAL PARAMETERS ARE SAVED:')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4293)
 4293     FORMAT('      ALPHAML, ALPHASE, GAMMAML, GAMMASE, ',
     1           'CAMMABC, GAMMABCSE,COVSE,COVBCSE')
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IF(IFEEDB.EQ.'ON')THEN
          IF(NPERC.GT.0)THEN
            WRITE(ICOUT,4943)
 4943       FORMAT('PERCENTILE CONFIDENCE LIMITS  WRITTEN TO ',
     1             'FILE  dpst1f.dat')
            CALL DPWRST('XXX','BUG ')
          ENDIF
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLFR')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLFR--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLGA(Y,N,
     1XTEMP,MAXNXT,
     1GAMMA,ALPHA,GAMMA2,ALPHA2,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR 2-PARAMETER GAMMA
C     EXAMPLE--MAXIMUM LIKELIHOOD GAMMA Y
C     REFERENCE--XX
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/3
C     ORIGINAL VERSION--MARCH     1998.
C     UPDATED         --DECEMBER  2003. ADD MOMENT ESTIMATES
C     UPDATED         --DECEMBER  2003. SUPPORT HTML/LATEX OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*4 IWRITE
      CHARACTER*1 IBASLC
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
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='DPML'
      ISUBN2='GA  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLGA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPMLGA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)N
   55 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO56I=1,N
      WRITE(ICOUT,57)I,Y(I)
   57 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   56 CONTINUE
   66 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPMLGA--THE NUMBER OF OBSERVATIONS ',
     1'FOR VARIABLE 1 IS NON-POSITIVE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1112)N
 1112 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(N.EQ.1)GOTO1120
      GOTO1129
 1120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** NOTE FROM DPMLGA--VARIABLE 1 ',
     1'HAS ONLY 1 ELEMENT')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1129 CONTINUE
C
      HOLD=Y(1)
      DO1135I=2,N
      IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM DPMLGA--VARIABLE 1 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
      DO1145I=1,N
        IF(Y(I).LE.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1141)
 1141     FORMAT('***** GAMMA FROM WEIBULL MAXIMUM LIKELIHOOD--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1142)
 1142     FORMAT('      NON-POSITIVE VALUE ENCOUNTERED.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1144)I,Y(I)
 1144     FORMAT('      ROW ',I8,' HAS THE VALUE = ',E15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
 1145 CONTINUE
C
C               ******************************
C               **  STEP 41--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR GAMMA MLE ESTIMATE  **
C               ******************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      CALL GAMEST(Y,N,ALPHA,GAMMA,IERROR)
C
CCCCC 12/2003: COMPUTE METHOD OF MOMENT ESTIMATES
C
      IWRITE='OFF'
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      GAMMA2=(XMEAN/XSD)**2
      ALPHA2=XSD**2/XMEAN
C
C               *********************************
C               **   STEP 42--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR GAMMA MLE ESTIMATE    **
C               **********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Gamma 2-Parameter Maximum Likelihood ',
     1         'Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=250>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Mean:')
 5063   FORMAT('         Sample Standard Deviation:')
 5064   FORMAT('         <B>Maximum Likelihood Estimates:</B>')
 5065   FORMAT('         Shape Parameter Gamma:')
 5066   FORMAT('         Scale Parameter Alpha:')
 5067   FORMAT('         <B>Method of Moments Estimates:</B>')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMA
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALPHA
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMA2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALPHA2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Gamma 2-Parameter Maximum Likelihood ',
     1       'Estimate}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'{',A1,'bf Maximum Likelihood Estimates:} & ',2X,A1,A1)
 8025 FORMAT(5X,'Shape Parameter Gamma: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Scale Parameter Alpha: & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,'{',A1,'bf Method of Moments Estimates:} & ',2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)GAMMA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)ALPHA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)GAMMA2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)ALPHA2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{center}')
 8093 FORMAT(A1,'end{table}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT('GAMMA 2-PARAMETER MAXIMUM LIKELIHOOD ESTIMATE:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)N
 4221   FORMAT(6X,'NUMBER OF OBSERVATIONS          = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)XMEAN
 4223   FORMAT(6X,'SAMPLE MEAN                     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)XSD
 4225   FORMAT(6X,'SAMPLE STANDARD DEVIATION       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4340)
 4340   FORMAT(6X,'MAXIMUM LIKELIHOOD ESTIMATES')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4343)GAMMA
 4343   FORMAT(6X,'      SHAPE PARAMETER GAMMA     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4345)ALPHA
 4345   FORMAT(6X,'      SCALE PARAMETER ALPHA     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4350)
 4350   FORMAT(6X,'METHOD OF MOMENTS ESTIMATES')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4353)GAMMA2
 4353   FORMAT(6X,'      SHAPE PARAMETER GAMMA     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4355)ALPHA2
 4355   FORMAT(6X,'      SCALE PARAMETER ALPHA     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
      IF(IFEEDB.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4441)
 4441   FORMAT('MAXIMUM LIKELIHHOD ESTIMATES WILL BE SAVED IN THE')
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,4443)
 4443   FORMAT('INTERNAL PARAMETERS GAMMA AND ALPHA')
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,4451)
 4451   FORMAT('METHOD OF MOMENTS ESTIMATES WILL BE SAVED IN THE')
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,4453)
 4453   FORMAT('INTERNAL PARAMETERS GAMMA2 AND ALPHA2')
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG')
      ENDIF
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLGA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMLGA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMLG1(Y,TAG,N,
     1XTEMP,DTEMP,MAXNXT,
     1SCALMO,GAMMMO,SCALML,SCALSE,GAMMML,GAMMSE,COVSE,
     1NUMV,ICENTY,TEND,
     1ICAPSW,ICAPTY,
     1QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
     1IOUNI1,IOUNI2,ALPHAP,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR GAMMA DISTRIBUTION
C              FOR THE FULL SAMPLE CASE.
C     EXAMPLE--GAMMA MAXIMUM LIKELIHOOD Y
C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
C                1999, CHAPTER 13.
C              --JOHNSON, KOTZ, AND BALAKRISNAN, "CONTINUOUS
C                UNIVARIATE DISTRIBUTIONS--VOLUME 1", SECOND EDITION,
C                WILEY, 1994, CHAPTER xx.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/11
C     ORIGINAL VERSION--NOVEMBER  2004. NOTE: THIS REPLACES SOME
C                                       EARLIER IMPLEMENTATIONS.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICENTY
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      PARAMETER (NUMALP=6)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWSC(NUMALP)
      DIMENSION AUPPSC(NUMALP)
      DIMENSION ALOWGA(NUMALP)
      DIMENSION AUPPGA(NUMALP)
      DIMENSION ALOWS2(NUMALP)
      DIMENSION AUPPS2(NUMALP)
      DIMENSION ALOWG2(NUMALP)
      DIMENSION AUPPG2(NUMALP)
C
      DIMENSION Y(*)
      DIMENSION TAG(*)
      DIMENSION XTEMP(*)
      DIMENSION QP(*)
      DIMENSION XQPHAT(*)
      DIMENSION XQPSE(*)
      DIMENSION XQPLCL(*)
      DIMENSION XQPUCL(*)
      DOUBLE PRECISION DTEMP(*)
C
      DOUBLE PRECISION GAMFUN
      DOUBLE PRECISION GAMFU2
      DOUBLE PRECISION GAMFU3
      EXTERNAL SUM
      EXTERNAL GAMFUN
      EXTERNAL GAMFU2
      EXTERNAL GAMFU3
      EXTERNAL GAMFU8
      EXTERNAL GAMFU9
C
      DOUBLE PRECISION DLOGGM
      COMMON/GAMCOM/DLOGGM
C
      INTEGER IN2
      DOUBLE PRECISION DK
      DOUBLE PRECISION DXBAR
      DOUBLE PRECISION DGMEAN
      DOUBLE PRECISION DSCALE
      DOUBLE PRECISION DGAM
      COMMON/GAMCO2/DK,DXBAR,DGMEAN,DSCALE,DGAM,IN2
C
      INTEGER IN3
      DOUBLE PRECISION DK2
      DOUBLE PRECISION DTERM6
      DOUBLE PRECISION DTERM7
      DOUBLE PRECISION DGAMMA
      COMMON/GAMCO3/DK2,DTERM6,DTERM7,DGAMMA,IN3
C
      COMMON/GAMCO8/P8,SCALE8
      COMMON/GAMCO9/P9,GHAT9
C
      DOUBLE PRECISION DN
      DOUBLE PRECISION AE
      DOUBLE PRECISION RE
      DOUBLE PRECISION DG
      DOUBLE PRECISION DS
      DOUBLE PRECISION DT1
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION DXSTRT
      DOUBLE PRECISION DXLOW
      DOUBLE PRECISION DXUP
      DOUBLE PRECISION XLOWSV
      DOUBLE PRECISION XUPSV
      DOUBLE PRECISION DANS(10)
      DOUBLE PRECISION TRIGAM
      DOUBLE PRECISION DTRM11
      DOUBLE PRECISION DTRM12
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
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='G1  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG1')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLG1--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,NUMV
   55   FORMAT('N,NUMV,NPERC = ',3I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I),TAG(I)
   57     FORMAT('I,Y(I),TAG(I) = ',I8,2E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
        WRITE(ICOUT,59)ICENTY
   59   FORMAT('ICENTY = ',A4)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN GAMMA MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)
 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 1 ',
     1         'IS <= 1')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)N
 1113   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      DO1125I=1,N
        IF(Y(I).LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1121)
 1121     FORMAT('***** ERROR FROM GAMMA MAXIMUM LIKELIHOOD--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1122)
 1122     FORMAT('      A NEGATIVE VALUE WAS ENCOUNTERED.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1123)I,Y(I)
 1123     FORMAT('      ROW ',I8,' HAS THE VALUE = ',E15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
 1125 CONTINUE
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** WARNING FROM GAMMA MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1132)HOLD
 1132 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
      IF(NPERC.GT.0)THEN
        DO1145I=1,NPERC
          IF(QP(I).LE.0.0 .OR. QP(I).GE.100.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1141)
 1141       FORMAT('***** WARNING IN GAMMA MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1143)QP(I)
 1143       FORMAT('      REQUESTED PERCENTILE (',G15.7,') IS ',
     1             'OUTSIDE THE (0,100) INTERVAL')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1144)
 1144       FORMAT('      NO PERCENTILE CONFIDENCE LIMITS WILL BE ',
     1             'COMPUTED.')
            CALL DPWRST('XXX','WRIT')
            NPERC=0
          ENDIF
 1145   CONTINUE
      ENDIF
C
C               **********************************
C               **  STEP 41--                   **
C               **  CARRY OUT CALCULATIONS      **
C               **  FOR GAMMA MLE               **
C               **  ESTIMATE (FULL SAMPLE CASE) **
C               **********************************
C
 4100 CONTINUE
C
C  FOR THE SHAPE PARAMETER, SOLVE THE EQUATION:
C
C    LOG(GAMMAHAT) - PHI(GAMMAHAT) - LOG(XBAR/G) = 0
C
C  WITH G DENOTING THE GEOMETRIC MEAN (PRODUCT[i=1 to n][X(i)**(1/N)]
C
C  THEN
C
C    SCALE = XBAR/GAMMAHAT
C
C  FOR STARTING VALUE, USE THE METHOD OF MOMENT ESTIMATORS
C
C    GAMMAHAT = (XBAR/XSD)**2
C    SCALE    = XSD**2/XBAR
C
C    
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      AN=REAL(N)
C
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL GEOMEA(Y,N,IWRITE,XGEOM,IBUGA3,IERROR)
C
      GAMMMO=(XMEAN/XSD)**2
      SCALMO=XSD**2/XMEAN
C
C
C  ESTIMATES FOR 2-PARAMETER MODEL.  USE DFZER2 TO FIND ROOT OF
C  THE LIKELIHOOD EQUATION.
C
      DLOGGM=DLOG(DBLE(XMEAN)/DBLE(XGEOM))
      DXSTRT=DBLE(GAMMMO)
      AE=2.0*0.000001D0*DXSTRT
      RE=AE
      IFLAG=0
      DXLOW=DXSTRT/2.0D0
      DXUP=2.0D0*DXSTRT
      ITBRAC=0
 4105 CONTINUE
      XLOWSV=DXLOW
      XUPSV=DXUP
      CALL DFZERO(GAMFUN,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG)
C
      IF(IFLAG.EQ.4 .AND. ITBRAC.LE.100)THEN
        DXLOW=XLOWSV/2.0D0
        DXUP=2.0D0*XUPSV
        ITBRAC=ITBRAC+1
        GOTO4105
      ENDIF
C
      IF(IFLAG.EQ.2)THEN
C
C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,111)
CC111   FORMAT('***** WARNING FROM GAMMA MAXIMUM ',
CCCCC1         'LIKELIHOOD--')
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,113)
CC113   FORMAT('      ESTIMATE OF GAMMA MAY NOT BE COMPUTED TO ',
CCCCC1         'DESIRED 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 GAMMA MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,123)
  123   FORMAT('      ESTIMATE OF GAMMA 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 GAMMA MAXIMUM LIKELIHOOD--')
        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 GAMMA MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,143)
  143   FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C
C  COMPUTE STANDARD ERRORS (CAN BASE ON EITHER THE NORMAL BIASED
C  ESTIMATORS OR THE BIAS CORRECTED ESTIMATORS)
C
C  NOTE THAT DPSIFN COMPUTES THE SCALED PSI DERIVATIVE FUNCTION:
C
C     (-1)**(K+1)/GAMMA(K+1)
C
C  FOR TRIGAMMA, K=1 AND THE SCALING FACTOR REDUCES TO 1.
C
      GAMMML=REAL(DXLOW)
      SCALML=XMEAN/GAMMML
C
      DN=DBLE(N)
      DG=DBLE(GAMMML)
      DS=DBLE(SCALML)
      KODE=1
      NTEMP=1
      M=1
      NZ=0
      CALL DPSIFN(DG,NTEMP,KODE,M,DANS,NZ,IERR)
      TRIGAM=DANS(1)
      IF(IERR.EQ.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3101)
 3101   FORMAT('***** ERROR FROM GAMMA MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3103)
 3103   FORMAT('      UNABLE TO COMPUTE TRIGAMMA FUNCTION.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ELSEIF(IERR.EQ.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3101)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3105)
 3105   FORMAT('      OVERFLOW IN COMPUTING THE TRIGAMMA FUNCTION.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ELSEIF(IERR.EQ.3)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3101)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3107)
 3107   FORMAT('      OVERFLOW IN COMPUTING THE TRIGAMMA FUNCTION.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      DTRM11=DN*(DG*TRIGAM-1.0D0)
      DTRM12=DS**2*TRIGAM
      SCALSE=REAL(DSQRT(DTRM12/DTRM11))
      GAMMSE=REAL(DSQRT(DG/DTRM11))
      COVSE=REAL(-DS/DTRM11)
C
C  CONFIDENCE INTERVALS FOR PARAMETERS.  CAN BASE ON EITHER NORMAL
C  APPROXIMATION OR ON LIKELIHOOD RATIO APPROXIMATION.
C
C  NORMAL APPROXIMATION FIRST.
C
      DO4110I=1,NUMALP
        ALP=ALPHA(I)
        P=1.0-(ALP/2.0)
        CALL NORPPF(P,PPF)
        ALOWSC(I)=SCALML - PPF*SCALSE
        AUPPSC(I)=SCALML + PPF*SCALSE
        ALOWGA(I)=GAMMML - PPF*GAMMSE
        AUPPGA(I)=GAMMML + PPF*GAMMSE
 4110 CONTINUE
C
C  NOW DO LIKELIHOOD RATIO APPROXIMATION.
C
      IN2=N
      IN3=N
      DN=DBLE(N)
      AE=1.D-7
      RE=1.D-7
      NUTEMP=1
C
      DGAM=DBLE(GAMMML)
      DSCALE=DBLE(SCALML)
      DXBAR=DBLE(XMEAN)
      DGMEAN=DBLE(XGEOM)
C
      DO4120I=1,NUMALP
        ALP=ALPHA(I)
        CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
        DK=DBLE(APPF)
        DK2=DK
C
        DXSTRT=DBLE(ALOWGA(I))
        DXLOW=DXSTRT/5.0D0
        DXUP=DBLE(GAMMML)
        CALL DFZERO(GAMFU2,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG)
        ALOWG2(I)=REAL(DXLOW)
C
        DXSTRT=DBLE(AUPPGA(I))
        DXUP=DXSTRT*5.0D0
        DXLOW=DBLE(GAMMML)
        CALL DFZERO(GAMFU2,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG)
        AUPPG2(I)=REAL(DXLOW)
C
        DXSTRT=DBLE(ALOWSC(I))
        DXLOW=DXSTRT/5.0D0
        DXUP=DBLE(SCALML)
        CALL DFZER2(GAMFU3,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG,DTEMP)
        ALOWS2(I)=REAL(DXLOW)
C
        DXSTRT=DBLE(AUPPSC(I))
        DXUP=DXSTRT*5.0D0
        DXLOW=DBLE(SCALML)
        CALL DFZER2(GAMFU3,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG,DTEMP)
        AUPPS2(I)=REAL(DXLOW)
 4120 CONTINUE
C
C  CONFIDENCE INTERVALS FOR SELECTED PERCENTILES.
C
C  1. STANDARD ERROR USES TECHNIQUE DEMONSTRATED IN EXAMPLE 13.1
C     (P. 227) OF BURY.  THIS IS BASED ON PROPOGATION OF ERROR.
C 
C  2. CONFIDENCE INTERVAL IS THEN GENERATED USING NORMAL
C     APPROXIMATION (EXAMPLE 13.1 OF BURY).
C
      IF(NPERC.GE.1)THEN
C
        ALPHL=ALPHAP/2.0
        ALPHU=1.0 - ALPHAP/2.0
        CALL NORPPF(ALPHU,Z95)
C
        GHAT9=GAMMML
        SCALE8=SCALML
        IORD=1
        EPS=0.001
        ACCUR=0.0
C
        WRITE(IOUNI1,4131)
        WRITE(IOUNI1,4132)
        DO4129I=1,NPERC
          QPTEMP=QP(I)/100.0
          CALL GAMPPF(QPTEMP,GAMMML,APPF)
          XQPHAT(I)=SCALML*APPF
C
          P8=QPTEMP
          P9=QPTEMP
C
          IFAIL=0
C
          GHAT   = GAMMML
          GHATMN = 0.0001
          GHATMX = GHAT + 20.0
          CALL DIFF(IORD,GHAT,GHATMN,GHATMX,GAMFU8,EPS,ACCUR,
     1              GHATP,ERROR,IFAIL)
C
          IF(IFAIL.EQ.1)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,301)
  301       FORMAT('***** WARNING IN NUMERICAL DERIVATIVE FOR GAMMA ',
     1             'MAXIMUM LIKELIHOOD PERCENTILES.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,303)
  303       FORMAT('      THE ESTIMATED ERROR IN THE RESULT ',
     1             'EXCEEDS THE')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,305)
  305       FORMAT('      REQUESTED ERROR, BUT THE MOST ACCURATE ',
     1             'RESULT')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,307)
  307       FORMAT('      POSSIBLE HAS BEEN RETURNED.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFAIL.EQ.2)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,311)
  311       FORMAT('***** ERROR IN NUMERICAL DERIVATIVE FOR GAMMA ',
     1             'MAXIMUM LIKELIHOOD PERCENTILES.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,313)
  313       FORMAT('      ERROR IN THE INPUT TO THE DIFF ROUTINE.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,315)
  315       FORMAT('      NO PERCENTILES WILL BE GENERATED.')
            CALL DPWRST('XXX','BUG ')
            NPERC=0
          ELSEIF(IFAIL.EQ.3)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,311)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,323)
  323       FORMAT('      THE INTERVAL FOR DIFFERENTIATION, (',G15.7,
     1             ',',G15.7,')')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,325)
  325       FORMAT('      IS TOO SMALL.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,315)
            CALL DPWRST('XXX','BUG ')
            GHATP=0.0
            NPERC=0
          ENDIF
C
          SCALHT = SCALML
          SCALMN = 0.0001
          SCALMX = SCALHT + 20.0
          CALL DIFF(IORD,SCALHT,SCALMN,SCALMX,GAMFU9,EPS,ACCUR,
     1              SCALEP,ERROR,IFAIL)
C
          IF(IFAIL.EQ.1)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,301)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,303)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,305)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,307)
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFAIL.EQ.2)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,311)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,313)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,315)
            CALL DPWRST('XXX','BUG ')
            NPERC=0
          ELSEIF(IFAIL.EQ.3)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,311)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,323)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,325)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,315)
            CALL DPWRST('XXX','BUG ')
            GHATP=0.0
            NPERC=0
          ENDIF
          D1=SCALEP
          D2=GHATP
          V11=SCALSE**2
          V22=GAMMSE**2
          V21=COVSE
          V12=V21
          TERM11=D1*D1*V11
          TERM12=D1*D2*V12
          TERM21=D2*D1*V21
          TERM22=D2*D2*V22
          SEXQP=TERM11+TERM12+TERM21+TERM22
          IF(SEXQP.GE.0.0)THEN
            SEXQP=SQRT(SEXQP)
          ELSE
            SEXQP=0.0
          ENDIF
          XQPSE(I)=SEXQP
          XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
          XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
          WRITE(IOUNI1,'(5E15.7)')
     1         QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
 4129   CONTINUE
 4131   FORMAT(15X,'       POINT     ','     LOWER     ',
     1         '     UPPER')
 4132   FORMAT('    PERCENTILE ','     ESTIMATE   ',
     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
      ENDIF
C
C               *************************************
C               **   STEP 42--                     **
C               **   WRITE OUT EVERYTHING          **
C               **   FOR GAMMA MLE ESTIMATE      **
C               *************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG1')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5002   FORMAT('<B>GAMMA MAXIMUM LIKELIHOOD ESTIMATION:')
 5004   FORMAT('<BR>FULL SAMPLE CASE</B>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Two-Parameter Model (Location = 0)</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=350>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Minimum Value:')
 5063   FORMAT('         Sample Mean:')
 5064   FORMAT('         Sample Standard Deviation:')
 5065   FORMAT('         Moment Estimate of Scale Parameter:')
 5066   FORMAT('         Moment Estimate of Shape Parameter:')
 5067   FORMAT('         ML Estimate of Scale Parameter:')
 5068   FORMAT('         Standard Error of Scale Parameter:')
 5069   FORMAT('         ML Estimate of Shape Parameter:')
 5070   FORMAT('         Standard Error of Shape Parameter:')
 5071   FORMAT('         Standard Error of Covariance of Scale and ',
     1         'Shape Parameter:')
 5072   FORMAT('         Sample Geometric Mean:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5072)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XGEOM
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALMO
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMMO
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5070)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)COVSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Limits for the Shape ',
     1         'Parameter</B><BR>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5134   FORMAT('         &nbsp;')
 5136   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM COLSPAN=2>')
 5137   FORMAT('         Normal Approximation')
 5138   FORMAT('         Likelihood Ratio')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=5>')
 5162   FORMAT('          <HR>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5138)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        DO5140I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWGA(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPGA(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWG2(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPG2(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5140   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5217   FORMAT('      <B>Confidence Limits for the Scale ',
     1         'Parameter</B>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5217)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5138)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
        DO5240I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWSC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPSC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWS2(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPS2(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5240   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  START THE TABLE FOR PERCENTILE CONFIDENCE INTERVALS
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,5801)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          WRITE(ICOUT,5811)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5813)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5815)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5817)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5816)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5819)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5861)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,55862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5863)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5864)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5870)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5872)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5847)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          DO55880I=1,NPERC
            WRITE(ICOUT,5841)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)QP(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPHAT(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPSE(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPLCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPUCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5859)
            CALL DPWRST('XXX','WRIT')
55880     CONTINUE
C
C  END THE TABLE AND RESET ASIS MODE
C
          WRITE(ICOUT,5191)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5193)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
 5801     FORMAT('</PRE>')
 5811     FORMAT('<UL>')
 5813     FORMAT('<TABLE NOBORDER>')
 5815     FORMAT('   <CAPTION ALIGN=CENTER>')
 5816     FORMAT('      <BR><B>Alpha = ',F7.3,'</B>')
 5817     FORMAT('      <B>Confidence Limits (Normal Approximation) ',
     1           'for Selected Percentiles</B>')
 5819     FORMAT('   </CAPTION>')
 5841     FORMAT('   <TR>')
 5843     FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5847     FORMAT('      </TD>')
 5848     FORMAT('      </TH>')
 5849     FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5851     FORMAT('         ',G15.7)
 5859     FORMAT('   </TR>')
 5861     FORMAT('         Percentile')
 5862     FORMAT('         Point <br> Estimate')
55862     FORMAT('         Standard <br> Error')
 5863     FORMAT('         Lower <br>Confidence Limit')
 5864     FORMAT('         Upper <br>Confidence Limit')
 5870     FORMAT('      <TD COLSPAN=5>')
 5872     FORMAT('         <HR WIDTH=600>')
C
 5199   FORMAT('<PRE>')
        WRITE(ICOUT,5199)
        CALL DPWRST('XXX','WRIT')
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001   FORMAT(A1,'end{verbatim}')
 8003   FORMAT(A1,'begin{table}')
 8004   FORMAT(A1,'end{table}')
 8005   FORMAT('{',A1,'bf Gamma Maximum Likelihood ',
     1         'Estimation: Full Sample Case}')
 8007   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009   FORMAT(A1,'begin{center}')
 8011   FORMAT(5X,'{',A1,'bf Two-Parameter Model ($',A1,
     1         'mu$ = 0 Case)}')
 8013   FORMAT(A1,'end{center}')
 8015   FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020   FORMAT(5X,A1,'begin{tabular} {lr}')
 8021   FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022   FORMAT(5X,'Minimum Value: & ',G15.7,2X,A1,A1)
 8023   FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8024   FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8033   FORMAT(5X,'Sample Geometric Mean: & ',G15.7,2X,A1,A1)
 8025   FORMAT(5X,'Moment Estimate of Scale Parameter: & ',
     1         G15.7,2X,A1,A1)
 8026   FORMAT(5X,'Moment Estimate of Shape Parameter: & ',
     1         G15.7,2X,A1,A1)
 8027   FORMAT(5X,'ML Estimate of Scale Parameter: & ',G15.7,2X,A1,A1)
 8028   FORMAT(5X,'ML Standard Error of Scale Parameter: & ',
     1         G15.7,2X,A1,A1)
 8029   FORMAT(5X,'Estimate of Shape Parameter: & ',G15.7,2X,A1,A1)
 8030   FORMAT(5X,'Standard Error of Shape Parameter: & ',
     1         G15.7,2X,A1,A1)
 8031   FORMAT(5X,'Standard Error of Covariance of Scale and Shape ',
     1         'Parameter: & ',G15.7,2X,A1,A1)
 8035   FORMAT(5X,' & ',2X,A1,A1)
 8049   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8033)XGEOM,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8035)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)SCALMO,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)GAMMMO,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8035)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)SCALML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)SCALSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)GAMMML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)GAMMSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)COVSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8093   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for Shape Parameter ',
     1       '(Based on No Bias Correction Estimate)}')
 8112 FORMAT(5X,'{',A1,'bf Confidence Limits for Shape Parameter ',
     1       '(Based on Bias Corrected Estimate)}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8111)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120   FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper & Lower & Upper ',
     1         2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit & Limit & Limit',
     1         2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,' & ',G15.7,' & ',
     1         G15.7,2X,A1,A1)
 8126   FORMAT(5X,'& ',A1,'multicolumn{2}{c}{Normal Approximation}',
     1         ' & ',A1,'multicolumn{2}{c}{Likelihood Ratio}',
     1         2X,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8126)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8130I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWGA(I),AUPPGA(I),ALOWG2(I),
     1                     AUPPG2(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8130   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8191   FORMAT(A1,'end{table}')
 8193   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8211 FORMAT(5X,'{',A1,'bf Confidence Limits for Scale Parameter}')
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8211)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8126)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8230I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWSC(I),AUPPSC(I),ALOWS2(I),
     1                     AUPPS2(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8230   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8191)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C WRITE SELECTED PERCENTILES (IF ANY)
C
        IF(NPERC.GT.0)THEN
C
          CALL DPCONA(92,IBASLC)
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8803)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8810)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8812)IBASLC,IBASLC,ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8813)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8820)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8821)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8822)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,
     1                     IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8840)IBASLC
          CALL DPWRST('XXX','WRIT')
          DO8830I=1,NPERC
            WRITE(ICOUT,8823)QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),
     1                       XQPUCL(I),IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
 8830     CONTINUE
          WRITE(ICOUT,8849)IBASLC
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8891)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8893)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
 8801   FORMAT(A1,'end{verbatim}')
 8803   FORMAT(A1,'begin{table}')
 8807   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8809   FORMAT(A1,'begin{center}')
 8810   FORMAT(5X,'{',A1,'bf Confidence Limits (Normal Approximation)',
     1         'for Selected Percentiles}')
 8812   FORMAT(5X,'{',A1,'bf $',A1,'alpha$ = ',F7.3,'}')
 8813   FORMAT(A1,'end{center}')
 8815   FORMAT(5X,'} ',A1,A1)
 8820   FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8821   FORMAT(5X,' & {',A1,'bf Point} & {',A1,'bf Standard} & {',
     1         A1,'bf Lower} & {',A1,'bf Upper}',2X,A1,A1)
 8822   FORMAT(5X,'{',A1,'bf Percentile} & {',A1,'bf Estimate} & {',
     1         A1,'bf Error} & {',A1,'bf Confidence Limit} & {',
     1         A1,'bf Confidence Limit}',
     1         2X,A1,A1)
 8823   FORMAT(5X,G15.7,' & ',G15.7,' & ',G15.7,' & ',G15.7,
     1         ' & ',G15.7,2X,A1,A1)
 8840   FORMAT(5X,A1,'hline')
 8849   FORMAT(A1,'end{tabular}')
 8891   FORMAT(A1,'end{center}')
 8893   FORMAT(A1,'end{table}')
C
 8899   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8899)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(6X,'GAMMA MAXIMUM LIKELIHOOD ESTIMATION: ',
     1         'FULL SAMPLE CASE')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4213)
 4213   FORMAT('TWO-PARAMETER MODEL (LOCATION = 0)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4215)N
 4215   FORMAT('NUMBER OF OBSERVATIONS                            = ',
     1         I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4217)XMIN
 4217   FORMAT('MINIMUM VALUE                                     = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4218)XMEAN
 4218   FORMAT('SAMPLE MEAN VALUE                                 = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4219)XSD
 4219   FORMAT('SAMPLE STANDARD DEVIATION VALUE                   = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4220)XGEOM
 4220   FORMAT('SAMPLE GEOMETRIC MEAN VALUE                       = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)SCALMO
 4221   FORMAT('MOMENT ESTIMATE OF SCALE PARAMETER                = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4222)GAMMMO
 4222   FORMAT('MOMENT ESTIMATE OF SHAPE PARAMETER                = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)SCALML
 4223   FORMAT('ML ESTIMATE OF SCALE PARAMETER                    = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)SCALSE
 4225   FORMAT('STANDARD ERROR OF SCALE PARAMETER                 = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4227)GAMMML
 4227   FORMAT('ML ESTIMATE OF SHAPE PARAMETER                    = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4229)GAMMSE
 4229   FORMAT('STANDARD ERROR OF SHAPE PARAMETER                 = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4231)COVSE
 4231   FORMAT('COVARIANCE OF THE SHAPE AND SCALE PARAMETERS      = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4240)
 4240   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)
 4242   FORMAT('                       NORMAL APPROXIMATION',
     1         '            LIKELIHOOD RATIO')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)
 4243   FORMAT('   CONFIDENCE           LOWER         UPPER',
     1         '         LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)
 4245   FORMAT('   VALUE (%)            LIMIT         LIMIT',
     1         '         LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4246)
 4246   FORMAT('---------------------------------------------------',
     1         '--------------------')
        CALL DPWRST('XXX','WRIT')
        DO4249I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4247)ATEMP,ALOWSC(I),AUPPSC(I),ALOWS2(I),
     1                     AUPPS2(I)
 4247     FORMAT('   ',F8.3,10X,4(G12.6,2X))
          CALL DPWRST('XXX','WRIT')
 4249   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4252)
 4252   FORMAT('CONFIDENCE INTERVAL FOR SHAPE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4246)
        CALL DPWRST('XXX','WRIT')
        DO4259I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4247)ATEMP,ALOWGA(I),AUPPGA(I),ALOWG2(I),
     1                     AUPPG2(I)
          CALL DPWRST('XXX','WRIT')
 4259   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,4911)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4915)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4921)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4922)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4346)
          CALL DPWRST('XXX','WRIT')
C
 4911   FORMAT('CONFIDENCE LIMITS (NORMAL APPROXIMATION) FOR ',
     1         'SELECTED PERCENTILES:')
 4915   FORMAT('ALPHA = ',F7.4)
 4921   FORMAT(10X,'      POINT     ','  STANDARD   ',
     1             '        LOWER     ', '       UPPER')
 4922   FORMAT('PERCENTILE','   ESTIMATE   ','      ERROR     ',
     1         'CONFIDENCE LIMIT ',' CONFIDENCE LIMIT')
 4346   FORMAT('-----------------------------------',
     1         '-----------------------------------')
C
          DO4981I=1,NPERC
            WRITE(ICOUT,4932)QP(I),XQPHAT(I),XQPSE(I),
     1                       XQPLCL(I),XQPUCL(I)
 4932       FORMAT(2X,F8.4,2G15.7,2X,G15.7,2X,G15.7)
            CALL DPWRST('XXX','WRIT')
 4981     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,4291)
 4291     FORMAT('THE FOLLOWING INTERNAL PARAMETERS ARE SAVED:')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4293)
 4293     FORMAT('      GAMMAML, GAMMASE, SCALEML, SCALESE, ',
     1           'GAMMAMOM, SCALEMOM,COVSE')
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IF(IFEEDB.EQ.'ON')THEN
          IF(NPERC.GT.0)THEN
            WRITE(ICOUT,4943)
 4943       FORMAT('PERCENTILE CONFIDENCE LIMITS  WRITTEN TO ',
     1             'FILE  dpst1f.dat')
            CALL DPWRST('XXX','BUG ')
          ENDIF
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG1')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLG1--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLG2(Y,TAG,N,
     1XTEMP,DTEMP,MAXNXT,
     1SCALMO,GAMMMO,SCALML,SCALSE,GAMMML,GAMMSE,COVSE,
     1NUMV,ICENTY,TEND,
     1ICAPSW,ICAPTY,
     1QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
     1IOUNI1,IOUNI2,ALPHAP,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR GAMMA DISTRIBUTION
C              FOR THE TIME CENSORED CASE.
C     EXAMPLE--GAMMA MAXIMUM LIKELIHOOD Y
C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
C                1999, CHAPTER 13.
C              --JOHNSON, KOTZ, AND BALAKRISNAN, "CONTINUOUS
C                UNIVARIATE DISTRIBUTIONS--VOLUME 1", SECOND EDITION,
C                WILEY, 1994, CHAPTER xx.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/11
C     ORIGINAL VERSION--NOVEMBER  2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICENTY
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASE
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      PARAMETER (NUMALP=6)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWSC(NUMALP)
      DIMENSION AUPPSC(NUMALP)
      DIMENSION ALOWGA(NUMALP)
      DIMENSION AUPPGA(NUMALP)
      DIMENSION ALOWS2(NUMALP)
      DIMENSION AUPPS2(NUMALP)
      DIMENSION ALOWG2(NUMALP)
      DIMENSION AUPPG2(NUMALP)
C
      DIMENSION Y(*)
      DIMENSION TAG(*)
      DIMENSION XTEMP(*)
      DIMENSION QP(*)
      DIMENSION XQPHAT(*)
      DIMENSION XQPSE(*)
      DIMENSION XQPLCL(*)
      DIMENSION XQPUCL(*)
      DOUBLE PRECISION DTEMP(*)
C
      EXTERNAL SUM
      EXTERNAL GC1FUN
      DOUBLE PRECISION J1FUN
      DOUBLE PRECISION J2FUN
      DOUBLE PRECISION DGAMMA
      DOUBLE PRECISION DGAMI
      DOUBLE PRECISION DPSI
      EXTERNAL J1FUN
      EXTERNAL J2FUN
      EXTERNAL DGAMMA
      EXTERNAL DGAMI
      EXTERNAL DPSI
C
      DOUBLE PRECISION XBAR
      DOUBLE PRECISION DGEOME
      INTEGER IN
      INTEGER IR
      COMMON/GC1COM/XBAR,DGEOME,IN,IR
C
      COMMON/GAMCO8/P8,SCALE8
      COMMON/GAMCO9/P9,GHAT9
C
      EXTERNAL GAMFU8
      EXTERNAL GAMFU9
C
      INTEGER LIMIT
      INTEGER LENW
      PARAMETER(LIMIT=200)
      PARAMETER(LENW=4*LIMIT)
      INTEGER INF
      INTEGER NEVAL
      INTEGER IER
      INTEGER LAST
      INTEGER IWORK(LIMIT)
      DOUBLE PRECISION EPSABS
      DOUBLE PRECISION EPSREL
      DOUBLE PRECISION DLOW
      DOUBLE PRECISION ABSERR
      DOUBLE PRECISION WORK(LENW)
C
      DOUBLE PRECISION DA
      COMMON/J1COM/DA
C
      DOUBLE PRECISION TOL
      DOUBLE PRECISION XPAR(2)
      DOUBLE PRECISION FVEC(2)
C
      DIMENSION FISH(2,2)
      DIMENSION COV(2,2)
      DIMENSION D(2)
C
      DOUBLE PRECISION DN
      DOUBLE PRECISION DR
      DOUBLE PRECISION DX
      DOUBLE PRECISION AE
      DOUBLE PRECISION RE
      DOUBLE PRECISION DG
      DOUBLE PRECISION DGAM
      DOUBLE PRECISION DS
      DOUBLE PRECISION DP
      DOUBLE PRECISION DT1
      DOUBLE PRECISION DTJ
      DOUBLE PRECISION DJ1
      DOUBLE PRECISION DJ2
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION DSUM3
      DOUBLE PRECISION DSUM4
      DOUBLE PRECISION DSUM5
      DOUBLE PRECISION DXSTRT
      DOUBLE PRECISION DXLOW
      DOUBLE PRECISION DXUP
      DOUBLE PRECISION XLOWSV
      DOUBLE PRECISION XUPSV
      DOUBLE PRECISION DANS(10)
      DOUBLE PRECISION TRIGAM
      DOUBLE PRECISION DTERM1
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
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='G2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLG2--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,NUMV
   55   FORMAT('N,NUMV,NPERC = ',3I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I),TAG(I)
   57     FORMAT('I,Y(I),TAG(I) = ',I8,2E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
        WRITE(ICOUT,59)ICENTY
   59   FORMAT('ICENTY = ',A4)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN GAMMA MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)
 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 1 ',
     1         'IS <= 1')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)N
 1113   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      DO1125I=1,N
        IF(Y(I).LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1121)
 1121     FORMAT('***** ERROR FROM GAMMA MAXIMUM LIKELIHOOD--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1122)
 1122     FORMAT('      A NEGATIVE VALUE WAS ENCOUNTERED.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1123)I,Y(I)
 1123     FORMAT('      ROW ',I8,' HAS THE VALUE = ',E15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
 1125 CONTINUE
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** WARNING FROM GAMMA MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1132)HOLD
 1132 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
      IF(NPERC.GT.0)THEN
        DO1145I=1,NPERC
          IF(QP(I).LE.0.0 .OR. QP(I).GE.100.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1141)
 1141       FORMAT('***** WARNING IN GAMMA MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1143)QP(I)
 1143       FORMAT('      REQUESTED PERCENTILE (',G15.7,') IS ',
     1             'OUTSIDE THE (0,100) INTERVAL')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1144)
 1144       FORMAT('      NO PERCENTILE CONFIDENCE LIMITS WILL BE ',
     1             'COMPUTED.')
            CALL DPWRST('XXX','WRIT')
            NPERC=0
          ENDIF
 1145   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 21--                             **
C               **  CHECK THE CENSORING VARIABLE: SHOULD  **
C               **  BE AT MOST 2 DISTINCT VALUES, 1       **
C               **  INDICATES FAILURE TIME, 0 INDICATES   **
C               **  CENSORING TIME.                       **
C               ********************************************
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC NOVEMBER 2004.  FOR CENSORED CASE, CHECK THAT SECOND VARIABLE
CCCCC                 CONTAINS TWO DISTINCT VALUES, SET TO 1 AND 0.
C
      CALL DISTIN(TAG,N,IWRITE,XTEMP,NDIST,IBUGA3,IERROR)
      IF(NDIST.EQ.1)THEN
        DO2102I=1,N
          TAG(I)=1.0
 2102   CONTINUE
      ELSEIF(NDIST.EQ.2)THEN
        IF(XTEMP(1).EQ.1.0 .OR. XTEMP(2).EQ.1.0)THEN
          DO2103I=1,N
            IF(TAG(I).NE.1.0)TAG(I)=0.0
 2103     CONTINUE
        ELSE
          ATEMP1=MIN(XTEMP(1),XTEMP(2))
          ATEMP2=MAX(XTEMP(1),XTEMP(2))
          DO2108I=1,N
            IF(TAG(I).EQ.ATEMP1)TAG(I)=1.0
            IF(TAG(I).EQ.ATEMP2)TAG(I)=0.0
 2108     CONTINUE
        ENDIF
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2104)
 2104   FORMAT('***** ERROR IN GAMMA MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2105)
 2105   FORMAT('      FOR CENSORED DATA, THE CENSORING VARIABLE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2106)
 2106   FORMAT('      SHOULD CONTAIN AT MOST TWO DISTINCT VALUES.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2107)NDIST
 2107   FORMAT('      ',I8,' DISTINCT VALUES FOUND.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      CALL SORTC(Y,TAG,N,Y,TAG)
      IR=0
      DO2120I=1,N
        IF(TAG(I).EQ.1.0)IR=IR+1
 2120 CONTINUE
C
      ICNT=0
      DO2122I=1,N
        IF(TAG(I).EQ.1.0)THEN
          ICNT=ICNT+1
          XTEMP(ICNT)=Y(I)
        ENDIF
 2122 CONTINUE
      DO2124I=1,N
        IF(TAG(I).EQ.0.0)THEN
          ICNT=ICNT+1
          XTEMP(ICNT)=Y(I)
        ENDIF
 2124 CONTINUE
      DO2126I=1,N
        Y(I)=XTEMP(I)
        IF(I.LE.IR)THEN
          TAG(I)=1.0
        ELSE
          TAG(I)=0.0
        ENDIF
 2126 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLG2')THEN
        WRITE(ICOUT,2127)N,IR,IM
 2127   FORMAT(1X,'N,IR,IM = ',3I8)
        CALL DPWRST('XXX','BUG ')
        DO2128I=1,N
          WRITE(ICOUT,2129)I,Y(I),TAG(I)
 2129     FORMAT(1X,'I,Y(I),TAG(I)=',I8,2E15.7)
          CALL DPWRST('XXX','BUG ')
 2128   CONTINUE
      ENDIF
C
      IM=N-IR
      IR1=IR
      IR2=IR
      IR3=IR
C
      AR=REAL(IR)
      DR=DBLE(IR)
      AN=REAL(N)
      AM=REAL(IM)
C
      IF(IM.EQ.0)THEN
        ICASE='NONE'
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2131)
 2131   FORMAT('***** WARNING FROM GAMMA MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2133)
 2133   FORMAT('      NO CENSORING TIMES DETECTED.  IT IS RECOMMENDED')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2135)
 2135   FORMAT('      THAT THE FULL SAMPLE SYNTAX BE USED:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2137)
 2137   FORMAT('      GAMMA MAXIMUM LIKELIHOOD  Y')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSE
        ICASE='SING'
        AHOLD=Y(IR+1)
        DO2140I=IR+1,N
          IF(Y(I).NE.AHOLD)THEN
            ICASE='MULT'
            GOTO2149
          ENDIF
 2140   CONTINUE
 2149   CONTINUE
      ENDIF
C
C               ************************************
C               **  STEP 41--                     **
C               **  CARRY OUT CALCULATIONS        **
C               **  FOR GAMMA MLE                 **
C               **  ESTIMATE (TIME CENSORED CASE) **
C               ************************************
C
 4100 CONTINUE
C
C  THE MAXIMUM LIKELIHOOD EQUATIONS FOR THE CENSORED CASE ARE:
C
C      R*XBAR/SHAT - R*GHAT + SUM[i=1 to M]
C        [Z(j)**GHAT*EXP(Z(j)/(GAMMA(GHAT) - G(Z(j),GHAT))] = 0
C
C      R*LOG(GEOMEAN/SHAT)  - N*DIGAMMA(GHAT) + SUM[i=1 to M]
C        [(GAMMA(GHAT)*DIGAMMA(GHAT) J(Z(j),GHAT))/
C        (GAMMA(GHAT) - G(Z(j),GHAT))] = 0
C
C      WHERE
C
C
C         XBAR = MEAN OF FAILURE DATA
C         GEOMEAN  = GEOMETRIC MEAN OF FAILURE DATA
C         R        = NUMBER OF FAILURES
C         M        = NUMBER OF CENSORING TIMES
C         SHAT     = FVEC(1) = CURRENT ESTIMATE OF SCALE PARAMETER
C         GHAT     = FVEC(2) = CURRENT ESTIMATE OF SHAPE PARAMETER
C         Z(j)     = jth CENSORING TIME
C         GAMMA    = GAMMA FUNCTION
C         DIGAMMA  = DIGAMMA FUNCTION
C         G(x,a)   = INCOMPLETE GAMMA FUNCTION
C         J(X,a)   = INTEGRAL[0 to x][t**(A-1)*LOG(t)*EXP(-t)]dt
C
C  THESE ARE SOLVED USING THE DNSQE ROUTINE.
C
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      AN=REAL(N)
C
C  COMPUTE STATISTICS FOR FAILURE ONLY DATA
C
      CALL MEAN(Y,IR,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,IR,IWRITE,XSD,IBUGA3,IERROR)
      CALL MINIM(Y,IR,IWRITE,XMIN,IBUGA3,IERROR)
      CALL GEOMEA(Y,IR,IWRITE,XGEOM,IBUGA3,IERROR)
      XCOEFV=XSD/XMEAN
C
C  USE MOMENT ESTIMATES OF FAILURE DATA AS STARTING VALUES FOR
C  EQUATION SOLVER.
C
      GAMMMO=(XMEAN/XSD)**2
      SCALMO=XSD**2/XMEAN
C
      XBAR=DBLE(XMEAN)
      DGEOME=DBLE(XGEOM)
      XPAR(1)=DBLE(GAMMMO)
      XPAR(2)=DBLE(SCALMO)
C
      IN=N
      JAC=0
      IOPT=2
      TOL=1.0D-6
      NVAR=2
      NPRINT=-1
      INFO=0
      LWA=MAXNXT
      FVEC(1)=0.0D0
      FVEC(2)=0.0D0
      CALL DNSQE(GC1FUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1           DTEMP,MAXNXT,Y(IR+1),IM)
C
      GAMMML=REAL(XPAR(1))
      SCALML=REAL(XPAR(2))
C
C  COMPUTE STANDARD ERRORS.
C
C  NOTE THAT DPSIFN COMPUTES THE SCALED PSI DERIVATIVE FUNCTION:
C
C     (-1)**(K+1)/GAMMA(K+1)
C
C  FOR TRIGAMMA, K=1 AND THE SCALING FACTOR REDUCES TO 1.
C
      ISE=1
      DN=DBLE(N)
      DG=DBLE(GAMMML)
      DS=DBLE(SCALML)
      DSUM1=0.0D0
      DSUM2=0.0D0
      DSUM3=0.0D0
      DSUM4=0.0D0
      DSUM5=0.0D0
      IF(IM.GT.0)THEN
        KODE=1
        NTEMP=1
        MTEMP=1
        NZ=0
C
        EPSABS=1.0D-7
        EPSREL=1.0D-7
        IER=0
        IKEY=3
        DLOW=0.0D0
        DA=DBLE(GAMMML)
        DGAM=DGAMMA(DG)
        DP=DPSI(DG)
        CALL DPSIFN(DG,NTEMP,KODE,MTEMP,DANS,NZ,IERR)
        TRIGAM=DANS(1)
        IF(IERR.EQ.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3101)
 3101     FORMAT('***** ERROR FROM GAMMA (CENSORED CASE) MAXIMUM ',
     1           'LIKELIHOOD--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3103)
 3103     FORMAT('      UNABLE TO COMPUTE TRIGAMMA FUNCTION.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3109)
 3109     FORMAT('      PARAMETER STANDARD ERRORS AND CONFIDENCE ',
     1           'WILL NOT BE COMPUTED.')
          CALL DPWRST('XXX','WRIT')
          ISE=0
          GOTO2319
        ELSEIF(IERR.EQ.2)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3101)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3105)
 3105     FORMAT('      OVERFLOW IN COMPUTING THE TRIGAMMA ',
     1           'FUNCTION.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3109)
          CALL DPWRST('XXX','WRIT')
          ISE=0
          GOTO2319
        ELSEIF(IERR.EQ.3)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3101)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3107)
 3107     FORMAT('      OVERFLOW IN COMPUTING THE TRIGAMMA ',
     1           'FUNCTION.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3109)
          CALL DPWRST('XXX','WRIT')
          ISE=0
          GOTO2319
        ENDIF
C
C
        DO2310I=IR+1,N
C
          DX=DBLE(Y(I)/SCALML)
          DTERM1=DGAM - DGAMI(DG,DX)
          DTJ=DX**DG*DEXP(-DX)/DTERM1
C
          DJ1=0.0D0
          CALL DQAG(J1FUN,DLOW,DX,EPSABS,EPSREL,IKEY,DJ1,
     1              ABSERR,NEVAL,
     1              IER,LIMIT,LENW,LAST,IWORK,WORK)
          DJ2=0.0D0
          CALL DQAG(J2FUN,DLOW,DX,EPSABS,EPSREL,IKEY,DJ2,
     1              ABSERR,NEVAL,
     1              IER,LIMIT,LENW,LAST,IWORK,WORK)
C
          DSUM1=DSUM1 + DTJ*(DX-DTJ)
          DSUM2=DSUM2 + DTJ*DLOG(DX)
          DSUM3=DSUM3 + DTJ*(DGAM*DP - DJ1)/DTERM1
          DSUM4=DSUM4 + (DGAM*(DP**2 + TRIGAM) - DJ2)/DTERM1
          DSUM5=DSUM5 + ((DGAM*DP - DJ1)/DTERM1)**2
C
 2310   CONTINUE
      ENDIF
 2319 CONTINUE
      IF(ISE.EQ.0)GOTO4129
C
      DTERM1=(-DR/DS**2)*((XBAR/DS)*(DG-1.0D0) - DG**2) - DSUM1/(DS**2)
      FISH(1,1)=REAL(DTERM1)
      DTERM1=DN*TRIGAM - DSUM4 + DSUM5
      FISH(2,2)=REAL(DTERM1)
      DTERM1=(1.0D0/DS)*(DR - DSUM2 + DSUM3)
      FISH(2,1)=REAL(DTERM1)
      FISH(1,2)=FISH(2,1)
C
      NDIM=2
      CALL SGECO(FISH,NDIM,NDIM,ITEMP,RCOND,XTEMP)
      IJOB=1
      CALL SGEDI(FISH,NDIM,NDIM,ITEMP,XTEMP,XTEMP(MAXNXT/2),IJOB)
      DO2410J=1,NDIM
        DO2415I=1,NDIM
          COV(I,J)=FISH(I,J)
 2415   CONTINUE
 2410 CONTINUE
C
      SCALSE=0.0
      GAMMSE=0.0
      IF(COV(1,1).GE.0.0)SCALSE=SQRT(COV(1,1))
      IF(COV(2,2).GE.0.0)GAMMSE=SQRT(COV(2,2))
      COVSE=COV(2,1)
C
C  CONFIDENCE INTERVALS FOR PARAMETERS.  CAN BASE ON EITHER NORMAL
C  APPROXIMATION OR ON LIKELIHOOD RATIO APPROXIMATION.
C
C  NORMAL APPROXIMATION FIRST.
C
      DO4110I=1,NUMALP
        ALP=ALPHA(I)
        P=1.0-(ALP/2.0)
        CALL NORPPF(P,PPF)
        ALOWSC(I)=SCALML - PPF*SCALSE
        AUPPSC(I)=SCALML + PPF*SCALSE
        ALOWGA(I)=GAMMML - PPF*GAMMSE
        AUPPGA(I)=GAMMML + PPF*GAMMSE
 4110 CONTINUE
C
C  NOW DO LIKELIHOOD RATIO APPROXIMATION.
C
      GOTO4129
C
CCCCC IN2=N
CCCCC IN3=N
CCCCC DN=DBLE(N)
CCCCC AE=1.D-7
CCCCC RE=1.D-7
CCCCC NUTEMP=1
C
CCCCC DGAM=DBLE(GAMMML)
CCCCC DSCALE=DBLE(SCALML)
CCCCC DXBAR=DBLE(XMEAN)
CCCCC DGMEAN=DBLE(XGEOM)
C
CCCCC DO4120I=1,NUMALP
CCCCC   ALP=ALPHA(I)
CCCCC   CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
CCCCC   DK=DBLE(APPF)
CCCCC   DK2=DK
C
CCCCC   DXSTRT=DBLE(ALOWGA(I))
CCCCC   DXLOW=DXSTRT/5.0D0
CCCCC   DXUP=DBLE(GAMMML)
CCCCC   CALL DFZERO(GAMFU2,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG)
CCCCC   ALOWG2(I)=REAL(DXLOW)
C
CCCCC   DXSTRT=DBLE(AUPPGA(I))
CCCCC   DXUP=DXSTRT*5.0D0
CCCCC   DXLOW=DBLE(GAMMML)
CCCCC   CALL DFZERO(GAMFU2,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG)
CCCCC   AUPPG2(I)=REAL(DXLOW)
C
CCCCC   DXSTRT=DBLE(ALOWSC(I))
CCCCC   DXLOW=DXSTRT/5.0D0
CCCCC   DXUP=DBLE(SCALML)
CCCCC   CALL DFZER2(GAMFU3,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG,DTEMP)
CCCCC   ALOWS2(I)=REAL(DXLOW)
C
CCCCC   DXSTRT=DBLE(AUPPSC(I))
CCCCC   DXUP=DXSTRT*5.0D0
CCCCC   DXLOW=DBLE(SCALML)
CCCCC   CALL DFZER2(GAMFU3,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG,DTEMP)
CCCCC   AUPPS2(I)=REAL(DXLOW)
C4120 CONTINUE
 4129 CONTINUE
C
C  CONFIDENCE INTERVALS FOR SELECTED PERCENTILES.
C
C  1. STANDARD ERROR USES TECHNIQUE DEMONSTRATED IN EXAMPLE 13.1
C     (P. 227) OF BURY.  THIS IS BASED ON PROPOGATION OF ERROR.
C 
C  2. CONFIDENCE INTERVAL IS THEN GENERATED USING NORMAL
C     APPROXIMATION (EXAMPLE 13.1 OF BURY).
C
      IF(NPERC.GE.1)THEN
C
        ALPHL=ALPHAP/2.0
        ALPHU=1.0 - ALPHAP/2.0
        CALL NORPPF(ALPHU,Z95)
C
        GHAT9=GAMMML
        SCALE8=SCALML
        IORD=1
        EPS=0.001
        ACCUR=0.0
C
        WRITE(IOUNI1,3531)
        WRITE(IOUNI1,3532)
        DO3529I=1,NPERC
          QPTEMP=QP(I)/100.0
          CALL GAMPPF(QPTEMP,GAMMML,APPF)
          XQPHAT(I)=SCALML*APPF
C
          P8=QPTEMP
          P9=QPTEMP
C
          IFAIL=0
C
          GHAT   = GAMMML
          GHATMN = GHAT/10.0
          GHATMX = GHAT*10.0
          CALL DIFF(IORD,GHAT,GHATMN,GHATMX,GAMFU8,EPS,ACCUR,
     1              GHATP,ERROR,IFAIL)
C
          IF(IFAIL.EQ.1)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,301)
  301       FORMAT('***** WARNING IN NUMERICAL DERIVATIVE FOR GAMMA ',
     1             'MAXIMUM LIKELIHOOD PERCENTILES.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,303)
  303       FORMAT('      THE ESTIMATED ERROR IN THE RESULT ',
     1             'EXCEEDS THE')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,305)
  305       FORMAT('      REQUESTED ERROR, BUT THE MOST ACCURATE ',
     1             'RESULT')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,307)
  307       FORMAT('      POSSIBLE HAS BEEN RETURNED.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFAIL.EQ.2)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,311)
  311       FORMAT('***** ERROR IN NUMERICAL DERIVATIVE FOR GAMMA ',
     1             'MAXIMUM LIKELIHOOD PERCENTILES.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,313)
  313       FORMAT('      ERROR IN THE INPUT TO THE DIFF ROUTINE.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,315)
  315       FORMAT('      NO PERCENTILES WILL BE GENERATED.')
            CALL DPWRST('XXX','BUG ')
            NPERC=0
          ELSEIF(IFAIL.EQ.3)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,311)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,323)
  323       FORMAT('      THE INTERVAL FOR DIFFERENTIATION, (',G15.7,
     1             ',',G15.7,')')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,325)
  325       FORMAT('      IS TOO SMALL.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,315)
            CALL DPWRST('XXX','BUG ')
            GHATP=0.0
            NPERC=0
          ENDIF
C
          SCALHT = SCALML
          SCALMN = SCALHT/10.0
          SCALMX = SCALHT*10.0
          CALL DIFF(IORD,SCALHT,SCALMN,SCALMX,GAMFU9,EPS,ACCUR,
     1              SCALEP,ERROR,IFAIL)
C
          IF(IFAIL.EQ.1)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,301)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,303)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,305)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,307)
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFAIL.EQ.2)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,311)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,313)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,315)
            CALL DPWRST('XXX','BUG ')
            NPERC=0
          ELSEIF(IFAIL.EQ.3)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,311)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,323)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,325)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,315)
            CALL DPWRST('XXX','BUG ')
            GHATP=0.0
            NPERC=0
          ENDIF
          D1=SCALEP
          D2=GHATP
          V11=SCALSE**2
          V22=GAMMSE**2
          V21=COVSE
          V12=V21
          TERM11=D1*D1*V11
          TERM12=D1*D2*V12
          TERM21=D2*D1*V21
          TERM22=D2*D2*V22
          SEXQP=TERM11+TERM12+TERM21+TERM22
          IF(SEXQP.GE.0.0)THEN
            SEXQP=SQRT(SEXQP)
          ELSE
            SEXQP=0.0
          ENDIF
          XQPSE(I)=SEXQP
          XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
          XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
          WRITE(IOUNI1,'(5E15.7)')
     1         QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
 3529   CONTINUE
 3531   FORMAT(15X,'       POINT     ','   STANDARD    ',
     1         '     LOWER     ',
     1         '     UPPER')
 3532   FORMAT('    PERCENTILE ','     ESTIMATE   ',
     1         '     ERROR     ',
     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
      ENDIF
C               *************************************
C               **   STEP 42--                     **
C               **   WRITE OUT EVERYTHING          **
C               **   FOR GAMMA MLE ESTIMATE        **
C               *************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG2')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5002   FORMAT('<B>GAMMA MAXIMUM LIKELIHOOD ESTIMATION:')
 5004   FORMAT('<BR>TIME CENSORED CASE</B>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Two-Parameter Model (Location = 0)</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=325>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5060   FORMAT('         Number of Observations:')
 5061   FORMAT('         Number of Failure Times:')
 5062   FORMAT('         Minimum Value of Failure Times:')
 5063   FORMAT('         Mean of Failure Times:')
 5064   FORMAT('         Standard Deviation of Failure Times:')
 5065   FORMAT('         Geometric Mean of Failure Times:')
 5067   FORMAT('         ML Estimate of Scale Parameter:')
 5068   FORMAT('         Standard Error of Scale Parameter:')
 5069   FORMAT('         ML Estimate of Shape Parameter:')
 5070   FORMAT('         Standard Error of Shape Parameter:')
 5071   FORMAT('         Covariance of Scale and ',
     1         'Shape Parameter:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)IR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XGEOM
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5070)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)COVSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Limits for the Shape ',
     1         'Parameter</B><BR>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5134   FORMAT('         &nbsp;')
 5136   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM COLSPAN=2>')
 5137   FORMAT('         Normal Approximation')
C5138   FORMAT('         Likelihood Ratio')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=3>')
 5162   FORMAT('          <HR>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        DO5140I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWGA(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPGA(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5140   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5217   FORMAT('      <B>Confidence Limits for the Scale ',
     1         'Parameter</B>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5217)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
        DO5240I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWSC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPSC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5240   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
 5811   FORMAT('<UL>')
 5813   FORMAT('<TABLE NOBORDER>')
 5815   FORMAT('   <CAPTION ALIGN=CENTER>')
 5816   FORMAT('      <BR><B>Alpha = ',F7.3,'</B>')
 5817   FORMAT('      <B>Confidence Limits (Normal Approximation) ',
     1         'for Selected Percentiles')
 5819   FORMAT('   </CAPTION>')
 5841   FORMAT('   <TR>')
 5843   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5847   FORMAT('      </TD>')
 5848   FORMAT('      </TH>')
 5849   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5851   FORMAT('         ',G15.7)
 5859   FORMAT('   </TR>')
 5861   FORMAT('         Percentile')
 5862   FORMAT('         Point <br> Estimate')
55862   FORMAT('         Standard <br> Error')
 5863   FORMAT('         Lower <br>Confidence Limit')
 5864   FORMAT('         Upper <br>Confidence Limit')
 5870   FORMAT('      <TD COLSPAN=5>')
 5872   FORMAT('         <HR WIDTH=600>')
C
C  START THE TABLE FOR PERCENTILE CONFIDENCE INTERVALS
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,999)
          WRITE(ICOUT,5811)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5813)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5815)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5817)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5816)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5819)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5861)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,55862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5863)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5864)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5870)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5872)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5847)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          DO55880I=1,NPERC
            WRITE(ICOUT,5841)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)QP(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPHAT(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPSE(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPLCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPUCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5859)
            CALL DPWRST('XXX','WRIT')
55880     CONTINUE
C
C  END THE TABLE AND RESET ASIS MODE
C
          WRITE(ICOUT,5091)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5093)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
 5801   FORMAT('<PRE>')
        WRITE(ICOUT,5801)
        CALL DPWRST('XXX','WRIT')
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001   FORMAT(A1,'end{verbatim}')
 8003   FORMAT(A1,'begin{table}')
 8004   FORMAT(A1,'end{table}')
 8005   FORMAT('{',A1,'bf Gamma Maximum Likelihood ',
     1         'Estimation: Time Censored Case}')
 8007   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009   FORMAT(A1,'begin{center}')
 8011   FORMAT(5X,'{',A1,'bf Two-Parameter Model ($',A1,
     1         'mu$ = 0 Case)}')
 8013   FORMAT(A1,'end{center}')
 8015   FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020   FORMAT(5X,A1,'begin{tabular} {lr}')
 8021   FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8025   FORMAT(5X,'Number of Failure Times: & ',I8,2X,A1,A1)
 8022   FORMAT(5X,'Minimum of Failure Times: & ',G15.7,2X,A1,A1)
 8023   FORMAT(5X,'Mean of Failure Times: & ',G15.7,2X,A1,A1)
 8024   FORMAT(5X,'Standard Deviation of Failure Times: & ',
     1         G15.7,2X,A1,A1)
 8033   FORMAT(5X,'Geometric Mean of Failure Times: & ',
     1         G15.7,2X,A1,A1)
 8027   FORMAT(5X,'ML Estimate of Scale Parameter: & ',G15.7,2X,A1,A1)
 8028   FORMAT(5X,'ML Standard Error of Scale Parameter: & ',
     1         G15.7,2X,A1,A1)
 8029   FORMAT(5X,'Estimate of Shape Parameter: & ',G15.7,2X,A1,A1)
 8030   FORMAT(5X,'Standard Error of Shape Parameter: & ',
     1         G15.7,2X,A1,A1)
 8031   FORMAT(5X,'Standard Error of Covariance of Scale and Shape ',
     1         'Parameter: & ',G15.7,2X,A1,A1)
 8035   FORMAT(5X,' & ',2X,A1,A1)
 8049   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)IR,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8033)XGEOM,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8035)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)SCALML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)SCALSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)GAMMML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)GAMMSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)COVSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8093   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for Shape Parameter}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8111)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper ',
     1         2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit',
     1         2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,2X,A1,A1)
 8126   FORMAT(5X,'& ',A1,'multicolumn{2}{c}{Normal Approximation}',
     1         2X,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8126)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8130I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWGA(I),AUPPGA(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8130   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8191   FORMAT(A1,'end{table}')
 8193   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8211 FORMAT(5X,'{',A1,'bf Confidence Limits for Scale Parameter}')
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8211)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8126)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8230I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWSC(I),AUPPSC(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8230   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8191)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C WRITE SELECTED PERCENTILES (IF ANY)
C
        IF(NPERC.GT.0)THEN
C
          CALL DPCONA(92,IBASLC)
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8803)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8810)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8812)IBASLC,IBASLC,ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8813)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8820)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8821)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8822)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,
     1                     IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8840)IBASLC
          CALL DPWRST('XXX','WRIT')
          DO8830I=1,NPERC
            WRITE(ICOUT,8823)QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),
     1                       XQPUCL(I),IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
 8830     CONTINUE
          WRITE(ICOUT,8849)IBASLC
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8891)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8893)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
 8801   FORMAT(A1,'end{verbatim}')
 8803   FORMAT(A1,'begin{table}')
 8807   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8809   FORMAT(A1,'begin{center}')
 8810   FORMAT(5X,'{',A1,'bf Confidence Limits (Normal Approximation)',
     1         'for Selected Percentiles}')
 8812   FORMAT(5X,'{',A1,'bf $',A1,'alpha$ = ',F7.3,'}')
 8813   FORMAT(A1,'end{center}')
 8815   FORMAT(5X,'} ',A1,A1)
 8820   FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8821   FORMAT(5X,' & {',A1,'bf Point} & {',A1,'bf Standard} & {',
     1         A1,'bf Lower} & {',A1,'bf Upper}',2X,A1,A1)
 8822   FORMAT(5X,'{',A1,'bf Percentile} & {',A1,'bf Estimate} & {',
     1         A1,'bf Error} & {',A1,'bf Confidence Limit} & {',
     1         A1,'bf Confidence Limit}',
     1         2X,A1,A1)
 8823   FORMAT(5X,G15.7,' & ',G15.7,' & ',G15.7,' & ',G15.7,
     1         ' & ',G15.7,2X,A1,A1)
 8840   FORMAT(5X,A1,'hline')
 8849   FORMAT(A1,'end{tabular}')
 8891   FORMAT(A1,'end{center}')
 8893   FORMAT(A1,'end{table}')
C
 8899   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8899)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(6X,'GAMMA MAXIMUM LIKELIHOOD ESTIMATION: ',
     1         'TIME CENSORED CASE')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4213)
 4213   FORMAT('TWO-PARAMETER MODEL (LOCATION = 0)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4215)N
 4215   FORMAT('NUMBER OF OBSERVATIONS                            = ',
     1         I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4216)IR
 4216   FORMAT('NUMBER OF FAILURE TIMES                           = ',
     1         I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4217)XMIN
 4217   FORMAT('MINIMUM OF FAILURE TIMES                          = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4218)XMEAN
 4218   FORMAT('MEAN OF FAILURE TIMES                             = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4219)XSD
 4219   FORMAT('STANDARD DEVIATION OF FAILURE TIMES               = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4220)XGEOM
 4220   FORMAT('GEOMETRIC MEAN OF FAILURE TIMES                   = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)SCALML
 4223   FORMAT('ML ESTIMATE OF SCALE PARAMETER                    = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)SCALSE
 4225   FORMAT('STANDARD ERROR OF SCALE PARAMETER                 = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4227)GAMMML
 4227   FORMAT('ML ESTIMATE OF SHAPE PARAMETER                    = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4229)GAMMSE
 4229   FORMAT('STANDARD ERROR OF SHAPE PARAMETER                 = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4231)COVSE
 4231   FORMAT('COVARIANCE OF THE SHAPE AND SCALE PARAMETERS      = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4240)
 4240   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)
 4242   FORMAT('                       NORMAL APPROXIMATION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)
 4243   FORMAT('   CONFIDENCE           LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)
 4245   FORMAT('   VALUE (%)            LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4246)
 4246   FORMAT('-------------------------------------------')
        CALL DPWRST('XXX','WRIT')
        DO4249I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4247)ATEMP,ALOWSC(I),AUPPSC(I)
 4247     FORMAT('   ',F8.3,10X,2(G12.6,2X))
          CALL DPWRST('XXX','WRIT')
 4249   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4252)
 4252   FORMAT('CONFIDENCE INTERVAL FOR SHAPE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4246)
        CALL DPWRST('XXX','WRIT')
        DO4259I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4247)ATEMP,ALOWGA(I),AUPPGA(I)
          CALL DPWRST('XXX','WRIT')
 4259   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,4911)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4915)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4921)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4922)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4946)
          CALL DPWRST('XXX','WRIT')
C
 4911   FORMAT('CONFIDENCE LIMITS (NORMAL APPROXIMATION) FOR ',
     1         'SELECTED PERCENTILES:')
 4915   FORMAT('ALPHA = ',F7.4)
 4921   FORMAT(10X,'      POINT     ','  STANDARD   ',
     1             '        LOWER     ', '       UPPER')
 4922   FORMAT('PERCENTILE','   ESTIMATE   ','      ERROR     ',
     1         'CONFIDENCE LIMIT ',' CONFIDENCE LIMIT')
 4946   FORMAT('-----------------------------------',
     1         '-----------------------------------')
C
          DO4981I=1,NPERC
            WRITE(ICOUT,4932)QP(I),XQPHAT(I),XQPSE(I),
     1                       XQPLCL(I),XQPUCL(I)
 4932       FORMAT(2X,F8.4,2G15.7,2X,G15.7,2X,G15.7)
            CALL DPWRST('XXX','WRIT')
 4981     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,4291)
 4291     FORMAT('THE FOLLOWING INTERNAL PARAMETERS ARE SAVED:')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4293)
 4293     FORMAT('      GAMMAML, GAMMASE, SCALEML, SCALESE, ',
     1           'GAMMAMOM, SCALEMOM,COVSE')
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IF(IFEEDB.EQ.'ON')THEN
          IF(NPERC.GT.0)THEN
            WRITE(ICOUT,4943)
 4943       FORMAT('PERCENTILE CONFIDENCE LIMITS  WRITTEN TO ',
     1             'FILE  dpst1f.dat')
            CALL DPWRST('XXX','BUG ')
          ENDIF
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLG2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLG2--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLGL(Y,N,
     1XTEMP,TEMP2,TEMP3,TEMP4,TEMP5,YTEMP,MAXNXT,
     1ASHALM,ASCALM,ALOCLM,
     1ICAPSW,ICAPTY,DTEMP1,XMOM,
     1ALPHAP,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE L-MOMENT ESTIMATES
C              FOR THE GENERALIZED LOGISTIC DISTRIBUTION
C     EXAMPLE--GENERALIZED LOGISTIC MAXIMUM LIKELIHOOD Y
C     REFERENCE--FORTRAN CODE WRITTEN FOR INCLUSION IN IBM
C                RESEARCH REPORT RC20525, 'FORTRAN ROUTINES FOR
C                USE WITH THE METHOD OF L-MOMENTS, VERSION 3',
C                J. R. M. HOSKING, IBM RESEARCH DIVISION,
C                T. J. WATSON RESEARCH CENTER, YORKTOWN HEIGHTS
C                NEW YORK 10598, U.S.A., VERSION 3     AUGUST 1996
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBUG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2006/2
C     ORIGINAL VERSION--FEBRUARY  2006.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IGEPDF
      CHARACTER*4 IGEPSV
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ICASPL
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
      DIMENSION YTEMP(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP3(*)
      DIMENSION TEMP4(*)
      DIMENSION TEMP5(*)
      DOUBLE PRECISION DTEMP1(*)
      DOUBLE PRECISION XMOM(*)
C
      DOUBLE PRECISION XPAR(3)
C
CCCCC PARAMETER (NUMALP=6)
CCCCC DIMENSION ALPHA(NUMALP)
CCCCC DIMENSION ALOWSC(NUMALP)
CCCCC DIMENSION AUPPSC(NUMALP)
CCCCC DIMENSION ALOWGA(NUMALP)
CCCCC DIMENSION AUPPGA(NUMALP)
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
CCCCC DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='GL  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGL')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLGL--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.4)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN GENERALIZED LOGISTIC L-MOMENTS ',
     1         'ESTIMATION--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1        'FOR VARIABLE 1 IS LESS THAN 5')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1137)
 1137 FORMAT('***** ERROR IN GENERALIZED LOGISTIC L-MOMENTS ',
     1       'ESTIMATION--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
C               ***************************************************
C               **  STEP 21--                                    **
C               **  CARRY OUT CALCULATIONS                       **
C               **  FOR GENERALIZED LOGISTIC L-MOMENT ESTIMATION **
C               ***************************************************
C
 2000 CONTINUE
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL VAR(Y,N,IWRITE,XVAR,IBUGA3,IERROR)
      XSD=SQRT(XVAR)
      CALL SORT(Y,N,Y)
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGL')THEN
        WRITE(ICOUT,2010)XMIN,XMAX,XMEAN,XSD
 2010   FORMAT('XMIN,XMAX,XMEAN,XSD = ',4G15.7)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      NMOM=3
      DO2110I=1,N
        DTEMP1(I)=DBLE(Y(I))
 2110 CONTINUE
      CALL SAMLMU(DTEMP1,N,XMOM,NMOM)
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGL')THEN
        WRITE(ICOUT,2120)XMOM(1),XMOM(2),XMOM(3)
 2120   FORMAT('XMOM(1),XMOM(2),XMOM(3) = ',3G15.7)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      CALL PELGLO(XMOM,XPAR)
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGL')THEN
        WRITE(ICOUT,2130)XPAR(1),XPAR(2),XPAR(3)
 2130   FORMAT('XPAR(1),XPAR(2),XPAR(3) = ',3G15.7)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      ASHALM=REAL(XPAR(3))
      ASCALM=REAL(XPAR(2))
      ALOCLM=REAL(XPAR(1))
C
C               ***********************************************
C               **   STEP 42--                               **
C               **   WRITE OUT EVERYTHING                    **
C               **   FOR GENERALIZED LOGISTIC MLE ESTIMATION **
C               ***********************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5002   FORMAT('<UL>')
 5003   FORMAT('<H2>Generalized Logistic Type 5 (Hosking) ',
     1         'Parameter Estimation</H2>')
 5004   FORMAT('</UL>')
 5005   FORMAT('<BR><BR>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5003)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5005)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=350>')
 5044   FORMAT('         <B>Summary Statistics:</B>')
 5045   FORMAT('         Number of Observations:')
 5061   FORMAT('         Sample Mean (All Data):')
 5062   FORMAT('         Sample Variance (All Data):')
 5063   FORMAT('         Sample Minimum:')
 5064   FORMAT('         Sample Maximum:')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5044)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5045)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XVAR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5080   FORMAT('         <B>Method of L-Moments</B>')
 5083   FORMAT('         First Sample L-Moment')
 5084   FORMAT('         Second Sample L-Moment')
 5085   FORMAT('         Third Sample L-Moment')
 5086   FORMAT('         L-Moment Estimates Invalid')
C
 5166   FORMAT('         Estimate of Location:')
 5066   FORMAT('         Estimate of Gamma:')
 5067   FORMAT('         Estimate of Scale:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5080)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5083)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)REAL(XMOM(1))
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5084)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)REAL(XMOM(2))
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5085)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)REAL(XMOM(3))
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        IF(ASHALM.EQ.0.0 .AND. ASCALM.EQ.0.0 .AND.
     1     ALOCLM.EQ.0.0)THEN
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5086)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5055)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
        ELSE
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5166)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)ALOCLM
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5067)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)ASCALM
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5066)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)ASHALM
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
        ENDIF
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Generalized Logistic Type 5 (Hosking) ',
     1       'Parameter Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8121 FORMAT(5X,'{',A1,'bf Summary Statistics} & ',
     1       2X,A1,A1)
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8226 FORMAT(5X,'{',A1,'bf Method of L-Moments} & ',2X,A1,A1)
 8232 FORMAT(5X,'Unable To Compute The L-Moment Based Estimates: & ',
     1       2X,A1,A1)
 8222 FORMAT(5X,'First Sample L-Moment: & ',G15.7,2X,A1,A1)
 8223 FORMAT(5X,'Second Sample L-Moment: & ',G15.7,2X,A1,A1)
 8224 FORMAT(5X,'Third Sample L-Moment: & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,'Estimate of Gamma: & ',G15.7,2X,A1,A1)
 8028 FORMAT(5X,'Estimate of Scale: & ',G15.7,2X,A1,A1)
 8128 FORMAT(5X,'Estimate of Location: & ',G15.7,2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8041 FORMAT(5X,': & ',2X,A1,A1)
 8049 FORMAT(A1,'end{tabular}')
C
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8041)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8226)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8222)REAL(XMOM(1)),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8223)REAL(XMOM(2)),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8224)REAL(XMOM(3)),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(ASHALM.EQ.0.0 .AND. ASCALM.EQ.0.0 .AND.
     1     ALOCLM.EQ.0.0)THEN
          WRITE(ICOUT,8232)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8128)ALOCLM,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8028)ASCALM,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8027)ASHALM,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8041)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091   FORMAT(A1,'end{center}')
 8093   FORMAT(A1,'end{table}')
 8099   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(12X,'GENERALIZED LOGISTIC TYPE 5 (HOSKING) ',
     1         'PARAMETER ESTIMATION:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4220)
 4220   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)N
 4221   FORMAT('NUMBER OF OBSERVATIONS                     = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4222)XMEAN
 4222   FORMAT('SAMPLE MEAN                                = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)XSD
 4223   FORMAT('SAMPLE STANDARD DEVIATION                  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4224)XMIN
 4224   FORMAT('SAMPLE MINIMUM                             = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)XMAX
 4225   FORMAT('SAMPLE MAXIMUM                             = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4250)
 4250   FORMAT('L-MOMENTS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4256)XMOM(1)
 4256   FORMAT('FIRST SAMPLE L-MOMENT                      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4257)XMOM(2)
 4257   FORMAT('SECOND SAMPLE L-MOMENT                     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4258)XMOM(3)
 4258   FORMAT('THIRD SAMPLE L-MOMENT                      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(ASHALM.EQ.0.0 .AND. ASCALM.EQ.0.0 .AND.
     1     ALOCLM.EQ.0.0)THEN
          WRITE(ICOUT,4260)
 4260     FORMAT('UNABLE TO COMPUTE L-MOMENT BASED ESTIMATES')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4262)ALOCLM
 4262     FORMAT('ESTIMATE OF LOCATION                       = ',
     1           G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4264)ASCALM
 4264     FORMAT('ESTIMATE OF SCALE                          = ',
     1           G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4266)ASHALM
 4266     FORMAT('ESTIMATE OF SHAPE                          = ',
     1           G15.7)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7020)
 7020   FORMAT('METHOD OF L-MOMENT ESTIMATES WILL BE SAVED AS ',
     1         'INTERNAL PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7022)
 7022   FORMAT('GAMMALMO, SCALELMO, AND LOCLMOM.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGL')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLGL--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLGM(Y,N,
     1XTEMP,MAXNXT,
     1PML,PMLVAR,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR GEOMETRIC DISTRIBUTION
C              THE MAXIMIM LIKELIHOOD ESTIMEATE IS SIMPLY THE
C              SAMPLE MEAN.
C     EXAMPLE--GEOMETRIC MAXIMUM LIKELIHOOD Y
C     REFERENCE--"UNIVARIATE DISCRETE DISTRIBUTIONS", SECOND EDITION,
C                JOHNSON, KOTZ, AND KEMP, WILEY, PP. 202.
C              --"STATISTICAL DISTRIBUTIONS IN ENGINEERING",
C                KARL BURY, 1999, CAMBRIDGE UNIVERSITY PRESS, P. 92.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/3
C     ORIGINAL VERSION--MARCH     2004.
C     UPDATED         --AUGUST    2005. REFORMAT OUTPUT FOR CONSISTENCY
C                                       WITH OTHER ML ROUTINES
C     UPDATED         --SEPTEMBER 2005. ADD CONFIDENCE INTERVALS FOR P
C
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*1 IBASLC
C
      PARAMETER (NUMALP=5)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWNO(NUMALP)
      DIMENSION AUPPNO(NUMALP)
      EXTERNAL SUM
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
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
CCCCC DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='GM  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGM')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLGM--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
       ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN GEOMETRIC MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS NON-POSITIVE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** WARNING FROM GEOMETRIC MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
C               ******************************
C               **  STEP 21--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR GEOMETRIC MLE ESTIMATE**
C               ******************************
C
 2100 CONTINUE
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
C
      DO2105I=1,N
        ITEMP=INT(Y(I)+0.5)
        Y(I)=REAL(ITEMP)
 2105 CONTINUE
      IERROR='NO'
      IWRITE='OFF'
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
      IF(XMIN.LT.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2111)
 2111   FORMAT('***** ERROR FROM GEOMETRIC MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2113)
 2113   FORMAT('      NEGATIVE VALUE ENCOUNTERED.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL SUM(Y,N,IWRITE,XSUM,IBUGA3,IERROR)
      PML=1.0/(XMEAN+1.0)
      PMLVAR=PML*PML*(1.0-PML)/REAL(N)
C
      AN=REAL(N)
      DO2210I=1,NUMALP
C
        ALP=ALPHA(I)
        P1=ALP/2.0
        P2=1.0-(ALP/2.0)
C
        CALL NBPPF(P1,PML,AN,SL)
        CALL NBPPF(P2,PML,AN,SU)
        ALOWNO(I)=1.0/((SU/AN)+1.0)
        AUPPNO(I)=1.0/((SL/AN)+1.0)
C
 2210 CONTINUE
C
C               **********************************
C               **   STEP 42--                  **
C               **   WRITE OUT EVERYTHING       **
C               **   FOR GEOMETRIC MLE ESTIMATE **
C               **********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Geometric Parameter Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=250>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5060   FORMAT('         Summary Statistics:')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Mean:')
 5063   FORMAT('         Sample Standard Deviation:')
 5064   FORMAT('         Sample Minimum:')
 5065   FORMAT('         Sample Maximum:')
 5066   FORMAT('         Maximum Likelihood Estimates:')
 5067   FORMAT('         Estimate of Probability of Success Parameter ',
     1         '<i>p</i>:')
 5068   FORMAT('         Asymptotic Sampling Variance of ',
     1         '<i>p</i>:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)PML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)PMLVAR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Limits for the ',
     1         'Probability of Success Parameter</B><BR>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5134   FORMAT('         &nbsp;')
 5136   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM COLSPAN=2>')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=3>')
 5162   FORMAT('          <HR>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        DO5140I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWNO(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPNO(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5140   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Geometric Parameter Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Summary Statistics: & ',2X,A1,A1)
 8022 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8023 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,' & ',2X,A1,A1)
 8028 FORMAT(5X,'Maximum Likelihood Estimates: & ',2X,A1,A1)
 8029 FORMAT(5X,'Estimate of Probability of Success Parameter $p$: & ',
     1       G15.7,2X,A1,A1)
 8030 FORMAT(5X,'Asymptotic Sampling Variance of $p$: & ',
     1       G15.7,2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)PML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)PMLVAR,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{center}')
 8093 FORMAT(A1,'end{table}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for the ',
     1      'Probability of Success Parameter}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8111)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper ',
     1         2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit ',
     1         2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,
     1         2X,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8130I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWNO(I),AUPPNO(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8130   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4201)
 4201   FORMAT(12X,'GEOMETRIC PARAMETER ESTIMATION')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4210)
 4210   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)N
 4211   FORMAT('NUMBER OF OBSERVATIONS             = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4213)XMEAN
 4213   FORMAT('SAMPLE MEAN                        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4215)XSD
 4215   FORMAT('SAMPLE STANDARD DEVIATION          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4217)XMIN
 4217   FORMAT('SAMPLE MINIMUM                     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4218)XMAX
 4218   FORMAT('SAMPLE MAXIMUM                     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4219)XSUM
 4219   FORMAT('SAMPLE SUM                         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4220)
 4220   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)PML
 4223   FORMAT('PROBABILITY OF SUCCESS PARAMETER P = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)PMLVAR
 4225   FORMAT('ASYMPTOTIC SAMPLING VARIANCE OF P  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4310)
 4310   FORMAT('CONFIDENCE INTERVAL FOR PROBABILITY OF SUCCESS ',
     1         'PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4321)
 4321   FORMAT('   CONFIDENCE           LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4323)
 4323   FORMAT('   VALUE (%)            LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4326)
 4326   FORMAT('-------------------------------------------')
        CALL DPWRST('XXX','WRIT')
        DO4341I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4347)ATEMP,ALOWNO(I),AUPPNO(I)
 4347     FORMAT('   ',F8.3,10X,2(G12.6,2X))
          CALL DPWRST('XXX','WRIT')
 4341   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4401)
 4401   FORMAT('PML AND PMLVAR WILL BE SAVED AS AN INTERNAL ',
     1         'PARAMETERS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGM')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLGM--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLGP(Y,N,
     1XTEMP,TEMP2,TEMP3,TEMP4,TEMP5,YTEMP,MAXNXT,THRESH,
     1QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
     1GAMMA1,SCALE1,ALOC1,GAMMA2,SCALE2,ALOC2,ASHALM,ASCALM,ALOCLM,
     1GAMMA3,SCALE3,ALOC3,
     1ICAPSW,ICAPTY,DTEMP1,XMOM,
     1IGEPDF,IOUNI1,IOUNI2,ISEED,ALPHAP,
     1IGEPSV,GAMMSV,SCALSV,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE METHOD OF MOMENT AND
C              MAXIMUM LIKELIHOOD ESTIMATES FOR THE GENERALIZED PARETO
C              DISTRIBUTION
C     EXAMPLE--GENERALIZED PARETO MAXIMUM LIKELIHOOD Y
C     REFERENCE--JOHNSON, KOTZ, AND BALAKRISHNAN.  "CONTINUOUS
C                UNIVARIATE DISTRIBUTIONS, VOLUME I", SECOND
C                EDITION, WILEY, 1994, PP. 614-619.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBUG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003/11
C     ORIGINAL VERSION--NOVEMBER  2003.
C     UPDATED         --JUNE      2004. SUPPORT FOR IGEPDF (ALTERNATE
C                                       DEFINITION OF GENERALIZED
C                                       PARETO: SIGN IS REVERSED)
C     UPDATED         --JUNE      2004. PRINT VARIANCE-COVARIANCE
C                                       MATRIX
C     UPDATED         --JUNE      2005. SUPPORT FOR L-MOMENTS
C                                       ESTIMATES
C     UPDATED         --JUNE      2005. FOR MLE, MOMENTS, DEFINE
C                                       "THRESH" AS THE LOCATION
C                                       PARAMETER.
C     UPDATED         --OCTOBER   2005. ALLOW DIFFERENT CHOICES FOR
C                                       STARTING VALUES
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IGEPDF
      CHARACTER*4 IGEPSV
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ICASPL
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
      DIMENSION YTEMP(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP3(*)
      DIMENSION TEMP4(*)
      DIMENSION TEMP5(*)
      DOUBLE PRECISION DTEMP1(*)
      DOUBLE PRECISION XMOM(*)
C
      PARAMETER (NUMALP=6)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWSC(NUMALP)
      DIMENSION AUPPSC(NUMALP)
      DIMENSION ALOWGA(NUMALP)
      DIMENSION AUPPGA(NUMALP)
C
      DIMENSION QP(*)
      DIMENSION XQPHAT(*)
      DIMENSION XQPSE(*)
      DIMENSION XQPLCL(*)
      DIMENSION XQPUCL(*)
C
      DOUBLE PRECISION TOL
      DOUBLE PRECISION XPAR(2)
      DOUBLE PRECISION FVEC(2)
      DOUBLE PRECISION G
      DOUBLE PRECISION T3
      DOUBLE PRECISION DT1
      DOUBLE PRECISION DT2
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DG
      DOUBLE PRECISION DS
      DOUBLE PRECISION DQP
C
      EXTERNAL GPAFUN
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
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='GP  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGP')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLGP--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN GENERALIZED PARETO MAXIMUM ',
     1         'LIKELIHOOD ESTIMATION--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1        'FOR VARIABLE 1 IS LESS THAN 3')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1147)
 1137 FORMAT('***** ERROR IN GENERALZIED PARETO MAXIMUM ',
     1       'LIKELIHOOD ESTIMATION--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
      DO1145I=1,N
        IF(Y(I).LE.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1147)
 1147     FORMAT('***** ERROR IN GENERALZIED PARETO MAXIMUM ',
     1          'LIKELIHOOD ESTIMATION--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1148)I,Y(I)
 1148     FORMAT('      ROW ',I8,' IS NON-POSITIVE (VALUE = ',G15.7,')')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
 1145 CONTINUE
C
C               ***************************************************
C               **  STEP 21--                                    **
C               **  CARRY OUT CALCULATIONS                       **
C               **  FOR GENERALIZED PARETO MOMENT/MLE ESTIMATION **
C               ***************************************************
C
 2000 CONTINUE
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
      CALL MEAN(Y,N,IWRITE,AMEAN,IBUGA3,IERROR)
      CALL VAR(Y,N,IWRITE,AVAR,IBUGA3,IERROR)
      CALL SORT(Y,N,Y)
C
C  EXTRACT POINTS ABOVE THE THRESHOLD.  IF NO THRESHOLD SPECIFIED,
C  THEN USED MINIMUM OF DATA (MINUS AN EPS) AS ESTIMATE OF LOCATION.
C
      IF(THRESH.EQ.0.0)THEN
        EPS=XMIN*0.0001
        ALOC=XMIN - EPS
        NUSE=N
        DO2005I=1,N
          YTEMP(I)=Y(I) - ALOC
 2005   CONTINUE
      ELSE
        ALOC=THRESH
        DO2010I=1,N
          IF(Y(I).GT.THRESH)THEN
            IFRST=I
            GOTO2019
          ENDIF
 2010   CONTINUE
        IFIRST=N+1
 2019   CONTINUE
C
        NUSE=N-IFRST+1
        IF(NUSE.LT.2)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2011)
 2011     FORMAT('***** ERROR FROM GENERALIZED PARETO MAXIMUM ',
     1           'LIKELIHOOD')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2021)
 2021     FORMAT('      NO POINTS ARE ABOVE THE THRESHOLD.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2023)THRESH
 2023     FORMAT('      THRESHOLD          = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2025)Y(N)
 2025     FORMAT('      MAXIMUM DATA POINT = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSE
          ICNT=0
          DO2030I=IFRST,N
            ICNT=ICNT+1
            YTEMP(ICNT)=Y(I)
 2030     CONTINUE
        ENDIF
      ENDIF
C
      CALL MEAN(YTEMP,NUSE,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL VAR(YTEMP,NUSE,IWRITE,XVAR,IBUGA3,IERROR)
      XSD=SQRT(XVAR)
C
      GAMMA1=0.5*(XMEAN*XMEAN/XVAR - 1.0)
      SCALE1=0.5*XMEAN*(XMEAN*XMEAN/XVAR + 1.0)
      ALOC1=ALOC
C
CCCCC JUNE 2005: ADD L-MOMENT ESTIMATES.
C
      NMOM=3
      DO2110I=1,N
        DTEMP1(I)=DBLE(Y(I))
 2110 CONTINUE
      CALL SAMLMU(DTEMP1,N,XMOM,NMOM)
      T3=XMOM(3)
      IF(XMOM(2).LE.0.0D0 .OR. DABS(T3).GE.1.0D0)THEN
        ALOCLM=CPUMIN
        ASCALM=CPUMIN
        ASHALM=CPUMIN
      ELSE
        G=(1.0D0-3.0D0*T3)/(1.0D0+T3)
        ASHALM=REAL(G)
        ASCALM=REAL((1.0D0+G)*(2.0D0+G)*XMOM(2))
        ALOCLM=REAL(XMOM(1)-DBLE(ASCALM)/(1.0D0+G))
      ENDIF
C
      ICASPL='GPAR'
      ITEMP=2
      NSAMP=20*NUSE
      IF(NSAMP.GT.5000)NSAMP=5000
      CALL DPEPM2(YTEMP,NUSE,ICASPL,MAXNXT,MINMAX,IGEPDF,
     1            ISEED,NSAMP,
     1            TEMP2,TEMP3,TEMP4,TEMP5,XTEMP,
     1            ALOCDM,SCALE3,GAMMA3,
     1            IBUGA3,ISUBRO,IERROR)
      ALOC3=ALOC1
C
      IF(IGEPSV.EQ.'EPER')THEN
        XPAR(1)=DBLE(GAMMA3)
        XPAR(2)=DBLE(SCALE3)
      ELSEIF(IGEPSV.EQ.'LMOM')THEN
        XPAR(1)=DBLE(ASHALM)
        XPAR(2)=DBLE(ASCALM)
      ELSEIF(IGEPSV.EQ.'MOME')THEN
        XPAR(1)=DBLE(GAMMA1)
        XPAR(2)=DBLE(SCALE1)
      ELSEIF(IGEPSV.EQ.'USER')THEN
        XPAR(1)=DBLE(GAMMSV)
        XPAR(2)=DBLE(SCALSV)
      ELSE
        XPAR(1)=DBLE(GAMMA3)
        XPAR(2)=DBLE(SCALE3)
      ENDIF
      DO2111I=1,MAXNXT
        DTEMP1(I)=0.0D0
 2111 CONTINUE
C
      IOPT=2
      TOL=1.0D-5
      NVAR=2
      NPRINT=-1
      INFO=0
      LWA=MAXNXT
      CALL DNSQE(GPAFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1           DTEMP1,MAXNXT,YTEMP,NUSE)
C
      ALOC2=ALOC1
      GAMMA2=REAL(XPAR(1))
      SCALE2=REAL(XPAR(2))
      MLFLAG=0
      IF(INFO.EQ.0)MLFLAG=1
      IF(INFO.EQ.2)MLFLAG=1
      IF(INFO.EQ.4)MLFLAG=1
C
      IF(GAMMA1.GT.-0.25)THEN
        AC1=(1.0+GAMMA1)**2/
     1      ((1.0+2.0*GAMMA1)*(1.0+3.0*GAMMA1)*(1.0+4.0*GAMMA1))
        AC1=AC1/REAL(N)
        VARMM2=2.0*SCALE1**2*(1.0+6.0*GAMMA1+12.0*GAMMA1**2)
        VARMM2=AC1*VARMM2
        VARMM1=(1.0+2.0*GAMMA1)**2*(1.0+GAMMA1+6.0*GAMMA1**2)
        VARMM1=AC1*VARMM1
        COVMOM=AC1*SCALE1*
     1         (1.0+2.0*GAMMA1)*(1.0+4.0*GAMMA1+12.0*GAMMA1**2)
      ELSE
        VARMM1=CPUMIN
        VARMM2=CPUMIN
        COVMOM=CPUMIN
      ENDIF
C
      IF(MLFLAG.EQ.0)THEN
        AN=REAL(N)
        VARML1=(1.0-GAMMA2)**2/AN
        VARML2=2.0*SCALE2**2*(1.0-GAMMA2)/AN
        COVML=SCALE2*(1.0-GAMMA2)/AN
        DO2310I=1,NUMALP
          ALP=ALPHA(I)
          P=1.0-(ALP/2.0)
          CALL NORPPF(P,PPF)
          ALOWSC(I)=SCALE2 - PPF*SQRT(VARML2)
          AUPPSC(I)=SCALE2 + PPF*SQRT(VARML2)
          IF(IGEPDF.EQ.'SIMI')THEN
            ALOWGA(I)=GAMMA2 - PPF*SQRT(VARML1)
            AUPPGA(I)=GAMMA2 + PPF*SQRT(VARML1)
          ELSE
            ALOWGA(I)=(-GAMMA2) - PPF*SQRT(VARML1)
            AUPPGA(I)=(-GAMMA2) + PPF*SQRT(VARML1)
          ENDIF
 2310   CONTINUE
C
        IF(NPERC.GE.1)THEN
C
          ALPHL=ALPHAP/2.0
          ALPHU=1.0 - ALPHAP/2.0
          CALL NORPPF(ALPHU,Z95)
C
C
CCCCC     WRITE(IOUNI1,2531)
CCCCC     WRITE(IOUNI1,2532)
          DO2429I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL GEPPPF(QPTEMP,MINMAX,GAMMA2,IGEPDF,APPF)
            XQPHAT(I)=ALOC2 + SCALE2*APPF
C
            IF(GAMMA2.EQ.0.0)THEN
              DT1=-DLOG(1.0D0 - DBLE(QPTEMP))
              DT2=0.0D0
            ELSE
              DG=DBLE(GAMMA2)
              DS=DBLE(SCALE2)
              DQP=DBLE(QPTEMP)
              DT1=(1.0D0/DG)*(1.0D0 - (1.0D0 - DQP)**DG)
              DT2=-(DS/(DG*DG))*(1.0D0 - (1.0D0 - DQP)**DG) -
     1            (DS/DG)*((1.0D0 - DQP)**DG)*DLOG(1.0D0 - DQP)
            ENDIF
C
            DTERM1=DT1**2*DBLE(VARML2) + DT1*DT2*DBLE(COVML) +
     1             DT2**2*DBLE(VARML1) + DT1*DT2*DBLE(COVML)
            SEXQP=REAL(DTERM1)
            IF(SEXQP.GE.0.0)THEN
              SEXQP=SQRT(SEXQP)
            ELSE
              SEXQP=0.0
            ENDIF
            XQPSE(I)=SEXQP
            XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
            XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
CCCCC       WRITE(IOUNI1,'(5E15.7)')
CCCCC1           QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
 2429     CONTINUE
C2531     FORMAT(15X,'       POINT     ','   STANDARD    ',
CCCCC1           '     LOWER     ',
CCCCC1           '     UPPER')
C2532     FORMAT('    PERCENTILE ','     ESTIMATE   ',
CCCCC1           '     ERROR     ',
CCCCC1           'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
        ENDIF
C
      ELSE
        VARML1=CPUMIN
        VARML2=CPUMIN
        COVML=CPUMIN
      ENDIF
C
      IF(IGEPDF.EQ.'SIMI')THEN
        GAMMA1=-GAMMA1
        IF(ASHALM.NE.CPUMIN)ASHALM=-ASHALM
      ELSE
        GAMMA2=-GAMMA2
      ENDIF
C
C               ***********************************************
C               **   STEP 42--                               **
C               **   WRITE OUT EVERYTHING                    **
C               **   FOR GENERALIZED PARETO MLE ESTIMATION   **
C               ***********************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5002   FORMAT('<UL>')
 5003   FORMAT('<H2>Generalized Pareto Parameter Estimation</H2>')
 5004   FORMAT('</UL>')
 5005   FORMAT('<BR><BR>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5003)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5005)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
C5015   FORMAT('   <CAPTION ALIGN=CENTER>')
C5017   FORMAT('      <B>Method of Moments and Method of Maximum ',
C    1         'Likelihood</B>')
C5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5015)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5017)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5019)
CCCCC   CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=350>')
 5044   FORMAT('         <B>Summary Statistics:</B>')
 5045   FORMAT('         Number of Observations:')
 5061   FORMAT('         Sample Mean (All Data):')
 5062   FORMAT('         Sample Variance (All Data):')
 5063   FORMAT('         Sample Minimum:')
 5064   FORMAT('         Sample Maximum:')
 5144   FORMAT('         User-Specified Threshold:')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5044)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5045)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XVAR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5144)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)THRESH
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5065   FORMAT('         <B>Method of Moments</B>')
 5165   FORMAT('         (Valid If Shape Parameter < 1)')
 5265   FORMAT('         (Valid If Shape Parameter > -1)')
 5266   FORMAT('         Sample Mean (after subtracting location):')
 5267   FORMAT('         Sample Variance (after subtracting ',
     1         'location):')
 5166   FORMAT('         Estimate of Location:')
 5066   FORMAT('         Estimate of Gamma:')
 5067   FORMAT('         Estimate of Scale:')
 5068   FORMAT('         Variance of Gamma:')
 5069   FORMAT('         Variance of Scale:')
 5070   FORMAT('         Covariance of Gamma and Scale:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        IF(IGEPDF.EQ.'SIMI')THEN
          WRITE(ICOUT,5165)
        ELSE
          WRITE(ICOUT,5265)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5166)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALOC1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALE1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMA1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        IF(VARMM1.NE.CPUMIN)THEN
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5068)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)VARMM1
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5069)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)VARMM2
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5070)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)COVMOM
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5080   FORMAT('         <B>Method of L-Moments</B>')
 5081   FORMAT('         (L-Moments Work Best For Values Of The')
 5082   FORMAT('         Shape Parameter In The Interval (-0.5,0.5))')
 5083   FORMAT('         First Sample L-Moment')
 5084   FORMAT('         Second Sample L-Moment')
 5085   FORMAT('         Third Sample L-Moment')
 5086   FORMAT('         L-Moment Estimates Cannot Be Computed')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5080)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5081)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5082)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5083)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)REAL(XMOM(1))
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5084)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)REAL(XMOM(2))
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5085)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)REAL(XMOM(3))
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        IF(ASHALM.EQ.CPUMIN)THEN
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5082)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5055)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
        ELSE
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5166)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)ALOCLM
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5067)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)ASCALM
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5066)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)ASHALM
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
        ENDIF
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5180   FORMAT('         <B>Elemental Percentile Method</B>')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5180)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5166)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALOC3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALE3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMA3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5071   FORMAT('         <B>Maximum Likelihood</B>')
 5072   FORMAT('         (Maximum Likelihood Estimates Do Not Exist')
 5073   FORMAT('         If Shape Parameter < -1')
 5074   FORMAT('         And May Perform Poorly If < -0.5)')
 5173   FORMAT('         If Shape Parameter > 1')
 5174   FORMAT('         And May Perform Poorly If > 0.5)')
 5274   FORMAT('         Unable to Compute the Maximum Likelihood ',
     1         'Estimates')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        IF(MLFLAG.EQ.1)THEN
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5274)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5055)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5091)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5093)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          GOTO5199
        ENDIF
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5072)
        CALL DPWRST('XXX','WRIT')
        IF(IGEPDF.EQ.'SIMI')THEN
          WRITE(ICOUT,5073)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5074)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,5173)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5174)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5166)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALOC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALE2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMA2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)VARML1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)VARML2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5070)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)COVML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5311   FORMAT('<UL>')
 5313   FORMAT('<TABLE NOBORDER>')
 5315   FORMAT('   <CAPTION ALIGN=CENTER>')
 5317   FORMAT('      <B>Confidence Limits for the Shape ',
     1         'Parameter</B><BR>')
 5319   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5311)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5313)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5315)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5317)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5319)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5321   FORMAT('   <TR>')
 5323   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5325   FORMAT('         Confidence<br>Value (%)')
 5327   FORMAT('      </TH>')
 5329   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5331   FORMAT('         Lower<br>Limit')
 5333   FORMAT('         Upper<br>Limit')
 5334   FORMAT('         &nbsp;')
 5336   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM COLSPAN=2>')
 5337   FORMAT('         Normal Approximation')
 5339   FORMAT('   </TR>')
 5361   FORMAT('      <TD COLSPAN=3>')
 5362   FORMAT('          <HR>')
 5364   FORMAT('         Note: For the Generalized Pareto ',
     1         'distribution, large ')
 5365   FORMAT('         sample sizes may be required for the ',
     1         'approximation to be accurate')
 5366   FORMAT('         (e.g., > 500).')
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5364)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5365)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5366)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5334)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5336)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5337)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5339)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5334)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5336)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5337)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5339)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5325)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5329)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5331)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5329)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5333)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5339)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5361)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5362)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5347)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5339)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5341   FORMAT('   <TR>')
 5347   FORMAT('      </TD>')
 5349   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5351   FORMAT('         ',G15.7)
 5359   FORMAT('   </TR>')
        DO5340I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5341)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5351)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5347)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5351)ALOWGA(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5347)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5351)AUPPGA(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5347)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5359)
          CALL DPWRST('XXX','WRIT')
 5340   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5417   FORMAT('      <B>Confidence Limits for the Scale ',
     1         'Parameter</B>')
        WRITE(ICOUT,5311)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5313)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5315)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5417)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5319)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5334)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5336)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5337)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5339)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5325)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5329)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5331)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5329)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5333)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5339)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5361)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5362)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5347)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5339)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
        DO5440I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5341)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5351)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5347)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5351)ALOWSC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5347)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5351)AUPPSC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5347)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5359)
          CALL DPWRST('XXX','WRIT')
 5440   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 5811     FORMAT('<UL>')
 5813     FORMAT('<TABLE NOBORDER>')
 5815     FORMAT('   <CAPTION ALIGN=CENTER>')
 5816     FORMAT('      <BR><B>Alpha = ',F7.3,'</B>')
 5817     FORMAT('      <B>Confidence Limits (Normal Approximation) ',
     1           'for Selected Percentiles')
 5819     FORMAT('   </CAPTION>')
 5841     FORMAT('   <TR>')
 5843     FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5847     FORMAT('      </TD>')
 5848     FORMAT('      </TH>')
 5849     FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5851     FORMAT('         ',G15.7)
 5859     FORMAT('   </TR>')
 5861     FORMAT('         Percentile')
 5862     FORMAT('         Point <br> Estimate')
55862     FORMAT('         Standard <br> Error')
 5863     FORMAT('         Lower <br>Confidence Limit')
 5864     FORMAT('         Upper <br>Confidence Limit')
 5870     FORMAT('      <TD COLSPAN=5>')
 5872     FORMAT('         <HR WIDTH=600>')
C
C  START THE TABLE FOR PERCENTILE CONFIDENCE INTERVALS
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,999)
          WRITE(ICOUT,5811)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5813)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5815)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5817)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5816)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5819)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5861)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,55862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5863)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5864)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5870)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5872)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5847)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          DO55880I=1,NPERC
            WRITE(ICOUT,5841)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)QP(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPHAT(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPSE(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPLCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPUCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5859)
            CALL DPWRST('XXX','WRIT')
55880     CONTINUE
C
C  END THE TABLE AND RESET ASIS MODE
C
          WRITE(ICOUT,5091)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5093)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
 5199   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Generalized Pareto Parameter Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8121 FORMAT(5X,'{',A1,'bf Summary Statistics} & ',
     1       2X,A1,A1)
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean (All Data): & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Variance (All Data): & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Minimum: & ',
     1       G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Maximum: & ',
     1       G15.7,2X,A1,A1)
 8125 FORMAT(5X,'User-Specified Threshold: & ',
     1       G15.7,2X,A1,A1)
 8026 FORMAT(5X,'{',A1,'bf Method of Moments} & ',
     1       2X,A1,A1)
 8126 FORMAT(5X,'(Valid If Shape Parameter $<$ 1) & ',
     1       2X,A1,A1)
 8127 FORMAT(5X,'(Valid If Shape Parameter $>$ -1) & ',
     1       2X,A1,A1)
 8122 FORMAT(5X,'Sample Mean (After Subtracting Location): & ',
     1       G15.7,2X,A1,A1)
 8123 FORMAT(5X,'Sample Variance (After Subtracting Location): & ',
     1       G15.7,2X,A1,A1)
 8226 FORMAT(5X,'{',A1,'bf Method of L-Moments} & ',
     1       2X,A1,A1)
 8230 FORMAT(5X,'(L-Moment Estimates Work Best For Values Of: & ',
     1       2X,A1,A1)
 8231 FORMAT(5X,'The Shape Parameter in (-0.5,0.5)): & ',
     1       2X,A1,A1)
 8232 FORMAT(5X,'Unable To Compute The L-Moment Based Estimates: & ',
     1       2X,A1,A1)
 8222 FORMAT(5X,'First Sample L-Moment: & ',
     1       G15.7,2X,A1,A1)
 8223 FORMAT(5X,'Second Sample L-Moment: & ',
     1       G15.7,2X,A1,A1)
 8224 FORMAT(5X,'Third Sample L-Moment: & ',
     1       G15.7,2X,A1,A1)
 8027 FORMAT(5X,'Estimate of Gamma: & ',G15.7,2X,A1,A1)
 8028 FORMAT(5X,'Estimate of Scale: & ',G15.7,2X,A1,A1)
 8128 FORMAT(5X,'Estimate of Location: & ',G15.7,2X,A1,A1)
 8029 FORMAT(5X,'Variance of Gamma: & ',G15.7,2X,A1,A1)
 8030 FORMAT(5X,'Variance of Scale: & ',G15.7,2X,A1,A1)
 8031 FORMAT(5X,'Covariance of Gamma and Scale: & ',G15.7,2X,A1,A1)
 8032 FORMAT(5X,'{',A1,'bf Maximum Likelihood} & ',
     1       2X,A1,A1)
 8033 FORMAT(5X,'(Maximum Likelihood Estimates Do Not Exist & ',
     1       2X,A1,A1)
 8034 FORMAT(5X,'If The Shape Parameter $<$ -1 And May & ',
     1       2X,A1,A1)
 8035 FORMAT(5X,'Perform Poorly If $<$ -0.5) & ',
     1       2X,A1,A1)
 8036 FORMAT(5X,'If The Shape Parameter $>$ 1 And May & ',
     1       2X,A1,A1)
 8037 FORMAT(5X,'Perform Poorly If $>$ 0.5) & ',
     1       2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8041 FORMAT(5X,': & ',2X,A1,A1)
 8049 FORMAT(A1,'end{tabular}')
 8052 FORMAT(5X,'{',A1,'bf Elemental Percentile Method} & ',
     1       2X,A1,A1)
 8054 FORMAT(5X,'Unable to Compute the Maximum Likelihood ',
     1       'Estimates & ',2X,A1,A1)
C
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)AMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)AVAR,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8125)THRESH,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8041)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8026)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IGEPDF.EQ.'SIMI')THEN
          WRITE(ICOUT,8126)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8127)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8122)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8123)XVAR,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8128)ALOC1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)SCALE1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)GAMMA1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(VARMM1.NE.CPUMIN)THEN
          WRITE(ICOUT,8029)VARMM1,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8030)VARMM2,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8031)COVMOM,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8041)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8226)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8230)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8231)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8222)REAL(XMOM(1)),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8223)REAL(XMOM(2)),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8224)REAL(XMOM(3)),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(ASHALM.EQ.CPUMIN)THEN
          WRITE(ICOUT,8232)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8128)ALOCLM,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8028)ASCALM,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8027)ASHALM,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8041)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8052)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8128)ALOC3,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)SCALE3,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)GAMMA3,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8041)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
C  START NEW TABLE FOR MAXIMIM LIKELIHOOD ESTIMATES
C
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        IF(MLFLAG.EQ.1)THEN
          WRITE(ICOUT,8054)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          GOTO8090
        ENDIF
C

        WRITE(ICOUT,8032)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8033)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IGEPDF.EQ.'SIMI')THEN
          WRITE(ICOUT,8034)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8035)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8036)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8037)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8128)ALOC2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)SCALE2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)GAMMA2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)VARML1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)VARML2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)COVML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8307 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8309 FORMAT(A1,'begin{center}')
 8311 FORMAT(5X,'{',A1,'bf Confidence Limits for Shape Parameter}')
 8313 FORMAT(A1,'end{center}')
 8415 FORMAT(5X,'Note: For the generalized Pareto distribution, ',
     1       'large sanple',A1,A1)
 8416 FORMAT(5X,'sizes may be required for the normal approximations ',
     1       'to be',A1,A1)
 8417 FORMAT(5X,'accurate (e.g., > 500).',A1,A1)
C
        WRITE(ICOUT,8309)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8311)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8415)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8416)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8417)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8307)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8307)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8313)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8320   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8321   FORMAT(5X,'Confidence & Lower & Upper ',
     1         2X,A1,A1)
 8322   FORMAT(5X,'Value (',A1,'%) & Limit & Limit',
     1         2X,A1,A1)
 8331   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,2X,A1,A1)
 8326   FORMAT(5X,'& ',A1,'multicolumn{2}{c}{Normal Approximation}',
     1         2X,A1,A1)
 8340   FORMAT(5X,A1,'hline')
 8349   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8309)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8320)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8326)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8321)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8322)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8340)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8330I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8331)ATEMP,ALOWGA(I),AUPPGA(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8330   CONTINUE
        WRITE(ICOUT,8349)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8411 FORMAT(5X,'{',A1,'bf Confidence Limits for Scale Parameter}')
C
        WRITE(ICOUT,8309)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8411)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8307)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8307)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8313)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
        WRITE(ICOUT,8309)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8320)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8326)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8321)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8322)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8340)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8430I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8331)ATEMP,ALOWSC(I),AUPPSC(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8430   CONTINUE
        WRITE(ICOUT,8349)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8090   CONTINUE
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{table}')
 8093 FORMAT(A1,'end{center}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C WRITE SELECTED PERCENTILES (IF ANY)
C
        IF(NPERC.GT.0)THEN
C
          CALL DPCONA(92,IBASLC)
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8803)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8810)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8812)IBASLC,IBASLC,ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8813)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8820)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8821)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8822)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,
     1                     IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8840)IBASLC
          CALL DPWRST('XXX','WRIT')
          DO8830I=1,NPERC
            WRITE(ICOUT,8823)QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),
     1                       XQPUCL(I),IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
 8830     CONTINUE
          WRITE(ICOUT,8849)IBASLC
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8891)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8893)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
 8801   FORMAT(A1,'end{verbatim}')
 8803   FORMAT(A1,'begin{table}')
 8807   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8809   FORMAT(A1,'begin{center}')
 8810   FORMAT(5X,'{',A1,'bf Confidence Limits (Normal Approximation)',
     1         'for Selected Percentiles}')
 8812   FORMAT(5X,'{',A1,'bf $',A1,'alpha$ = ',F7.3,'}')
 8813   FORMAT(A1,'end{center}')
 8815   FORMAT(5X,'} ',A1,A1)
 8820   FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8821   FORMAT(5X,' & {',A1,'bf Point} & {',A1,'bf Standard} & {',
     1         A1,'bf Lower} & {',A1,'bf Upper}',2X,A1,A1)
 8822   FORMAT(5X,'{',A1,'bf Percentile} & {',A1,'bf Estimate} & {',
     1         A1,'bf Error} & {',A1,'bf Confidence Limit} & {',
     1         A1,'bf Confidence Limit}',
     1         2X,A1,A1)
 8823   FORMAT(5X,G15.7,' & ',G15.7,' & ',G15.7,' & ',G15.7,
     1         ' & ',G15.7,2X,A1,A1)
 8840   FORMAT(5X,A1,'hline')
 8849   FORMAT(A1,'end{tabular}')
 8891   FORMAT(A1,'end{center}')
 8893   FORMAT(A1,'end{table}')
C
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(12X,'GENERALIZED PARETO PARAMETER ESTIMATION:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4220)
 4220   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)N
 4221   FORMAT('NUMBER OF OBSERVATIONS                     = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4222)AMEAN
 4222   FORMAT('SAMPLE MEAN (ALL DATA)                     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)AVAR
 4223   FORMAT('SAMPLE VARIANCE (ALL DATA)                 = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4224)XMIN
 4224   FORMAT('SAMPLE MINIMUM                             = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)XMAX
 4225   FORMAT('SAMPLE MAXIMUM                             = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4226)THRESH
 4226   FORMAT('USER-SPECIFIED THRESHOLD                   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4230)
 4230   FORMAT('METHOD OF MOMENTS:')
        CALL DPWRST('XXX','WRIT')
        IF(IGEPDF.EQ.'SIMI')THEN
          WRITE(ICOUT,4231)
 4231     FORMAT('(VALID IF SHAPE PARAMETER < 1)')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4232)
 4232     FORMAT('(VALID IF SHAPE PARAMETER > -1)')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,4234)XMEAN
 4234   FORMAT('SAMPLE MEAN (AFTER SUBTRACT LOCATION)      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4235)XVAR
 4235   FORMAT('SAMPLE VARIANCE (AFTER SUBTRACT LOCATION)  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4233)ALOC1
 4233   FORMAT('ESTIMATE OF LOCATION                       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4237)SCALE1 
 4237   FORMAT('ESTIMATE OF SCALE                          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4236)GAMMA1
 4236   FORMAT('ESTIMATE OF GAMMA                          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        IF(VARMM1.NE.CPUMIN)THEN
          WRITE(ICOUT,4238)VARMM1 
 4238     FORMAT('VARIANCE OF GAMMA                          = ',
     1           G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4239)VARMM2 
 4239     FORMAT('VARIANCE OF SCALE                          = ',
     1           G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4240)COVMOM 
 4240     FORMAT('COVARIANCE OF GAMMA AND SCALE              = ',
     1           G15.7)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4250)
 4250   FORMAT('L-MOMENTS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4251)
 4251   FORMAT('(L-MOMENT ESTIMATES WORK BEST FOR')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4252)
 4252   FORMAT('VALUES OF SHAPE PARAMETER IN (-0.5,0.5))')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4256)XMOM(1)
 4256   FORMAT('FIRST SAMPLE L-MOMENT                      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4257)XMOM(2)
 4257   FORMAT('SECOND SAMPLE L-MOMENT                     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4258)XMOM(3)
 4258   FORMAT('THIRD SAMPLE L-MOMENT                      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        IF(ASHALM.EQ.CPUMIN)THEN
          WRITE(ICOUT,4260)
 4260     FORMAT('UNABLE TO COMPUTE L-MOMENT BASED ESTIMATES')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4262)ALOCLM
 4262     FORMAT('ESTIMATE OF LOCATION                       = ',
     1           G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4264)ASCALM
 4264     FORMAT('ESTIMATE OF SCALE                          = ',
     1           G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4266)ASHALM
 4266     FORMAT('ESTIMATE OF SHAPE                          = ',
     1           G15.7)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4310)
 4310   FORMAT('ELEMENTAL PERCENTILE METHOD:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4233)ALOC3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4237)SCALE3 
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4236)GAMMA3
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4280)
 4280   FORMAT('MAXIMUM LIKELIHOOD:')
        CALL DPWRST('XXX','WRIT')
        IF(MLFLAG.EQ.1)THEN
          WRITE(ICOUT,4283)
 4283     FORMAT('UNABLE TO COMPUTE MAXIMUM LIKELIHOOD ESTIMATES.')
          CALL DPWRST('XXX','WRIT')
          GOTO4299
        ENDIF
        IF(IGEPDF.EQ.'SIMI')THEN
          WRITE(ICOUT,4291)
 4291     FORMAT('(MAXIMUM LIKELIHOOD ESTIMATES DO')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4292)
 4292     FORMAT('NOT EXIST IF SHAPE PARAMTER < -1')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4293)
 4293     FORMAT('AND MAY PERFORM POORLY IF < -0.5)')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4296)
 4296     FORMAT('(MAXIMUM LIKELIHOOD ESTIMATES DO')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4297)
 4297     FORMAT('NOT EXIST IF SHAPE PARAMTER > 1')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4298)
 4298     FORMAT('AND MAY PERFORM POORLY IF > 0.5)')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,4233)ALOC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4237)SCALE2 
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4236)GAMMA2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4238)VARML1 
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4239)VARML2 
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4240)COVML 
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4331)
 4331   FORMAT('NOTE: FOR THE GENERALIZED PARETO DISTRIBUTION, ',
     1         'LARGE SAMPLE SIZES')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4333)
 4333   FORMAT('      MAY BE REQUIRED FOR THE NORMAL APPROXIMATIONS ',
     1         'TO BE ACCURATE (E.G., > 500).')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4340)
 4340   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4342)
 4342   FORMAT('                       NORMAL APPROXIMATION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4343)
 4343   FORMAT('   CONFIDENCE           LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4345)
 4345   FORMAT('   VALUE (%)            LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4346)
 4346   FORMAT('-------------------------------------------')
        CALL DPWRST('XXX','WRIT')
        DO4349I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4347)ATEMP,ALOWSC(I),AUPPSC(I)
 4347     FORMAT('   ',F8.3,10X,2(G12.6,2X))
          CALL DPWRST('XXX','WRIT')
 4349   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4352)
 4352   FORMAT('CONFIDENCE INTERVAL FOR SHAPE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4342)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4343)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4345)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4346)
        CALL DPWRST('XXX','WRIT')
        DO4359I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4347)ATEMP,ALOWGA(I),AUPPGA(I)
          CALL DPWRST('XXX','WRIT')
 4359   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,4911)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4915)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4921)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4922)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4946)
          CALL DPWRST('XXX','WRIT')
C
 4911   FORMAT('CONFIDENCE LIMITS (NORMAL APPROXIMATION) FOR ',
     1         'SELECTED PERCENTILES:')
 4915   FORMAT('ALPHA = ',F7.4)
 4921   FORMAT(10X,'      POINT     ','  STANDARD   ',
     1             '        LOWER     ', '       UPPER')
 4922   FORMAT('PERCENTILE','   ESTIMATE   ','      ERROR     ',
     1         'CONFIDENCE LIMIT ',' CONFIDENCE LIMIT')
 4946   FORMAT('-----------------------------------',
     1         '-----------------------------------')
C
          DO4981I=1,NPERC
            WRITE(ICOUT,4932)QP(I),XQPHAT(I),XQPSE(I),
     1                       XQPLCL(I),XQPUCL(I)
 4932       FORMAT(2X,F8.4,2G15.7,2X,G15.7,2X,G15.7)
            CALL DPWRST('XXX','WRIT')
 4981     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
 4299   CONTINUE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7011)
 7011   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES WILL BE SAVED AS ',
     1         'INTERNAL PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7012)
 7012   FORMAT('GAMMAML, SCALEML, AND LOCML.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7013)
 7013   FORMAT('MAXIMUM LIKELIHOOD PARAMETER VARIANCE-COVARIANCE ',
     1         'MATRIX WRITTEN TO DPST1F.DAT')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7016)
 7016   FORMAT('METHOD OF MOMENT ESTIMATES WILL BE SAVED AS ',
     1         'INTERNAL PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7017)
 7017   FORMAT('GAMMAMOM, SCALEMOM, AND LOCMOM.')
        CALL DPWRST('XXX','BUG ')
        IF((GAMMA1.GT.-0.25.AND.IGEPDF.EQ.'JOHN') .OR.
     1     (GAMMA1.LT.0.25.AND.IGEPDF.EQ.'SIMI'))THEN
          WRITE(ICOUT,7018)
 7018     FORMAT('METHOD OF MOMENTS PARAMETER VARIANCE-COVARIANCE ',
     1           'MATRIX WRITTEN TO DPST1F.DAT')
          CALL DPWRST('XXX','BUG ')
        ENDIF
        WRITE(ICOUT,7020)
 7020   FORMAT('METHOD OF L-MOMENT ESTIMATES WILL BE SAVED AS ',
     1         'INTERNAL PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7022)
 7022   FORMAT('GAMMALMO, SCALELMO, AND LOCLMOM.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7024)
 7024   FORMAT('ELEMENTAL PERCENTILE METHOD ESTIMATES WILL BE SAVED ',
     1         'AS INTERNAL PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7026)
 7026   FORMAT('GAMMAEPM, SCALEEPM, AND LOCEPM.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
C
      WRITE(IOUNI1,7051)
 7051 FORMAT(1X,'PARAMETER VARIANCE-COVARIANCE MATRIX FOR ',
     1'GENERALIZED PARETO MAXIMUM LIKELIHOOD ESTIMATION.')
      WRITE(IOUNI1,7053)VARML1,COVML
      WRITE(IOUNI1,7053)COVML,VARML2
 7053 FORMAT(1X,2E15.7)
C
      IF((GAMMA1.GT.-0.25.AND.IGEPDF.EQ.'JOHN') .OR.
     1   (GAMMA1.LT.0.25.AND.IGEPDF.EQ.'SIMI'))THEN
        WRITE(IOUNI2,7061)
 7061   FORMAT(1X,'PARAMETER VARIANCE-COVARIANCE MATRIX FOR ',
     1  'GENERALIZED PARETO METHOD OF MOMENT ESTIMATION.')
        WRITE(IOUNI2,7053)VARMM1,COVMOM
        WRITE(IOUNI2,7053)COVMOM,VARMM2
      ENDIF
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLGP')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMLGP--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMLGU(Y,N,
     1XTEMP,MAXNXT,
     1ALOC,SCALE,ALOC2,SCALE2,
     1MINMAX,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR GUMBEL (EXTREME VALUE TYPE I)
C     EXAMPLE--GUMBEL MAXIMUM LIKELIHOOD Y
C     REFERENCE--XX
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/6
C     ORIGINAL VERSION--JUNE      1998.
C     MODIFED         --OCTOBER   2003. SUPPORT FOR MINIMUM GUMBEL
C                                       (PREVIOUSLY ONLY MAXIMUM
C                                       GUMBEL SUPPORTED)
C     MODIFED         --OCTOBER   2003. SUPPORT FOR HTML/LATEX OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
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='DPML'
      ISUBN2='GU  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGU')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLGU--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,MINMAX
   55   FORMAT('N,MINMAX = ',2I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,N
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN GUMBEL MAXIMUM LIKELIHOOD ESTIMATION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)
 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE RESPONSE ',
     1         'VARIABLE IS LESS THAN OR EQUAL TO ONE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
      IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM GUMBEL MAXIMUM LIKELIHOOD--RESPONSE ',
     1'VARIABLE HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
 1290 CONTINUE
C
C               ******************************
C               **  STEP 41--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR GUMBEL MLE ESTIMATE **
C               ******************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      CALL EV1EST(Y,N,ALOC,SCALE,ALOC2,SCALE2,MINMAX,IERROR)
C
C               *********************************
C               **   STEP 42--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR GUMBEL MLE ESTIMATE   **
C               **********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5002   FORMAT('<H2>GUMBEL (MAXIMUM CASE) PARAMETER ESTIMATION</H2>')
 5003   FORMAT('<H2>GUMBEL (MINIMUM) PARAMETER ESTIMATION</H2>')
 5004   FORMAT('<BR><BR>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,5002)
        ELSE
          WRITE(ICOUT,5003)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER CELLPADDING=5 CELLSPACING=5>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Method of Moment Estimate</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=200>')
 5045   FORMAT('         Number of Observations:')
 5061   FORMAT('         Location Parameter:')
 5062   FORMAT('         Scale Parameter:')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=200>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5059   FORMAT('   </TR>')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5045)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALOC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALE2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5117   FORMAT('      <B>Maximum Likelihood Estimate</B>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5045)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALOC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8005 FORMAT(5X,'{',A1,'bf Gumbel (Maximum Case) Parameter ',
     1       'Estimation}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Method of Moments Estimates:}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Location Parameter: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Scale Parameter: & ',G15.7,2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)ALOC2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)SCALE2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{table}')
 8093 FORMAT(A1,'end{center}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8111 FORMAT(5X,'{',A1,'bf Maximum Likelihood Estimate:}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8111)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)ALOC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)SCALE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,4111)
 4111     FORMAT('GUMBEL (MAXIMUM CASE) METHOD OF MOMENTS ESTIMATE:')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4113)
 4113     FORMAT('GUMBEL (MINIMUM CASE) METHOD OF MOMENTS ESTIMATE:')
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4142)N
 4142   FORMAT(6X,'NUMBER OF OBSERVATIONS = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4143)ALOC2
 4143   FORMAT(6X,'LOCATION PARAMETER LOC2   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4145)SCALE2
 4145   FORMAT(6X,'SCALE PARAMETER SCALE2    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4147)
 4147   FORMAT(6X,'LOC2 AND SCALE2 WILL BE SAVED AS INTERNAL ',
     1         'PARAMETERS.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,4211)
 4211     FORMAT('GUMBEL (MAXIMUM CASE) MAXIMUM LIKELIHOOD ESTIMATE:')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4213)
 4213     FORMAT('GUMBEL (MINIMUM CASE) MAXIMUM LIKELIHOOD ESTIMATE:')
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)N
 4242   FORMAT(6X,'NUMBER OF OBSERVATIONS = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4343)ALOC
 4343   FORMAT(6X,'LOCATION PARAMETER LOC    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)SCALE
 4243   FORMAT(6X,'SCALE PARAMETER SCALE     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4341)
 4341   FORMAT(6X,'LOC AND SCALE WILL BE SAVED AS INTERNAL ',
     1         'PARAMETERS.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGU')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLGU--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLGV(Y,N,
     1XTEMP,TEMP2,TEMP3,TEMP4,TEMP5,YTEMP,MAXNXT,
     1QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
     1GAMMA1,SCALE1,ALOC1,GAMMA2,SCALE2,ALOC2,ASHALM,ASCALM,ALOCLM,
     1ICAPSW,ICAPTY,DTEMP1,XMOM,
     1MINMAX,IOUNI1,IOUNI2,ISEED,ALPHA,
     1MLFLAG,ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES PARAMETER ESTIMATES FOR THE
C              GENERALIZED EXTREME VALUE DISTRIBUTION USING THE
C              FOLLOWING METHODS:
C
C              1) L-MOMENTS
C              2) ELEMENTAL PERCENTILES
C              3) MAXIMUM LIKELIHOOD
C
C                 NOTE: I AM HAVING PROBLEMS WITH HOSKINGS MAXIMUM
C                 LIKELIHOOD ROUTINE.  FOR NOW, BYPASS ML ESTIMATION.
C                 IF I GET THIS WORKING BETTER, THEN I WILL
C                 RE-ACTIVATE IT.
C
C     EXAMPLE--GENERALIZED EXTREME VALUE MAXIMUM LIKELIHOOD Y
C     REFERENCE--JOHNSON, KOTZ, AND BALAKRISHNAN.  "CONTINUOUS
C                UNIVARIATE DISTRIBUTIONS, VOLUME I", SECOND
C                EDITION, WILEY, 1994, PP. 614-619.
C              --HOSKING, ALGORITHM AS215   APPL. STATIST. (1985)
C                VOL. 34, NO. 3, Modifications in AS R76 (1989)
C                have been incorporated.
C              --CASTILLO, HADI, BALAKRISHNAN, SARABIA, "EXTREME
C                VALUE AND RELATED MODELS WITH APPLICATIONS IN
C                ENGINEERING AND SCIENCE", WILEY, 2005.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBUG, MD 20899-8980
C                 PHONE--301-975-2855
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/7
C     ORIGINAL VERSION--JULY      2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IGEPDF
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ICASPL
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
C
      LOGICAL MLFLAG
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
      DIMENSION YTEMP(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP3(*)
      DIMENSION TEMP4(*)
      DIMENSION TEMP5(*)
      DOUBLE PRECISION DTEMP1(*)
      DOUBLE PRECISION XMOM(*)
C
      DIMENSION QP(*)
      DIMENSION XQPHAT(*)
      DIMENSION XQPSE(*)
      DIMENSION XQPLCL(*)
      DIMENSION XQPUCL(*)
C
      DOUBLE PRECISION VARCOV(6)
      DOUBLE PRECISION PARA(3)
      DOUBLE PRECISION TOL
      DOUBLE PRECISION XPAR(3)
      DOUBLE PRECISION FVEC(3)
      DOUBLE PRECISION G
      DOUBLE PRECISION T3
C
      EXTERNAL GPAFUN
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='DPML'
      ISUBN2='GV  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGV')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLGV--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGV')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.3)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN GENERALIZED EXTREME VALUE MAXIMUM ',
     1         'LIKELIHOOD ESTIMATION--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE RESPONSE ',
     1        'VARIABLE IS LESS THAN 3')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1137)
 1137 FORMAT('***** ERROR IN GENERALZIED EXTREME VALUE MAXIMUM ',
     1       'LIKELIHOOD ESTIMATION--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('      RESPONSE VARIABLE HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
C               ***************************************************
C               **  STEP 21--                                    **
C               **  CARRY OUT CALCULATIONS                       **
C               **  FOR GENERALIZED EXTREME VALUE MOMENT/MLE     **
C               **  ESTIMATION                                   **
C               ***************************************************
C
 2000 CONTINUE
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGV')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL VAR(Y,N,IWRITE,XVAR,IBUGA3,IERROR)
      XSD=SQRT(XVAR)
C
      IF(MINMAX.EQ.1)THEN
        DO2002I=1,N
          Y(I)=-Y(I)
 2002   CONTINUE
      ENDIF
      CALL SORT(Y,N,Y)
C
C  COMPUTE L-MOMENT ESTIMATORS
C
      NMOM=3
      DO2110I=1,N
        DTEMP1(I)=DBLE(Y(I))
 2110 CONTINUE
      CALL SAMLMU(DTEMP1,N,XMOM,NMOM)
      CALL GEVPEL(XMOM,PARA)
      ALOCLM=REAL(PARA(1))
      ASCALM=REAL(PARA(2))
      ASHALM=REAL(PARA(3))
C
      ICASPL='GEV '
      ITEMP=2
      NSAMP=20*N
      IF(NSAMP.GT.5000)NSAMP=5000
      CALL DPEPM2(Y,N,ICASPL,MAXNXT,MINMAX,IGEPDF,
     1            ISEED,NSAMP,
     1            TEMP2,TEMP3,TEMP4,TEMP5,XTEMP,
     1            ALOC2,SCALE2,GAMMA2,
     1            IBUGA3,ISUBRO,IERROR)
C
        IF(ASHALM.NE.CPUMIN)THEN
          XPAR(1)=DBLE(ALOCLM)
          XPAR(2)=DBLE(ASCALM)
          XPAR(3)=DBLE(ASHALM)
        ELSE
          XPAR(1)=DBLE(ALOC2)
          XPAR(2)=DBLE(SCALE2)
          XPAR(3)=DBLE(GAMMA2)
        ENDIF
C
        IF(MLFLAG)THEN
          MONIT=0
          MONIT=1
          IFAULT=0
          DO2130I=1,N
            DTEMP1(I)=DBLE(Y(I))
 2130     CONTINUE
C
          CALL MLEGEV(DTEMP1,N,XPAR,VARCOV,MONIT,IFAULT)
          GAMMA1=REAL(XPAR(3))
          SCALE1=REAL(XPAR(2))
          ALOC1=REAL(XPAR(1))
C
          IF(IFAULT.EQ.1)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1011)
 1011       FORMAT(
     1'***** ERROR: MAXIMUM LIKEHOOD ESTIMATION FOR GENERALIZED')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1013)N
 1013       FORMAT(
     1'      EXTREME VALUE REQUIRES N > 2.  N = ',I8)
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO1099
          ELSEIF(IFAULT.EQ.2)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1021)
 1021       FORMAT(
     1'***** ERROR: MAXIMUM LIKEHOOD ESTIMATION FOR GENERALIZED')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1023)
 1023       FORMAT(
     1'      EXTREME VALUE EXCEEDED MAXIMUM NUMBER OF ITERATIONS.')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO1099
          ELSEIF(IFAULT.EQ.3)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1031)
 1031       FORMAT(
     1'***** ERROR: MAXIMUM LIKEHOOD ESTIMATION FOR GENERALIZED')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1033)
 1033       FORMAT(
     1'      EXTREME VALUE EXCEEDED MAXIMUM NUMBER OF EVALUATIONS ',
     1'FOR LOG LIKELIHOOD.')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO1099
          ELSEIF(IFAULT.EQ.4)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1041)
 1041     FORMAT(
     1'***** ERROR: MAXIMUM LIKEHOOD ESTIMATION FOR GENERALIZED')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1043)
 1043       FORMAT(
     1'      EXTREME VALUE EXCEEDED MAXIMUM NUMBER OF STEP LENGTH ',
     1'REDUCTIONS.')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO1099
          ENDIF
        ENDIF
C
CCCCC   WRITE(IOUNI1,1051)
C1051   FORMAT(1X,'PARAMETER VARIANCE-COVARIANCE MATRIX FOR ',
CCCCC1'GENERALIZED EXTREME VALUE MAXIMUM LIKELIHOOD ESTIMATION.')
CCCCC   WRITE(IOUNI1,1053)REAL(VARCOV(1)),REAL(VARCOV(2)),
CCCCC1                    REAL(VARCOV(4))
C1053   FORMAT(1X,3G15.7)
CCCCC   WRITE(IOUNI1,1053)REAL(VARCOV(2)),REAL(VARCOV(3)),
CCCCC1                    REAL(VARCOV(5))
CCCCC   WRITE(IOUNI1,1053)REAL(VARCOV(4)),REAL(VARCOV(5)),
CCCCC1                    REAL(VARCOV(6))
C
 1099 CONTINUE
      IF(MINMAX.EQ.1)THEN
        ALOCLM=-ALOCLM
        ALOC1=-ALOC1
        ALOC2=-ALOC2
      ENDIF
C
C               ******************************************************
C               **   STEP 42--                                      **
C               **   WRITE OUT EVERYTHING                           **
C               **   FOR GENERALIZED EXTREME VALUE MLE ESTIMATION   **
C               ******************************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGV')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5002   FORMAT('<UL>')
 5003   FORMAT('<H2>Generalized Extreme Value Parameter ',
     1         'Estimation (Maximum Case)</H2>')
 5008   FORMAT('<H2>Generalized Extreme Value Parameter ',
     1         'Estimation (Minimum Case)</H2>')
 5004   FORMAT('</UL>')
 5005   FORMAT('<BR><BR>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.1)THEN
          WRITE(ICOUT,5008)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,5003)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5005)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
C5015   FORMAT('   <CAPTION ALIGN=CENTER>')
C5017   FORMAT('      <B>Method of Moments and Method of Maximum ',
C    1         'Likelihood</B>')
C5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5015)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5017)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5019)
CCCCC   CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=350>')
 5044   FORMAT('         <B>Summary Statistics:</B>')
 5045   FORMAT('         Number of Observations:')
 5061   FORMAT('         Sample Mean (All Data):')
 5062   FORMAT('         Sample Variance (All Data):')
 5063   FORMAT('         Sample Minimum:')
 5064   FORMAT('         Sample Maximum:')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5044)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5045)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XVAR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5065   FORMAT('         <B>Method of Moments</B>')
 5165   FORMAT('         (Valid If Shape Parameter < 1)')
 5265   FORMAT('         (Valid If Shape Parameter > -1)')
 5266   FORMAT('         Sample Mean (after subtracting location):')
 5267   FORMAT('         Sample Variance (after subtracting ',
     1         'location):')
 5166   FORMAT('         Estimate of Location:')
 5066   FORMAT('         Estimate of Gamma:')
 5067   FORMAT('         Estimate of Scale:')
 5068   FORMAT('         Variance of Gamma:')
 5069   FORMAT('         Variance of Scale:')
 5070   FORMAT('         Covariance of Gamma and Scale:')
C
 5080   FORMAT('         <B>Method of L-Moments</B>')
C5081   FORMAT('         (L-Moments Work Best For Values Of The')
C5082   FORMAT('         Shape Parameter In The Interval (-0.5,0.5))')
 5083   FORMAT('         First Sample L-Moment')
 5084   FORMAT('         Second Sample L-Moment')
 5085   FORMAT('         Third Sample L-Moment')
 5086   FORMAT('         L-Moment Estimates Cannot Be Computed')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5080)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5041)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5043)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5081)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5047)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5049)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5055)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5047)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5059)
CCCCC   CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5041)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5043)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5082)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5047)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5049)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5055)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5047)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5059)
CCCCC   CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5083)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)REAL(XMOM(1))
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5084)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)REAL(XMOM(2))
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5085)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)REAL(XMOM(3))
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        IF(ASHALM.EQ.CPUMIN)THEN
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5086)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5055)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
        ELSE
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5166)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)ALOCLM
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5067)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)ASCALM
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5066)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)ASHALM
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
        ENDIF
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5180   FORMAT('         <B>Elemental Percentile Method</B>')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5180)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5166)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALOC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALE2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMA2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5071   FORMAT('         <B>Maximum Likelihood</B>')
C
        IF(MLFLAG)THEN
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5071)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5055)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5166)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)ALOC1
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5067)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)SCALE1
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5066)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)GAMMA1
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
CCCCC   WRITE(ICOUT,5041)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5043)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5068)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5047)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5049)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5051)VARML1
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5047)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5059)
CCCCC   CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5041)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5043)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5069)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5047)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5049)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5051)VARML2
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5047)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5059)
CCCCC   CALL DPWRST('XXX','WRIT')
C
CCCCC   WRITE(ICOUT,5041)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5043)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5070)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5047)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5049)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5051)COVML
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5047)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5059)
CCCCC   CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Generalized Extreme Value Parameter ',
     1       'Estimation (Maximum Case)}')
 8012 FORMAT(5X,'{',A1,'bf Generalized Extreme Value Parameter ',
     1       'Estimation (Minimum Case)}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.1)THEN
          WRITE(ICOUT,8012)IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8011)IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8121 FORMAT(5X,'{',A1,'bf Summary Statistics} & ',
     1       2X,A1,A1)
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean (All Data): & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Variance (All Data): & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Minimum: & ',
     1       G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Maximum: & ',
     1       G15.7,2X,A1,A1)
 8226 FORMAT(5X,'{',A1,'bf Method of L-Moments} & ',
     1       2X,A1,A1)
 8326 FORMAT(5X,'{',A1,'bf Elemental Percentile Method} & ',
     1       2X,A1,A1)
 8232 FORMAT(5X,'Unable To Compute The L-Moment Based Estimates: & ',
     1       2X,A1,A1)
 8222 FORMAT(5X,'First Sample L-Moment: & ',
     1       G15.7,2X,A1,A1)
 8223 FORMAT(5X,'Second Sample L-Moment: & ',
     1       G15.7,2X,A1,A1)
 8224 FORMAT(5X,'Third Sample L-Moment: & ',
     1       G15.7,2X,A1,A1)
 8027 FORMAT(5X,'Estimate of Gamma: & ',G15.7,2X,A1,A1)
 8028 FORMAT(5X,'Estimate of Scale: & ',G15.7,2X,A1,A1)
 8128 FORMAT(5X,'Estimate of Location: & ',G15.7,2X,A1,A1)
 8029 FORMAT(5X,'Variance of Gamma: & ',G15.7,2X,A1,A1)
 8030 FORMAT(5X,'Variance of Scale: & ',G15.7,2X,A1,A1)
 8031 FORMAT(5X,'Covariance of Gamma and Scale: & ',G15.7,2X,A1,A1)
 8032 FORMAT(5X,'{',A1,'bf Maximum Likelihood} & ',
     1       2X,A1,A1)
 8033 FORMAT(5X,'(Maximum Likelihood Estimates Do Not Exist & ',
     1       2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8041 FORMAT(5X,': & ',2X,A1,A1)
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XVAR,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8041)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8226)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8222)REAL(XMOM(1)),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8223)REAL(XMOM(2)),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8224)REAL(XMOM(3)),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(ASHALM.EQ.CPUMIN)THEN
          WRITE(ICOUT,8232)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8128)ALOCLM,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8028)ASCALM,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8027)ASHALM,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8041)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8326)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8128)ALOC2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)SCALE2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)GAMMA2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8041)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        IF(MLFLAG)THEN
          WRITE(ICOUT,8032)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8033)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8128)ALOC1,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8028)SCALE1,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8027)GAMMA1,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,8029)VARML1,IBASLC,IBASLC
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,8030)VARML2,IBASLC,IBASLC
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,8031)COVML,IBASLC,IBASLC
CCCCC     CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8049)IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{table}')
 8093 FORMAT(A1,'end{center}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(12X,'GENERALIZED EXTREME VALUE PARAMETER ESTIMATION:')
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.1)THEN
          WRITE(ICOUT,4216)
 4216     FORMAT(12X,'(MINIMUM CASE)')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4217)
 4217     FORMAT(12X,'(MAXIMUM CASE)')
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4220)
 4220   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)N
 4221   FORMAT('NUMBER OF OBSERVATIONS                     = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4222)XMEAN
 4222   FORMAT('SAMPLE MEAN                                = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)XVAR
 4223   FORMAT('SAMPLE VARIANCE                            = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4224)XMIN
 4224   FORMAT('SAMPLE MINIMUM                             = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)XMAX
 4225   FORMAT('SAMPLE MAXIMUM                             = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
 4233   FORMAT('ESTIMATE OF LOCATION                       = ',G15.7)
 4237   FORMAT('ESTIMATE OF SCALE                          = ',G15.7)
 4236   FORMAT('ESTIMATE OF GAMMA                          = ',G15.7)
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4250)
 4250   FORMAT('L-MOMENTS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4256)XMOM(1)
 4256   FORMAT('FIRST SAMPLE L-MOMENT                      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4257)XMOM(2)
 4257   FORMAT('SECOND SAMPLE L-MOMENT                     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4258)XMOM(3)
 4258   FORMAT('THIRD SAMPLE L-MOMENT                      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        IF(ASHALM.EQ.CPUMIN)THEN
          WRITE(ICOUT,4260)
 4260     FORMAT('UNABLE TO COMPUTE L-MOMENT BASED ESTIMATES')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4262)ALOCLM
 4262     FORMAT('ESTIMATE OF LOCATION                       = ',
     1           G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4264)ASCALM
 4264     FORMAT('ESTIMATE OF SCALE                          = ',
     1           G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4266)ASHALM
 4266     FORMAT('ESTIMATE OF SHAPE                          = ',
     1           G15.7)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4310)
 4310   FORMAT('ELEMENTAL PERCENTILE METHOD:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4233)ALOC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4237)SCALE2 
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4236)GAMMA2
        CALL DPWRST('XXX','WRIT')
C
        IF(MLFLAG)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4290)
 4290     FORMAT('MAXIMUM LIKELIHOOD:')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4233)ALOC1
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4237)SCALE1 
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4236)GAMMA1
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IF(MLFLAG)THEN
          WRITE(ICOUT,7011)
 7011     FORMAT('MAXIMUM LIKELIHOOD ESTIMATES WILL BE SAVED AS ',
     1           'INTERNAL PARAMETERS')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7012)
 7012     FORMAT('GAMMAML, SCALEML, AND LOCML.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7013)
 7013     FORMAT('MAXIMUM LIKELIHOOD PARAMETER VARIANCE-COVARIANCE ',
     1           'MATRIX WRITTEN TO DPST1F.DAT')
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        WRITE(ICOUT,7020)
 7020   FORMAT('METHOD OF L-MOMENT ESTIMATES WILL BE SAVED AS ',
     1         'INTERNAL PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7022)
 7022   FORMAT('GAMMALMO, SCALELMO, AND LOCLMOM.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7024)
 7024   FORMAT('ELEMENTAL PERCENTILE METHOD ESTIMATES WILL BE SAVED ',
     1         'AS INTERNAL PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7026)
 7026   FORMAT('GAMMAEPM, SCALEEPM, AND LOCEPM.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
C
      IF(MLFLAG)THEN
CCCCC   WRITE(IOUNI1,7051)
C7051   FORMAT(1X,'PARAMETER VARIANCE-COVARIANCE MATRIX FOR ',
CCCCC1  'GENERALIZED EXTREME VALUE MAXIMUM LIKELIHOOD ESTIMATION.')
CCCCC   WRITE(IOUNI1,7053)VARML1,COVML
CCCCC   WRITE(IOUNI1,7053)COVML,VARML2
C7053   FORMAT(1X,2E15.7)
      ENDIF
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLGV')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMLGV--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMLGX(Y,N,
     1XTEMP,MAXNXT,
     1GAMMA1,SCALE1,
     1ICAPSW,ICAPTY,DTEMP1,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
C              FOR THE GEOMETRIC EXTREME EXPONENTIAL DISTRIBUTION.
C              THE MAXIMUM LIKELIHOOD ESTIMATES ARE THE SOLUTION TO
C              THE FOLLOWING SIMULTANEOUS NONLINEAR EQUATIONS:
C              EQUATIONS.
C
C              N/G - 2*SUM[i=1 to N][EXP(-L*X(i)/(1-(1-G)*EXP(-L*X(i)))]
C
C              N/G - 2*SUM[i=1 to N][EXP(-L*X(i)/(1-(1-G)*EXP(-L*X(i)))]
C
C              WITH G AND L DENOTING THE SHAPE PARAMETER GAMMA AND
C              SCALE PARAMETER LAMBDA RESPECTIVELY.
C
C     EXAMPLE--GEOMETRIC EXTREME EXPONENTIAL MAXIMUM LIKELIHOOD Y
C     REFERENCE--"CAN DATA RECOGNIZE ITS PARENT DISTRIBUTION?",
C                MARSHALL, MEZA, AND OLKIN, JOURNAL OF COMPUTATIONAL
C                AND GRAPHICAL STATISTICS, SEPTEMBER, 2001,
C                PP. 555-580.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBUG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/3
C     ORIGINAL VERSION--MARCH     2004.
C     UPDATED         --AUGUST    2005. MODIFY OUTPUT OF FORMAT TO MAKE IT
C                                       MORE CONSISTENT WITH OTHER ML ROUTINES
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
      DOUBLE PRECISION DTEMP1(*)
C
      DOUBLE PRECISION TOL
      DOUBLE PRECISION XPAR(2)
      DOUBLE PRECISION FVEC(2)
C
      EXTERNAL GEEFUN
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='DPML'
      ISUBN2='GX  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGX')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLGX--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGX')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN GEOMETRIC EXTREME EXPONENTIAL ',
     1         'MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS LESS THAN 3')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN GEOMETRIC EXTREME EXPONENTIAL ',
     1       'MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
      DO1145I=1,N
        IF(Y(I).LE.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1147)
 1147     FORMAT('***** ERROR IN GENERALZIED EXTREME EXPONENTIAL ',
     1           'MAXIMUM LIKELIHOOD ESTIMATION')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1148)I,Y(I)
 1148     FORMAT('      ROW ',I8,' IS NON-POSITIVE (VALUE = ',G15.7,')')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
 1145 CONTINUE
C
C               ********************************************************
C               **  STEP 21--                                         **
C               **  CARRY OUT CALCULATIONS                            **
C               **  FOR GEOMETRIC EXTREME EXPONENTIAL MLE ESTIMATION  **
C               ********************************************************
C
 2100 CONTINUE
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGX')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
C
      XPAR(1)=DBLE(XMEAN)
      XPAR(2)=DBLE(XSD)
C
      IOPT=2
      TOL=1.0D-6
      NVAR=2
      NPRINT=-1
      INFO=0
      LWA=MAXNXT
      CALL DNSQE(GEEFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1           DTEMP1,MAXNXT,Y,N)
C
      GAMMA1=REAL(XPAR(1))
      SCALE1=REAL(XPAR(2))
C
C               ***********************************************
C               **   STEP 42--                               **
C               **   WRITE OUT EVERYTHING                    **
C               **   FOR GEOMETRIC   EXTREME EXPONENTIAL MLE **
C               **   ESTIMATION                              **
C               ***********************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLGX')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Geometric Extreme Exponential Parameter ',
     1         'Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=350>')
 5060   FORMAT('         Summary Statistics:')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Mean:')
 5063   FORMAT('         Sample Standard Deviation:')
 5064   FORMAT('         Sample Minimum:')
 5065   FORMAT('         Sample Maximum:')
 5066   FORMAT('         Maximum Likelihood Estimates:')
 5067   FORMAT('         Estimate of Gamma:')
 5068   FORMAT('         Estimate of Scale:')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMA1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALE1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Geometric Extreme Exponential ',
     1       'Parameter Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Summary Statistics: & ',2X,A1,A1)
 8022 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8023 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,' & ',2X,A1,A1)
 8028 FORMAT(5X,'Maximum Likelihood Estimates: & ',2X,A1,A1)
 8029 FORMAT(5X,'Estimate of Gamma: & ',G15.7,2X,A1,A1)
 8030 FORMAT(5X,'Estimate of Scale: & ',G15.7,2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)GAMMA1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)SCALE1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{table}')
 8093 FORMAT(A1,'end{center}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(12X,
     1  'GEOMETRIC EXTREME EXPONENTIAL PARAMETER ESTIMATION')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4220)
 4220   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)N
 4221   FORMAT('NUMBER OF OBSERVATIONS                   = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4222)XMEAN
 4222   FORMAT('SAMPLE MEAN                              = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)XSD  
 4223   FORMAT('SAMPLE STANDARD DEVIATION                = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)XMIN
 4225   FORMAT('SAMPLE MINIMUM                           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4227)XMAX
 4227   FORMAT('SAMPLE MAXIMUM                           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4230)
 4230   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4231)GAMMA1
 4231   FORMAT('ESTIMATE OF GAMMA                        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4233)SCALE1
 4233   FORMAT('ESTIMATE OF SCALE                        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4241)
 4241   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES WILL BE SAVED AS ',
     1         'INTERNAL PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4242)
 4242   FORMAT('GAMMAML, AND SCALEML.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLGX')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLGX--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLHE(Y,N,
     1YTEMP2,XTEMP2,TEMP1,TEMP2,ITEMP1,MAXNXT,
     1ALPHAM,BETAMO,ALPHML,BETAML,
     1ALPHEP,BETAEP,ALPHZF,BETAZF,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES AND METHOD OF MOMENT ESTIMATES FOR
C              THE HERMITE DISTRIBUTION.  FOUR METHODS OF ESTIMATION
C              ARE COMPUTED.
C
C              1. THE METHOD OF MOMENT ESTIMATES ARE THE SOLUTIONS
C                 TO THE EQUATIONS:
C                    ALPHA*(ALPHA+BETA)   - XMEAN = 0
C                    ALPHA*(2*ALPHA+BETA) - XVARI = 0
C                 WITH XMEAN AND XVARI DENOTING THE SAMPLE MEAN AND
C                 VARIANCE RESPECTIVELY.  AFTER SOME ALGEBRA, THIS
C                 CAN BE SOLVED AS:
C
C                    ALPHAHAT = SQRT(XVAR - XBAR)
C                    BETAHAT  = (XVAR/ALPHAHAT) - 2*ALPHAHAT
C
C              2. THE MAXIMUM LIKELIHOOD EQUATIONS ARE:
C                    SUM[n=0 to k][f(n)*{(n/ALPHA) - (ALPHA + BETA)}]
C                       = 0
C                    SUM[n=0 to k][f(n)*ALPHA*{(p(n-1)/p(n) - 1}] = 0
C                 WITH f(n) DENOTING THE SAMPLE FREQUENCIES FOR
C                 N = 0, 1, 2, ..., K   (K = MAXIMUM OBSERVED VALUE)
C                 AND P(n) = HERPDF.
C
C              3. THE EVEN POINT ESTIMATORS ARE
C
C                    AHAT=-0.5*LOG(2*SE/N - 1)
C                    BHAT=0.5*(XBAR - AHAT)
C
C                 WHERE
C
C                    XBAR = SAMPLE MEAN
C                    SE = SUM OF OBSEVED FREQUENCES AT X = 0, 2, ...
C                    ALPHAHAT = SQRT(2*BHAT)
C                    BETAHAT = AHAT/SQRT(2*BHAT)
C
C              4. THE ZEROTH FREQUENCY AND THE MEAN ESTIMATORS ARE
C
C                    AHAT = -(XBAR + 2*LOG(N0/N))
C                    BHAT = XBAR + LOG(N0/N)
C
C              DETAILS OF MAXIMIM LIKELIHOOD ESTIMATION ARE GIVEN
C              IN "SOME PROPERTIES OF THE HERMITE DISTRIBUTION",
C              KEMP AND KEMP, BIOMETRIKA (1965), 52, 3 and 4,
C              P. 381.  THE OTHER METHODS ARE DESCRIBED IN
C              "EVEN POINT ESTIMATION AND MOMENT ESTIMATION IN
C              HERMITE DISTRIBUTIONS", Y. C. PATEL, BIOMETRICS,
C              32, DECEMBER, 1976, PP. 865-873.  THE PATEL
C              ARTICLE ALSO GIVES THE VARIANCES AND COVARIANCES
C              FOR EACH OF THESE METHODS.
C     EXAMPLE--HERMITE MAXIMUM LIKELIHOOD Y
C     REFERENCE--"UNIVARIATE DISCRETE DISTRIBUTIONS", SECOND EDITION,
C                JOHNSON, KOTZ, AND KEMP, WILEY, PP. 202.
C              --"SOME PROPERTIES OF THE HERMITE DISTRIBUTION",
C                KEMP AND KEMP, BIOMETRIKA (1965), 52, 3 and 4,
C                P. 381.
C              --"EVEN POINT ESTIMATION AND MOMENT ESTIMATION IN
C                HERMITE DISTRIBUTIONS", Y. C. PATEL, BIOMETRICS,
C                32, DECEMBER, 1976, PP. 865-873.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/4
C     ORIGINAL VERSION--APRIL     2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IRELAT
      CHARACTER*4 IRHSTG
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*1 IBASLC
C
      REAL IAA
      REAL IAB
      REAL IBB
      REAL MOMCOV
      REAL MLCOV
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION DSUM3
      DOUBLE PRECISION DSE
      DOUBLE PRECISION DS0
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION YTEMP2(*)
      DIMENSION XTEMP2(*)
      DIMENSION TEMP1(*)
      DIMENSION TEMP2(*)
      DIMENSION ITEMP1(*)
C
      REAL AMLCOV(2,2)
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='DPML'
      ISUBN2='HE  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLHE')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLHE--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
       ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLHE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN HERMITE MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS NON-POSITIVE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** WARNING FROM HERMITE MAXIMUM ',
     1       'LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
 1139 CONTINUE
C
C               ******************************************
C               **  STEP 21--                           **
C               **  CARRY OUT CALCULATIONS              **
C               **  FOR HERMITE MLE ESTIMATE            **
C               ******************************************
C
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLHE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      IFLAG1=0
      IFLAG2=0
      IFLAG3=0
      IFLAG4=0
C
      DSE=0.0D0
      DSO=0.0D0
      DO2105I=1,N
        ITEMP=INT(Y(I)+0.5)
        IF(MOD(ITEMP,2).EQ.0)THEN
          DSE=DSE + 1.0D0
        ELSE
          DSO=DSO + 1.0D0
        ENDIF
        Y(I)=REAL(ITEMP)
 2105 CONTINUE
      IERROR='NO'
      IWRITE='OFF'
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
      IF(XMIN.LT.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2111)
 2111   FORMAT('***** ERROR FROM HERMITE MAXIMUM ',
     1         'LIKELIHOOD ESTIMATION--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2113)
 2113   FORMAT('      NEGATIVE VALUE ENCOUNTERED.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL VAR(Y,N,IWRITE,XVAR,IBUGA3,IERROR)
C
      TEMP=XVAR - XMEAN
      IF(TEMP.LE.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2121)
 2121   FORMAT('***** ERROR FROM HERMITE MAXIMUM LIKELIHOOD ',
     1         'ESTIMATION--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2123)
 2123   FORMAT('      MEAN IS GREATER THAN VARIANCE.  MOMENT AND ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2125)
 2125   FORMAT('      MAXIMUM LIKELIHOOD ESTIMATES DO NOT EXIST.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2127)
 2127   FORMAT('      HERMITE DISTRIBUTION NOT APPROPRIATE FOR ',
     1         'THESE DATA.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2129)XMEAN,XVAR
 2129   FORMAT('      MEAN = ',F14.7,' AND VARIANCE = ',F14.7)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      ALPHAM=SQRT(XVAR - XMEAN)
      BETAMO=(XVAR/ALPHAM) - 2.0*ALPHAM
      IF(BETAMO.LE.0.0)IFLAG1=1
      IF(IFLAG1.EQ.0)THEN
        AHAT=ALPHAM*BETAMO
        BHAT=ALPHAM**2/2.0
        AN=REAL(N)
        TERM1=(1.0/AN)*(AHAT + 2.0*(AHAT + 4.0*BHAT)**2)
        TERM2=(1.0/AN**2)*(2.0*AHAT - 2.0*(AHAT + 4.0*BHAT)**2)
        TERM3=(1.0/AN**3)*(AHAT + 16.0*BHAT)
        AMOVAR=TERM1 + TERM2 + TERM3
        TERM1=(1.0/AN)*(BHAT + 0.5*(AHAT + 4.0*BHAT)**2)
        TERM2=(1.0/AN**2)*(-4.0*BHAT - 0.5*(AHAT + 4.0*BHAT)**2)
        TERM3=(1.0/AN**3)*(0.25*AHAT + 4.0*BHAT)
        BMOVAR=TERM1 + TERM2 + TERM3
        TERM1=(1.0/AN)*(-1.0*(AHAT + 4.0*BHAT)**2)
        TERM2=(1.0/AN**2)*(-0.5*AHAT + 4.0*BHAT + (AHAT+4.0*BHAT)**2)
        TERM3=(1.0/AN**3)*(-0.5*AHAT - 8.0*BHAT)
        MOMCOV=TERM1 + TERM2 + TERM3
      ENDIF
C
C  EVEN POINT ESTIMATOR
C
C  NOTE: FORMULAS FOR VARIANCES, COVARIANCE IN PATEL ARTICLE
C        SEEM TO BE INCORRECT (I.E., PLUGGING AHAT AND BHAT INTO
C        HIS FORMULAS DOES NOT GIVE ANYTHING CLOSE TO HIS PRINTED
C        RESULTS, I SUSPECT EXP(4*A) TERM IS NOT ACCURATE).
C
      IF(DSE.GT.DSO)THEN
        AHAT=REAL(-0.5D0*DLOG(2.0D0*DSE/DBLE(N) - 1.0D0))
        BHAT=0.5*(XMEAN - AHAT)
        ALPHEP=SQRT(2.0*BHAT)
        BETAEP=AHAT/SQRT(2.0*BHAT)
CCCCC   AEPVAR=0.25*(EXP(4.0*AHAT) - 1.0)
CCCCC   BEPVAR=(1.0/16.0)*(EXP(4.0*AHAT) - 1.0 - 4.0*AHAT + 16.0*BHAT)
CCCCC   EPCOV=(1.0/8.0)*(4.0*AHAT - EXP(4.0*AHAT) + 1.0)
      ELSE
        IFLAG2=1
      ENDIF
C
C  BIN DATA FOR ZERO FREQUENCY AND MAXIMUM LIKELIHOOD ESTIMATES
C
      IRELAT='OFF'
      IRHSTG='OFF'
      XSTART=XMIN-0.5
      XSTOP=XMAX+0.5
      CLWID=1.0
      CALL DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
     1            YTEMP2,XTEMP2,N2,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C  ZERO FREQUENCY AND MEAN ESTIMATOR
C
      DO2160I=1,N2
        IF(XTEMP2(I).EQ.XMIN)THEN
          AN0=YTEMP2(I)
          GOTO2169
        ENDIF
 2160 CONTINUE
      IFLAG3=1
 2169 CONTINUE
C
      IF(IFLAG3.EQ.0)THEN
        AN=REAL(N)
        ALOWLM=-LOG(AN0/AN)
        AUPPLM=-2.0*LOG(AN0/AN)
        IF(XMEAN.GE.ALOWLM .AND. XMEAN.LE.AUPPLM)THEN
          ATEMP=LOG(AN0/AN)
          AHAT=-(XMEAN + 2.0*ATEMP)
          BHAT=XMEAN + ATEMP
          ALPHZF=SQRT(2.0*BHAT)
          BETAZF=AHAT/SQRT(2.0*BHAT)
          Z=EXP(AHAT+BHAT)
          AZFVAR=(1.0/AN)*(4.0*Z - 3.0*AHAT - 4.0*BHAT - 4.0)
          BZFVAR=(1.0/AN)*(Z - AHAT - 1.0)
          ZFCOV=(2.0/AN)*(Z - AHAT - BHAT - 1.0)
        ELSE
          IFLAG3=1
        ENDIF
      ENDIF
C
C  USE MOMENT ESTIMATORS AS INITIAL VALUES FOR MAXIMUM
C  LIKELIHOOD.  CALL DPBINI TO CREATE f(n) VALUES.
C
      BETAML=BETAMO
      IF(BETAML.LE.0.01)BETAML=0.3
      ALPHML=ALPHAM
      IF(ALPHML.LE.0.01)ALPHML=0.3
      MAXIT=100
      ITER=0
C
 2200 CONTINUE
      ITER=ITER+1
      IF(ITER.GT.MAXIT)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2201)
 2201   FORMAT('***** WARNING FROM HERMITE MAXIMUM LIKELIHOOD ',
     1         'ESTIMATION--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2203)
 2203   FORMAT('      MAXIMUM NUMBER OF ITERATIONS REACHED ',
     1         'WITHOUT CONVERGENCE.')
        CALL DPWRST('XXX','WRIT')
        GOTO2299
      ENDIF
C
      IAB=REAL(N)
      IF(ALPHML.GT.0.0)THEN
        IAA=REAL(N)*(1.0 + XMEAN/(ALPHML*ALPHML))
      ELSE
        IFLAG4=1
        GOTO2299
      ENDIF
C
      DSUM1=0.0D0
      DSUM2=0.0D0
      DSUM3=0.0D0
      ANMAX=XTEMP2(N2)
      DO2210I=1,N2
        AN=XTEMP2(I)
        FN=YTEMP2(I)
        CALL HERPDF(AN,ALPHML,BETAML,PDFN)
        AN2=AN-1
        IF(AN2.GE.0.0)THEN
          CALL HERPDF(AN2,ALPHML,BETAML,PDFNM1)
        ELSE
          PDFNM1=0.0
        ENDIF
        IF(PDFN.GT.0.0)THEN
          THETAN=(PDFNM1/PDFN) - 1.0
        ELSE
          THETAN=0.0
        ENDIF
        DSUM1=DSUM1 + DBLE(FN)*DBLE(THETAN)
        DSUM2=DSUM2 + DBLE(PDFN)*DBLE(THETAN)**2
 2210 CONTINUE
C
      SB=ALPHML*REAL(DSUM1)
      IBB=REAL(N)*ALPHML*ALPHML*REAL(DSUM2)
      BETANW=BETAML + (IAA*SB)/(IAA*IBB - IAB*IAB)
      ALPHML=(-BETANW + SQRT(BETANW*BETANW + 4.0*XMEAN))/2.0
C
C     CHECK FOR CONVERGENCE
C
      IF(ABS(BETANW - BETAML).GT.0.0001)THEN
        BETAML=BETANW
        GOTO2200
      ELSE
        BETAML=BETANW
      ENDIF
C
 2299 CONTINUE
C
      IF(IFLAG4.EQ.0)THEN
        AMLCOV(1,1)=IAA
        AMLCOV(2,2)=IBB
        AMLCOV(1,2)=IAB
        AMLCOV(2,1)=IAB
        MAXROM=2
        NR1=2
        CALL SGECO(AMLCOV,MAXROM,NR1,ITEMP1,RCOND,TEMP1)
        IJOB=1
        CALL SGEDI(AMLCOV,MAXROM,NR1,ITEMP1,TEMP1,TEMP2,IJOB)
        AMLVAR=AMLCOV(1,1)
        BMLVAR=AMLCOV(2,2)
        MLCOV=AMLCOV(1,2)
      ENDIF
C
C               ******************************************
C               **   STEP 42--                          **
C               **   WRITE OUT EVERYTHING               **
C               **   FOR HERMITE MLE ESTIMATE           **
C               ******************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLHE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>HERMITE  Parameter Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=250>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Mean:')
 5063   FORMAT('         Sample Minimum:')
 5064   FORMAT('         Sample Maximum:')
 5065   FORMAT('         Sample Variance:')
 5066   FORMAT('         <B>Method of Moments</B>')
 5067   FORMAT('         <B>Method of Even Points</B>')
 5068   FORMAT('         <B>Method of First Frequency and Mean</B>')
 5069   FORMAT('         <B>Method of Maximum Likelihood</B>')
 5071   FORMAT('         Estimate of Alpha:')
 5072   FORMAT('         Estimate of Beta:')
 5073   FORMAT('         Variance of Alpha:')
 5074   FORMAT('         Variance of Beta:')
 5075   FORMAT('         Covariance of Alpha and Beta:')
 5076   FORMAT('         Sample Even Sums:')
 5077   FORMAT('         Sample Odd Sums:')
 5078   FORMAT('         Sample First Frequency:')
 5081   FORMAT('         Computed Estimates are Inadmissable')
 5091   FORMAT('         Estimate of A:')
 5092   FORMAT('         Estimate of B:')
 5093   FORMAT('         Variance of A:')
 5094   FORMAT('         Variance of B:')
 5095   FORMAT('         Covariance of A and B:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XVAR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        IF(IFLAG1.EQ.1)THEN
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5081)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5055)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
        ELSE
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5071)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)ALPHAM
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5072)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)BETAMO
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          AHAT=ALPHAM*BETAMO
          BHAT=ALPHAM**2/2.0
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5091)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)AHAT
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5092)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)BHAT
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5093)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)AMOVAR
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5094)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)BMOVAR
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5095)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)MOMCOV
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
        ENDIF
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5076)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)REAL(DSE)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5077)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)REAL(DSO)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        IF(IFLAG1.EQ.1)THEN
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5081)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5055)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
        ELSE
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5071)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)ALPHEP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5072)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)BETAEP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          AHAT=ALPHEP*BETAEP
          BHAT=ALPHEP**2/2.0
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5091)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)AHAT
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5092)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)BHAT
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
        ENDIF
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5078)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AN0
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        IF(IFLAG3.EQ.1)THEN
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5081)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5055)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
        ELSE
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5071)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)ALPHZF
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5072)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)BETAZF
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          AHAT=ALPHZF*BETAZF
          BHAT=ALPHZF**2/2.0
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5091)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)AHAT
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5092)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)BHAT
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5093)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)AZFVAR
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5094)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)BZFVAR
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5095)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)ZFCOV
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
        ENDIF
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        IF(IFLAG4.EQ.1)THEN
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5081)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5055)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
        ELSE
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5071)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)ALPHML
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5072)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)BETAML
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          AHAT=ALPHML*BETAML
          BHAT=ALPHML**2/2.0
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5091)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)AHAT
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5092)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)BHAT
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5073)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)AMLVAR
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5074)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)BMLVAR
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5075)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)MLCOV
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
        ENDIF
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5097   FORMAT('</TABLE>')
 5098   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5097)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5098)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf HERMITE Parameter Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
C
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Sum of Even Points: & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,'Sum of Odd Points: & ',G15.7,2X,A1,A1)
 8028 FORMAT(5X,'Sample First Frequency: & ',G15.7,2X,A1,A1)
 8029 FORMAT(5X,'Computations Result in Inadmissable Estimates: & ',
     1       2X,A1,A1)
 8030 FORMAT(5X,'Maximum Likelihood Estimates Questionable: & ',
     1       2X,A1,A1)
C
 8031 FORMAT(5X,'{',A1,'bf Method of Moments}:  & ',2X,A1,A1)
 8032 FORMAT(5X,'{',A1,'bf Method of Even Points}:  & ',2X,A1,A1)
 8033 FORMAT(5X,'{',A1,'bf Method of First Frequency and Mean}:  & ',
     1       2X,A1,A1)
 8034 FORMAT(5X,'{',A1,'bf Method of Maximum Likelihood}:  & ',
     1       2X,A1,A1)
C
 8041 FORMAT(5X,'Estimate of $',A1,'alpha$: & ',G15.7,2X,A1,A1)
 8042 FORMAT(5X,'Estimate of $',A1,'beta$: & ',G15.7,2X,A1,A1)
 8043 FORMAT(5X,'Variance of $',A1,'alpha$: & ',G15.7,2X,A1,A1)
 8044 FORMAT(5X,'Variance of $',A1,'beta$: & ',G15.7,2X,A1,A1)
 8045 FORMAT(5X,'Covariance of $',A1,'alpha$ and $',A1,'beta$: & ',
     1       G15.7,2X,A1,A1)
 8051 FORMAT(5X,'Estimate of a: & ',G15.7,2X,A1,A1)
 8052 FORMAT(5X,'Estimate of b: & ',G15.7,2X,A1,A1)
 8053 FORMAT(5X,'Variance of a: & ',G15.7,2X,A1,A1)
 8054 FORMAT(5X,'Variance of b: & ',G15.7,2X,A1,A1)
 8055 FORMAT(5X,'Covariance of a and b: & ',G15.7,2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
C
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XVAR,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8031)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IFLAG1.EQ.0)THEN
          WRITE(ICOUT,8041)IBASLC,ALPHAM,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8042)IBASLC,BETAMO,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          AHAT=ALPHAM*BETAMO
          BHAT=ALPHAM**2/2.0
          WRITE(ICOUT,8051)AHAT,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8052)BHAT,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8053)AMOVAR,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8054)BMOVAR,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8055)MOMCOV,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8029)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,8032)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)REAL(DSE),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)REAL(DSO),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IFLAG2.EQ.0)THEN
          WRITE(ICOUT,8041)IBASLC,ALPHEP,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8042)IBASLC,BETAEP,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          AHAT=ALPHEP*BETAEP
          BHAT=ALPHEP**2/2.0
          WRITE(ICOUT,8051)AHAT,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8052)BHAT,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,8053)AEPVAR,IBASLC,IBASLC
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,8054)BEPVAR,IBASLC,IBASLC
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,8055)EPCOV,IBASLC,IBASLC
CCCCC     CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8029)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,8033)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)AN0,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IFLAG3.EQ.0)THEN
          WRITE(ICOUT,8041)IBASLC,ALPHZF,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8042)IBASLC,BETAZF,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          AHAT=ALPHZF*BETAZF
          BHAT=ALPHZF**2/2.0
          WRITE(ICOUT,8051)AHAT,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8052)BHAT,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8053)AZFVAR,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8054)BZFVAR,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8055)ZFCOV,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8029)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,8033)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IFLAG4.EQ.0)THEN
          WRITE(ICOUT,8041)IBASLC,ALPHML,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8042)IBASLC,BETAML,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          AHAT=ALPHML*BETAML
          BHAT=ALPHML**2/2.0
          WRITE(ICOUT,8051)AHAT,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8052)BHAT,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8043)IBASLC,AMLVAR,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8044)IBASLC,BMLVAR,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8045)IBASLC,IBASLC,MLCOV,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8030)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{center}')
 8093 FORMAT(A1,'end{table}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4301)
 4301   FORMAT(12X,'HERMITE PARAMETER ESTIMATION:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4303)N
 4303   FORMAT('NUMBER OF OBSERVATIONS                  = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4305)XMIN
 4305   FORMAT('SAMPLE MINIMUM                          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4307)XMAX
 4307   FORMAT('SAMPLE MAXIMUM                          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4308)XMEAN
 4308   FORMAT('SAMPLE MEAN                             = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4309)XVAR
 4309   FORMAT('SAMPLE VARIANCE                         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4311)
 4311   FORMAT('METHOD OF MOMENTS')
        CALL DPWRST('XXX','WRIT')
        IF(IFLAG1.EQ.0)THEN
          WRITE(ICOUT,4312)ALPHAM
 4312     FORMAT(6X,'ESTIMATE OF ALPHA                 = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4313)BETAMO
 4313     FORMAT(6X,'ESTIMATE OF BETA                  = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          AHAT=ALPHAM*BETAMO
          BHAT=ALPHAM**2/2.0
          WRITE(ICOUT,4314)AHAT
 4314     FORMAT(6X,'ESTIMATE OF A                     = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4315)BHAT
 4315     FORMAT(6X,'ESTIMATE OF B                     = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4316)AMOVAR
 4316     FORMAT(6X,'ESTIMATE OF VARIANCE OF A         = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4317)BMOVAR
 4317     FORMAT(6X,'ESTIMATE OF VARIANCE OF B         = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4318)MOMCOV
 4318     FORMAT(6X,'ESTIMATE OF COVARIANCE OF A AND B = ',G15.7)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4319)
 4319     FORMAT(6X,'INADMISSABLE ESTIMATES')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4321)
 4321   FORMAT('METHOD OF EVEN POINTS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4323)REAL(DSE)
 4323   FORMAT(6X,'SUM OF EVEN FREQUENCIES           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4324)REAL(DSO)
 4324   FORMAT(6X,'SUM OF ODD FREQUENCIES            = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        IF(IFLAG2.EQ.0)THEN
          WRITE(ICOUT,4312)ALPHEP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4313)BETAEP
          CALL DPWRST('XXX','WRIT')
          AHAT=ALPHEP*BETAEP
          BHAT=ALPHEP**2/2.0
          WRITE(ICOUT,4314)AHAT
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4315)BHAT
          CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,4316)AEPVAR
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,4317)BEPVAR
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,4318)EPCOV
CCCCC     CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4329)
 4329     FORMAT(6X,'INADMISSABLE ESTIMATES')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4331)
 4331   FORMAT('METHOD OF ZERO FREQUENCY AND MEAN')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4333)AN0
 4333   FORMAT(6X,'ZERO FREQUENCY                    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        IF(IFLAG3.EQ.0)THEN
          WRITE(ICOUT,4312)ALPHZF
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4313)BETAZF
          CALL DPWRST('XXX','WRIT')
          AHAT=ALPHZF*BETAZF
          BHAT=ALPHZF**2/2.0
          WRITE(ICOUT,4314)AHAT
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4315)BHAT
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4316)AZFVAR
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4317)BZFVAR
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4318)ZFCOV
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4339)
 4339     FORMAT(6X,'INADMISSABLE ESTIMATES')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4341)
 4341   FORMAT('METHOD OF MAXIMUM LIKELIHOOD')
        CALL DPWRST('XXX','WRIT')
        IF(IFLAG4.EQ.0)THEN
          WRITE(ICOUT,4312)ALPHML
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4313)BETAML
          CALL DPWRST('XXX','WRIT')
          AHAT=ALPHML*BETAML
          BHAT=ALPHML**2/2.0
          WRITE(ICOUT,4314)AHAT
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4315)BHAT
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4346)AMLVAR
 4346     FORMAT(6X,'ESTIMATE OF VARIANCE OF ALPHA     = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4347)BMLVAR
 4347     FORMAT(6X,'ESTIMATE OF VARIANCE OF BETA      = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4348)
 4348     FORMAT(6X,'ESTIMATE OF COVARIANCE OF ')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4349)MLCOV
 4349     FORMAT(6X,'ALPHA AND BETA                    = ',G15.7)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4351)
 4351     FORMAT(6X,'UNABLE TO COMPUTE ESTIMATES')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4361)
 4361   FORMAT('ALPHAMOM, BETAMOM, ALPHAML, BETAML, ALPHAZF, ',
     1         'BETAZF, ALPHAEP, AND BETAEP')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4363)
 4363   FORMAT('WILL BE SAVED AS INTERNAL PARAMETERS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLHE')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLHE--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLHY(Y,N,ITEMP1,ITEMP2,
     1XTEMP,MAXNXT,
     1ICAPSW,ICAPTY,IHYPTY,IOUNI1,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR HYPERGEOMETRIC DISTRIBUTION.
C              FOR THE HYPERGEOMETRIC DISTRIBUTION, WE HAVE:
C
C                 1) N  = TOTAL NUMBER OF ITEMS IN POPULATION
C                 2) n  = NUMBER OF ITEMS SAMPLED (STORED IN THE
C                         ITEMP1 ARRAY)
C                 3) K  = NUMBER OF DEFECTIVE ITEMS (OR SUCCESSES)
C                         IN POPULATION
C                 4) x  = NUMBER OF DEFECTIVES IN SAMPLE (STORED IN
C                         Y ARRAY)
C
C              THERE ARE TWO DISTINCT CASES:
C
C              GIVEN THAT N (THE POPULATION SIZE) IS KNOWN, WE
C              WANT TO ESTIMATE THE NUMBER OF DEFECTIVES IN
C              THE POPULATION GIVEN A SAMPLE OF SIZE n WITH x
C              DEFECTIVES.  AN EXAMPLE IS ACCEPTANCE SAMPLING
C              WHERE THE LOT SIZE IS KNOWN AND A SUBSAMPLE IS
C              CHOOSEN FOR INSPECTION.  IN THIS CASE, THE MAXIMUM
C              LIKELIHOOD ESTIMATE OF K IS:
C
C                   K = MAX INTEGER <= x*(N+1)/n
C
C              IN CAPTURE/RECAPTURE PROBLEMS, A SAMPLE IS TAKEN
C              AND MARKED.  THAT IS, K IS KNOWN.  THEN A SECOND
C              SAMPLE (OF SIZE n) IS TAKEN AND THE NUMBER OF MARKED
C              ITEMS (x) ARE COUNTED.  IN THIS CASE,
C              THE MAXIMUM LIKELIHOOD ESTIMATES ARE:
C
C                   N = MAX INTEGER <= n*K/x
C
C              WE IMPLEMENT THE REFINEMENT OF CHAPMAN (SEE
C              PAGE 263 OF JOHNSON, KOTZ, AND KEMP):
C
C                   N* = (n+1)*(K+1)/(x+1) - 1
C
C              FORMULAS FOR THE VARIANCE ARE ALSO GIVEN IN
C              JOHNSON, KOTZ, AND KEMP.
C         
C
C     EXAMPLE--HYPERGEOMETRIC MAXIMUM LIKELIHOOD NUMDEF NSAMP NPOP
C              HYPERGEOMETRIC MAXIMUM LIKELIHOOD NUMDEF NSAMP NK
C     REFERENCE--"UNIVARIATE DISCRETE DISTRIBUTIONS", SECOND EDITION,
C                JOHNSON, KOTZ, AND KEMP, WILEY, PP. 262-264.
C              --"STATISTICAL DISTRIBUTIONS", THIRD EDITION,
C                EVANS, HASTINGS, AND PEACOCK, WILEY, PP. 109-113.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/3
C     ORIGINAL VERSION--MARCH     2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IHYPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*1 IBASLC
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
      DIMENSION ITEMP1(*)
      DIMENSION ITEMP2(*)
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='DPML'
      ISUBN2='HY  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLHY')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLHY--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3,IHYPTY
   52   FORMAT('IBUGA3,IHYPTY = ',A4,1X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I),ITEMP1(I),ITEMP2(I)
   57     FORMAT('I,Y(I),ITEMP1(I) = ',I8,E15.7,2I8)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
       ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLHY')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN HYPERGEOMETRIC MAXIMUM ',
     1         'LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS NON-POSITIVE.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ********************************************
C               **  STEP 21--                             **
C               **  PRINT OUT PRELIMINARY INFORMATION     **
C               ********************************************
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Hypergeometric  Maximum Likelihood ',
     1         'Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
 5021   FORMAT('   <TR>')
 5023   FORMAT('      <TH ALIGN=CENTER VALIGN=BOTTOM WIDTH=150>')
 5027   FORMAT('      </TH>')
 5029   FORMAT('   </TR>')
 5031   FORMAT('         Number of<BR> Defectives<BR>in Sample')
 5032   FORMAT('         Number of<BR> Items<BR>in Sample')
 5033   FORMAT('         Number of<BR> Items<BR>in Population')
 5034   FORMAT('         Number of<BR> Defectives<BR>in Population')
 5035   FORMAT('         Maximum Likelihood<BR>Estimate of<BR>',
     1         'Defectives in Population')
 5036   FORMAT('         Maximum Likelihood<BR>Estimate of<BR>',
     1         'Population Size')
 5037   FORMAT('         Approximate<BR>Variance of<BR>',
     1         'Estimate')
 5038   FORMAT('      <TH COLSPAN=5>')
 5039   FORMAT('         <HR>')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5031)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5032)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        IF(IHYPTY.EQ.'ACCE')THEN
          WRITE(ICOUT,5023)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5033)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5027)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5023)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5035)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5027)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,5023)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5033)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5027)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5023)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5036)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5027)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5037)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5029)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5038)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Hypergeometric Maximum Likelihood ',
     1       'Estimate}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8021 FORMAT(5X,'Number of & Number of & Number of & ',
     1       'Maximum Likelihood & Approximate', 2X,A1,A1)
 8022 FORMAT(5X,'Defectives & Items & Items & ',
     1       'Estimate of & Variance of', 2X,A1,A1)
 8023 FORMAT(5X,'Defectives & Items & Items & ',
     1       'Estimate of & Variance of', 2X,A1,A1)
 8024 FORMAT(5X,'Defectives & Items & Defectives & ',
     1       'Estimate of', 2X,A1,A1)
 8025 FORMAT(5X,'In Sample & In Sample & In Population & ',
     1       'Defectives in Population & Estimate', 2X,A1,A1)
 8026 FORMAT(5X,'In Sample & In Sample & In Population & ',
     1       'Population Size & Estimate', 2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IHYPTY.EQ.'ACCE')THEN
          WRITE(ICOUT,8023)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8025)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8024)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8026)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4301)
 4301   FORMAT('HYPERGEOMETRIC MAXIMUM LIKELIHOOD ESTIMATION:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4311)
 4311   FORMAT('NUMBER OF      NUMBER OF     NUMBER OF    ',
     1         '   MAXIMUM LIKELIHOOD         APPROXIMATE')
        CALL DPWRST('XXX','WRIT')
        IF(IHYPTY.EQ.'ACCE')THEN
          WRITE(ICOUT,4313)
 4313   FORMAT('DEFECTIVES     ITEMS         ITEMS        ',
     1         '   ESTIMATE OF                VARIANCE OF')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4315)
 4315   FORMAT('IN SAMPLE      IN SAMPLE     IN POPULATION',
     1         '   DEFECTIVES IN POPULATION   ESTIMATE')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4323)
 4323   FORMAT('DEFECTIVES     ITEMS         DEFECTIVES   ',
     1         '   ESTIMATE OF                VARIANCE OF')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4325)
 4325   FORMAT('IN SAMPLE      IN SAMPLE     IN POPULATION',
     1         '   POPULATION SIZE            ESTIMATE')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,4331)
 4331   FORMAT('------------------------------------------',
     1         '-----------------------------------------')
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
C               ****************************************
C               **  STEP 41--                         **
C               **  CARRY OUT CALCULATIONS            **
C               **  FOR HYPERGEOMETRIC MLE ESTIMATE   **
C               ****************************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLHY')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
C
      DO1405I=1,N
        ITEMP=INT(Y(I)+0.5)
        Y(I)=REAL(ITEMP)
        IF(ITEMP.LT.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1411)
 1411     FORMAT('***** ERROR FROM HYPERGEOMETRIC MAXIMUM ',
     1           'LIKELIHOOD--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1413)
 1413     FORMAT('      NEGATIVE VALUE ENCOUNTERED FOR NUMBER OF ',
     1           'DEFECTIVES.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSEIF(ITEMP1(I).LT.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1421)
 1421     FORMAT('***** ERROR FROM HYPERGEOMETRIC MAXIMUM ',
     1           'LIKELIHOOD--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1423)
 1423     FORMAT('      NON-POSITIVE VALUE ENCOUNTERED IN SECOND ',
     1           'RESPONSE VARIABLE.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSEIF(ITEMP2(I).LT.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1431)
 1431     FORMAT('***** ERROR FROM HYPERGEOMETRIC MAXIMUM ',
     1           'LIKELIHOOD--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1433)
 1433     FORMAT('      NON-POSITIVE VALUE ENCOUNTERED IN THIRD ',
     1           'RESPONSE VARIABLE.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
 1405 CONTINUE
      IERROR='NO'
      IWRITE='OFF'
C
      IF(IHYPTY.EQ.'ACCE')THEN
        DO2010I=1,N
          IX=Y(I)
          NSAMP=ITEMP1(I)
          NPOP=ITEMP2(I)
          ANSAMP=REAL(NSAMP)
          ANPOP=REAL(NPOP)
          AX=REAL(IX)
          AK=AX*(ANPOP+1.0)/ANSAMP
          K=INT(AK)
          AK=REAL(K)
          AP=AK/ANPOP
          AVAR=(ANPOP+1.0)**2*(ANPOP-ANSAMP)*AP*(1.0-AP)/
     1         (ANSAMP*(ANPOP-1.0))
          IF(IPRINT.EQ.'ON')THEN
          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 4: DEFINE DATA ROW
C
 5041       FORMAT('   <TR>')
 5043       FORMAT('      <TD ALIGN=CENTER VALIGN=BOTTOM WIDTH=150>')
 5047       FORMAT('      </TD>')
 5053       FORMAT('         ',I8)
 5055       FORMAT('         ',E15.7)
 5059       FORMAT('   </TR>')
C
            WRITE(ICOUT,5041)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5043)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5053)IX
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5047)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5043)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5053)NSAMP
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5047)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5043)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5053)NPOP
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5047)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5043)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5053)K
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5047)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5043)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5055)AVAR
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5047)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5059)
            CALL DPWRST('XXX','WRIT')
C
          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
 8031       FORMAT(5X,I8,' & ',I8,' & ',I8,' & ',I8,' & ',G15.7,
     1             2X,A1,A1)
            WRITE(ICOUT,8031)IX,NSAMP,NPOP,K,AVAR,IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
          ELSE
            WRITE(ICOUT,4351)IX,NSAMP,NPOP,K,AVAR
            WRITE(IOUNI1,4352)IX,NSAMP,NPOP,K,AVAR
 4351       FORMAT(I8,5X,I8,9X,I8,10X,I8,12X,E15.7)
 4352       FORMAT(4(I8,2X),E15.7)
            CALL DPWRST('XXX','WRIT')
          ENDIF
          ENDIF
 2010   CONTINUE
      ELSE
        DO2610I=1,N
          IX=Y(I)
          NSAMP=ITEMP1(I)
          NK=ITEMP2(I)
          ANSAMP=REAL(NSAMP)
          AK=REAL(NK)
          AX=REAL(IX)
CCCCC     AN=REAL(NSAMP)*REAL(NK)/REAL(IX)
          AN=((ANSAMP+1.0)*(AK+1.0)/(AX+1.0)) - 1.0
          NPOP=INT(AN)
          AN=NPOP
          AM=ANSAMP*AK/AN
          TERM1=(AM**(-1) + 2.0*AM**(-2) + 6.0*AN**(-3))
          AVAR=AN**2*TERM1
          IF(IPRINT.EQ.'ON')THEN
          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 4: DEFINE DATA ROW
C
            WRITE(ICOUT,5041)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5043)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5053)IX
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5047)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5043)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5053)NSAMP
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5047)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5043)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5053)NK
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5047)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5043)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5053)NPOP
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5047)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5043)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5055)AVAR
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5047)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5059)
            CALL DPWRST('XXX','WRIT')
C
          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
            WRITE(ICOUT,8031)IX,NSAMP,NK,NPOP,AVAR,IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
          ELSE
            WRITE(ICOUT,4351)IX,NSAMP,NK,NPOP,AVAR
            CALL DPWRST('XXX','WRIT')
            WRITE(IOUNI1,4352)IX,NSAMP,NK,NPOP,AVAR
          ENDIF
          ENDIF
 2610   CONTINUE
      ENDIF
C
C               ******************************************
C               **   STEP 42--                          **
C               **   CLOSE OUT TABLES                   **
C               ******************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLHY')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{center}')
 8093 FORMAT(A1,'end{table}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLHY')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLHY--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLIG(Y,N,
     1XTEMP,MAXNXT,
     1GAMMA,XSCALE,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR INVERSE GAUSSIAN DISTRIBUTION
C     EXAMPLE--INVERSE GAUSSIAN MAXIMUM LIKELIHOOD Y
C     REFERENCE--XX
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/5
C     ORIGINAL VERSION--MAY       1998.
C     UPDATED         --DECEMBER  2003. SUPPORT HTML/LATEX OUTPUT
C     UPDATED         --AUGUST    2005. MODIFY THE OUTPUT FORMAT FOR
C                                       CONSISTECY WITH OTHER ML
C                                       ROUTINES
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      DOUBLE PRECISION DSUM
C
      CHARACTER*4 ICAPTY
      CHARACTER*4 ICAPSW
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IBASLC
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
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='DPML'
      ISUBN2='IG  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLIG')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLIG--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','BUG ')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','BUG ')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLIG')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN INVERSE GAUSSIAN MAXIMUM LIKELIHOOD ',
     1         'ESTIMATION.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1112)
 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE RESPONSE ',
     1         'VARIABLE IS LESS THAN OR EQUAL TO 1.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1113)N
 1113   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM INVERSE GAUSSIAN MAXIMUM ',
     1       'LIKELIHOOD ESTIMATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)HOLD
 1132 FORMAT('      RESPONSE VARIABLE HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1139 CONTINUE
C
 1290 CONTINUE
C
C               ****************************************
C               **  STEP 41--                         **
C               **  CARRY OUT CALCULATIONS            **
C               **  FOR INVERSE GAUSSIAN MLE ESTIMATE **
C               ****************************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLIG')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      DO4110I=1,N
        IF(Y(I).LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4111)
 4111     FORMAT('***** NOTE FROM INVERSE GAUSSIAN MAXIMUM ',
     1           'LIKELIHOOD ESTIMATION--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4113)
 4113     FORMAT('      NON-POSITIVE VALUE DETECTED.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
 4110 CONTINUE
C
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
C
      DSUM=0.0D0
      DO4120I=1,N
        DSUM=DSUM + (1.0D0/DBLE(Y(I)) - 1.0D0/DBLE(XMEAN))
 4120 CONTINUE
      GAMMA=REAL(DBLE(N)/DSUM)
      XSCALE=XMEAN
C
C               *******************************************
C               **   STEP 42--                           **
C               **   WRITE OUT EVERYTHING                **
C               **   FOR INVERSE GAUSSIAN MLE ESTIMATE   **
C               *******************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLIG')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Inverse Gaussian Parameter Estimation</b>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=350>')
 5045   FORMAT('         Number of Observations:')
 5061   FORMAT('         Sample Mean:')
 5062   FORMAT('         Sample Standard Deviation:')
 5063   FORMAT('         Sample Minimum:')
 5064   FORMAT('         Sample Maximum:')
 5065   FORMAT('         Estimate of Gamma Shape Parameter:')
 5066   FORMAT('         Estimate of Mu Shape Parameter:')
 5067   FORMAT('         Estimate of Gamma Shape Parameter:')
 5068   FORMAT('         Estimate of Mu Shape Parameter:')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5071   FORMAT('         Summary Statistics:')
 5073   FORMAT('         Maximum Likelihood Estimates:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5045)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5073)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMA
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSCALE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Inverse Gaussian Parameter Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8028 FORMAT(5X,'Estimate of $',A1,'gamma$ shape parameter: & ',
     1       G15.7,2X,A1,A1)
 8029 FORMAT(5X,'Estimate of $',A1,'mu$ shape parameter: & ',
     1       G15.7,2X,A1,A1)
 8030 FORMAT(5X,'Summary Statistics: & ',2X,A1,A1)
 8032 FORMAT(5X,'Maximum Likelihood Estimates: & ',2X,A1,A1)
 8033 FORMAT(5X,' & ',2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8033)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,GAMMA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)XSCALE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{table}')
 8093 FORMAT(A1,'end{center}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(12X,
     1  'INVERSE GAUSSIAN MAXIMUM LIKELIHOOD ESTIMATION:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4220)
 4220   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)N
 4221   FORMAT('NUMBER OF OBSERVATIONS                  = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4222)XMEAN
 4222   FORMAT('SAMPLE MEAN                             = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)XSD
 4223   FORMAT('SAMPLE STANDARD DEVIATION               = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4224)XMIN
 4224   FORMAT('SAMPLE MINIMUM                          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)XMAX
 4225   FORMAT('SAMPLE MAXIMUM                          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4240)
 4240   FORMAT('METHOD OF MAXIMUM LIKELIHOOD:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4241)GAMMA
 4241   FORMAT('ESTIMATE OF GAMMA SHAPE PARAMETER       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)XSCALE
 4243   FORMAT('ESTIMATE OF MU SHAPE PARAMETER          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4251)
 4251   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES WILL BE SAVED AS ',
     1         'INTERNAL PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4252)
 4252   FORMAT('GAMMAML, AND MUML.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLIG')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMLIG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMLJO(Y,N,
     1XTEMP,MAXNXT,
     1ALPHA1,ALPHA2,ALOC,SCALE,
     1Z,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE PARAMETER ESTIMATES FOR
C              THE JOHNSON SU/SB DISTRIBUTIONS USING THE PERCENTILE
C              METHOD OF SLIFKER AND SHAPIRO.
C     EXAMPLE--JOHNSON PERCENTILE Y
C     REFERENCE--JAMES F. SLIFKER AND SAMUEL S. SHAPIRO, "THE JOHNSON
C                SYSTEM: SELECTION AND PARAMETER ESTIMATION",
C                TECHNOMETRICS, VOL. 22, NO. 2, MAY 1980, PP. 239-246.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/4
C     ORIGINAL VERSION--APRIL     2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ITYPE
      CHARACTER*4 IQUAME
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*1 IBASLC
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
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='DPML'
      ISUBN2='JO  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLJO')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLJO--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLJO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN JOHNSON PERCENTILE ESTIMATION--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS NON-POSITIVE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN JOHNSON PERCENTILE ESTIMATION--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
C               **************************************
C               **  STEP 21--                       **
C               **  CARRY OUT CALCULATIONS          **
C               **  FOR JOHNSON PERCENTILE ESTIMATE **
C               **************************************
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLJO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      AN=N
C
CCCCC Z=0.524
      ZM=-Z
      Z3=3*Z
      Z3M=-3*Z
      CALL NORCDF(Z,PZ)
      CALL NORCDF(ZM,PZM)
      CALL NORCDF(Z3,PZ3)
      CALL NORCDF(Z3M,PZ3M)
C
CCCCC CALL SORT(Y,N,XTEMP)
C
      CALL QUANT(PZ,Y,N,IWRITE,XTEMP,MAXNXT,
     1IQUAME,
     1XZ,IBUGA3,IERROR)
      CALL QUANT(PZM,Y,N,IWRITE,XTEMP,MAXNXT,
     1IQUAME,
     1XZM,IBUGA3,IERROR)
      CALL QUANT(PZ3,Y,N,IWRITE,XTEMP,MAXNXT,
     1IQUAME,
     1XZ3,IBUGA3,IERROR)
      CALL QUANT(PZ3M,Y,N,IWRITE,XTEMP,MAXNXT,
     1IQUAME,
     1XZ3M,IBUGA3,IERROR)
C
      AM=XZ3 - XZ
      AN2=XZM - XZ3M
      AP=XZ  - XZM
      ACUT=AM*AN2/(AP*AP)
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLJO')THEN
        WRITE(ICOUT,2190)Z,ZM,Z3,Z3M
 2190   FORMAT('Z,ZM,Z3,Z3M = ',4G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2191)PZ,PZM,PZ3,PZ3M
 2191   FORMAT('PZ,PZM,PZ3,PZ3M = ',4G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2192)XZ,XZM,XZ3,XZ3M
 2192   FORMAT('XZ,XZM,XZ3,XZ3M = ',4G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2193)AM,AN2,AP,ACUT
 2193   FORMAT('AM,AN2,AP,ACUT = ',4G15.7)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      IF(ACUT.GE.0.99 .AND. ACUT.LE.1.01)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2201)
 2201   FORMAT('***** FROM JOHNSON PERCENTILE ESTIMATION--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2203)
 2203   FORMAT('      COMPUTATIONS SUGGEST THE LOGNORMAL DISTRIBUTION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2205)
 2205   FORMAT('      IS THE MOST APPROPRIATE MODEL.  NO JOHNSON ',
     1         'SB/SU ESTIMATION IS PERFORMED.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        ALPHA1=0.0
        ALPHA2=0.0
        ALOC=0.0
        SCALE=1.0
        GOTO9000
      ELSEIF(ACUT.GT.1.01)THEN
        ITYPE='SU'
        ANUM=2.0*Z
        TERM1=0.5*((AM/AP) + (AN2/AP))
        IF(TERM1.LT.1.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2211)
 2211     FORMAT('***** FROM JOHNSON PERCENTILE ESTIMATION--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2213)
 2213     FORMAT('      SQUARE ROOT OF A NEGATVE NUMBER ENCOUNTERED')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2215)
 2215     FORMAT('      IN COMPUTING ESTIMATE OF ALPHA2.  NO JOHNSON',
     1         'SB/SU ESTIMATION IS PERFORMED.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          ALPHA1=0.0
          ALPHA2=0.0
          ALOC=0.0
          SCALE=1.0
          GOTO9000
        ELSE
          ADENOM=ALOG(TERM1+SQRT(TERM1*TERM1-1.0))
        ENDIF
        ALPHA2=ANUM/ADENOM
C
        ANUM=(AN2/AP) - (AM/AP)
        TERM1=(AM/AP)*(AN2/AP) - 1.0
        IF(TERM1.LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2221)
 2221     FORMAT('***** FROM JOHNSON PERCENTILE ESTIMATION--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2223)
 2223     FORMAT('      SQUARE ROOT OF A NEGATVE NUMBER ENCOUNTERED')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2225)
 2225     FORMAT('      IN COMPUTING ESTIMATE OF ALPHA1.  NO JOHNSON',
     1         'SB/SU ESTIMATION IS PERFORMED.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2227)Z
 2227     FORMAT('      TRY ADJUSTING THE VALUE OF Z (CURRENTLY = ',
     1           G15.7,')')
          CALL DPWRST('XXX','WRIT')
          ALPHA1=0.0
          ALPHA2=0.0
          ALOC=0.0
          SCALE=1.0
          GOTO9000
        ELSE
          ADENOM=2.0*SQRT(TERM1)
        ENDIF
        TERM1=ANUM/ADENOM
        TERM2=ALOG(TERM1+SQRT(TERM1*TERM1+1.0))
        ALPHA1=ALPHA2*TERM2
C
        ANUM=2.0*AP*SQRT((AM/AP)*(AN2/AP) - 1.0)
        ADENOM=((AM/AP)+(AN2/AP)-2.0)*SQRT((AM/AP)+(AN2/AP)+2.0)
        SCALE=ANUM/ADENOM
C
        TERM1=(XZ + XZM)/2.0
        ANUM=AP*((AN2/AP) - (AM/AP))
        ADENOM=2.0*((AM/AP) + (AN2/AP) - 2.0)
        ALOC=TERM1 + (ANUM/ADENOM)
C
      ELSE
        ITYPE='SB'
        ANUM=Z
        TERM1=0.5*SQRT((1.0 + (AP/AM))*(1.0 + (AP/AN2)))
        IF(TERM1.LT.1.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2231)
 2231     FORMAT('***** FROM JOHNSON PERCENTILE ESTIMATION--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2233)
 2233     FORMAT('      SQUARE ROOT OF A NEGATVE NUMBER ENCOUNTERED')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2235)
 2235     FORMAT('      IN COMPUTING ESTIMATE OF ALPHA2.  NO JOHNSON',
     1         'SB/SU ESTIMATION IS PERFORMED.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2227)Z
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          ALPHA1=0.0
          ALPHA2=0.0
          ALOC=0.0
          SCALE=1.0
          GOTO9000
        ELSE
          ADENOM=ALOG(TERM1+SQRT(TERM1*TERM1-1.0))
        ENDIF
        ALPHA2=ANUM/ADENOM
C
        ANUM=(AP/AN2) - (AP/AM)
        ANUM=ANUM*SQRT((1.0 + (AP/AM))*(1.0 + (AP/AN2)) - 4.0)
        ADENOM=2.0*((AP/AM)*(AP/AN2) - 1.0)
        TERM1=ANUM/ADENOM
        TERM2=ALOG(TERM1+SQRT(TERM1*TERM1+1.0))
        ALPHA1=ALPHA2*TERM2
C
        TERM1=(1.0 + (AP/AM))*(1.0 + (AP/AN2) - 2.0)**2 - 4.0
        IF(TERM1.LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2241)
 2241     FORMAT('***** FROM JOHNSON PERCENTILE ESTIMATION--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2243)
 2243     FORMAT('      SQUARE ROOT OF A NEGATVE NUMBER ENCOUNTERED')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2245)
 2245     FORMAT('      IN COMPUTING ESTIMATE OF SCALE FOR JOHNSON ',
     1           'SB.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2247)
 2247     FORMAT('NO JOHNSON SB/SU ESTIMATION IS PERFORMED.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2227)Z
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          ALPHA1=0.0
          ALPHA2=0.0
          ALOC=0.0
          SCALE=1.0
          GOTO9000
        ELSE
          ANUM=AP*SQRT(TERM1 - 4.0)
        ENDIF
        ADENOM=((AP/AM)*(AP/AN2) - 1.0)
        SCALE=ANUM/ADENOM
C
        TERM1=(XZ + XZM)/2.0
        TERM2=SCALE/2.0
        ANUM=AP*((AP/AN2) - (AP/AM))
        ADENOM=2.0*((AP/AM)*(AP/AN2) - 1.0)
        IF(ADENOM.EQ.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2251)
 2251     FORMAT('***** FROM JOHNSON PERCENTILE ESTIMATION--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2253)
 2253     FORMAT('      DIVISION BY ZERO ENCOUNTERED IN COMPUTING')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2255)
 2255     FORMAT('      ESTIMATE OF LOCATION FOR JOHNSON SB.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2257)
 2257     FORMAT('NO JOHNSON SB/SU ESTIMATION IS PERFORMED.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2227)Z
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          ALPHA1=0.0
          ALPHA2=0.0
          ALOC=0.0
          SCALE=1.0
          GOTO9000
        ELSE
          ALOC=TERM1 - TERM2 + (ANUM/ADENOM)
        ENDIF
C
      ENDIF
C
C               *********************************
C               **   STEP 42--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR NORMAL MLE ESTIMATE   **
C               **********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLJO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Johnson SB/SU Percentile Estimation')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=250>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Mean:')
 5063   FORMAT('         Sample Standard Deviation:')
 5064   FORMAT('         z Value Used:')
 5065   FORMAT('         P<sub>z</sub> = NORCDF(z):')
 5066   FORMAT('         P<sub>-z</sub> = NORCDF(-z):')
 5067   FORMAT('         P<sub>3z</sub> = NORCDF(3z):')
 5068   FORMAT('         P<sub>-3z</sub> = NORCDF(-3z):')
 5069   FORMAT('         X<sub>z</sub> = Quantile of 0.5 + ',
     1         'P<sub>z</sub>/N:')
 5070   FORMAT('         X<sub>-z</sub> = Quantile of 0.5 + ',
     1         'P<sub>-z</sub>/N:')
 5071   FORMAT('         X<sub>3z</sub> = Quantile of 0.5 + ',
     1         'P<sub>3z</sub>/N:')
 5072   FORMAT('         X<sub>-3z</sub> = Quantile of 0.5 + ',
     1         'P<sub>-3z</sub>/N:')
 5073   FORMAT('         <i>m</i> = X<sub>3z</sub> - X<sub>z</sub>:')
 5074   FORMAT('         <i>n</i> = X<sub>-z</sub> - X<sub>3z</sub>:')
 5075   FORMAT('         <i>p</i> = X<sub>z</sub> - X<sub>-z</sub>:')
 5076   FORMAT('         <i>mn/p<sup>2</sup>:')
 5077   FORMAT('         <b><i>mn/p<sup>2</sup> > 1 implies a ',
     1         'Johnson SU Distribution</b>')
 5078   FORMAT('         <b><i>mn/p<sup>2</sup> < 1 implies a ',
     1         'Johnson SB Distribution</b>')
 5079   FORMAT('         Estimate of alpha<sub>1</sub>:')
 5080   FORMAT('         Estimate of alpha<sub>2</sub>:')
 5081   FORMAT('         Estimate of Location:')
 5082   FORMAT('         Estimate of Scale:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)Z
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)PZ
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)PZM
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)PZ3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)PZ3M
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XZ
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5070)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XZM
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XZ3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5072)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XZ3M
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5073)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AM
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5074)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AN2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5075)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5076)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ACUT
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        IF(ACUT.GT.1.0)THEN
          WRITE(ICOUT,5077)
        ELSE
          WRITE(ICOUT,5078)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5079)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALPHA1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5080)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALPHA2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5081)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALOC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5082)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Normal Maximum Likelihood Estimate}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Standard Deviation: & ',
     1       G15.7,2X,A1,A1)
 8024 FORMAT(5X,'z Value Used: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'$P_{z}$ = NORCDF($z$): & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'$P_{-z}$ = NORCDF($-z$): & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,'$P_{3z}$ = NORCDF($3z$): & ',G15.7,2X,A1,A1)
 8028 FORMAT(5X,'$P_{-3z}$ = NORCDF($-3z$): & ',G15.7,2X,A1,A1)
 8029 FORMAT(5X,'$X_{z}$ = Quantile of 0.5 + $P_{z}/N$: & ',
     1       G15.7,2X,A1,A1)
 8030 FORMAT(5X,'$X_{-z}$ = Quantile of 0.5 + $P_{z}/N$: & ',
     1       G15.7,2X,A1,A1)
 8031 FORMAT(5X,'$X_{3z}$ = Quantile of 0.5 + $P_{z}/N$: & ',
     1       G15.7,2X,A1,A1)
 8032 FORMAT(5X,'$X_{-3z}$ = Quantile of 0.5 + $P_{z}/N$: & ',
     1       G15.7,2X,A1,A1)
 8033 FORMAT(5X,'$m = X_{3z} - X_{z}$: & ',G15.7,2X,A1,A1)
 8034 FORMAT(5X,'$n = X_{-z} - X_{3z}$: & ',G15.7,2X,A1,A1)
 8035 FORMAT(5X,'$p = X_{z} - X_{-z}$: & ',G15.7,2X,A1,A1)
 8036 FORMAT(5X,'$mn/p^{2}$: & ',G15.7,2X,A1,A1)
 8037 FORMAT(5X,'$mn/p^{2} > 1$: Implies a Johnson SU Distribution & ',
     1       2X,A1,A1)
 8038 FORMAT(5X,'$mn/p^{2} < 1$: Implies a Johnson SB Distribution & ',
     1       2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8041 FORMAT(5X,'Estimate of $',A1,'alpha_{1}: & ',G15.7,2X,A1,A1)
 8042 FORMAT(5X,'Estimate of $',A1,'alpha_{2}: & ',G15.7,2X,A1,A1)
 8043 FORMAT(5X,'Estimate of Location: & ',G15.7,2X,A1,A1)
 8044 FORMAT(5X,'Estimate of Scale: & ',G15.7,2X,A1,A1)
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)Z,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)PZ,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)PZM,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)PZ3,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)PZ3M,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)XZ,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)XZM,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)XZ3,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)XZ3M,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8033)AM,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8034)AN2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8035)AP,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8036)ACUT,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(ACUT.GT.1.0)THEN
          WRITE(ICOUT,8037)IBASLC,IBASLC
        ELSE
          WRITE(ICOUT,8038)IBASLC,IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8041)IBASLC,ALPHA1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8042)IBASLC,ALPHA2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC,ALOC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8044)IBASLC,SCALE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{center}')
 8093 FORMAT(A1,'end{table}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4201)
 4201   FORMAT(15X,'JOHNSON PERCENTILE ESTIMATION:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4203)N
 4203   FORMAT('NUMBER OF OBSERVATIONS              = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4205)XMEAN
 4205   FORMAT('SAMPLE MEAN                         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4207)XSD
 4207   FORMAT('SAMPLE STANDARD DEVIATION           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4211)Z
 4211   FORMAT('VALUE OF Z                          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4213)PZ
 4213   FORMAT('PZ = NORCDF(Z)                      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4215)PZM
 4215   FORMAT('PZM = NORCDF(-Z)                    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4217)PZ3
 4217   FORMAT('PZ3 = NORCDF(3*Z)                   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4219)PZ3M
 4219   FORMAT('PZ3M = NORCDF(-3*Z)                 = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4221)XZ
 4221   FORMAT('XZ = QUANTILE(0.5 + PZ/N)           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)XZM
 4223   FORMAT('XZM = QUANTILE(0.5 + PZM/N)         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)XZ3
 4225   FORMAT('XZ3 = QUANTILE(0.5 + PZ3/N)         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4227)XZ3M
 4227   FORMAT('XZ3M = QUANTILE(0.5 + PZ3M/N)       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4231)AM
 4231   FORMAT('M = XZ3 - XZ                        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4233)AN2
 4233   FORMAT('N = XZM - XZ3                       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4235)AP
 4235   FORMAT('P = XZ - XZM                        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(ACUT.GT.1.0)THEN
          WRITE(ICOUT,4241)ACUT
 4241     FORMAT('M*N/P^2 = ',G15.7,' > 1 IMPLIES JOHNSON SU ',
     1           'DISTRIBUTION')
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ACUT.LT.1.0)THEN
          WRITE(ICOUT,4243)ACUT
 4243     FORMAT('M*N/P^2 = ',G15.7,' < 1 IMPLIES JOHNSON SB ',
     1           'DISTRIBUTION')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4251)ALPHA1
 4251   FORMAT('ESTIMATE OF ALPHA1                  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4253)ALPHA2
 4253   FORMAT('ESTIMATE OF ALPHA2                  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4255)ALOC
 4255   FORMAT('ESTIMATE OF LOCATION                = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4257)SCALE
 4257   FORMAT('ESTIMATE OF SCALE                   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4291)
 4291   FORMAT('ALPHA1PE, ALPHA2PE, LOCPERC, AND SCALEPER ',
     1         'WILL BE SAVED AS INTERNAL PARAMETERS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLJO')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMLJO--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMLLO(Y,N,
     1XTEMP,MAXNXT,
     1ALOC,ASCALE,
     1ICAPSW,ICAPTY,DTEMP1,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR LOGISTIC DISTRIBUTION
C     EXAMPLE--LOGISTIC MAXIMUM LIKELIHOOD Y
C     REFERENCE--CHARLES ANTLE, LAWRENCE KLIMKO, AND WILLIAM
C                HARKNESS, (1970), "CONFIDENCE INTERVALS FOR THE
C                PARAMETERS OF THE LOGISTIC DISTRIBUTION", BIOMETRIKA,
C                PP. 397-402.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003/10
C     ORIGINAL VERSION--OCTOBER   2003.
C     UPDATED         --JANUARY   2005. MODIFY THE OUTPUT FORMAT
C                                       TO MAKE MORE CONSISTENT
C                                       WITH OTHER DISTRIBUTIONS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
      DOUBLE PRECISION DTEMP1(*)
C
      DOUBLE PRECISION TOL
      DOUBLE PRECISION XPAR(2)
      DOUBLE PRECISION FVEC(2)
C
      DIMENSION ATABLE(6,5)
      DIMENSION BTABLE(5,10)
C
      EXTERNAL LOGFUN
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
      DATA PI/3.14159265358979/
C
      DATA (ATABLE(1,J),J=1,5)/6.3,12.8,25.7,32.2,64.4/
      DATA (ATABLE(2,J),J=1,5)/2.9,4.0,5.0,5.4,6.7/
      DATA (ATABLE(3,J),J=1,5)/2.50,3.29,4.07,4.30,5.06/
      DATA (ATABLE(4,J),J=1,5)/2.34,3.06,3.67,3.87,4.45/
      DATA (ATABLE(5,J),J=1,5)/2.25,2.93,3.54,3.70,4.19/
      DATA (ATABLE(6,J),J=1,5)/2.22,2.85,3.40,3.56,4.03/
C
      DATA (BTABLE(I,1),I=1,5)/0.01,0.24,0.436,0.588,0.707/
      DATA (BTABLE(I,2),I=1,5)/0.02,0.29,0.475,0.623,0.739/
      DATA (BTABLE(I,3),I=1,5)/0.024,0.304,0.492,0.640,0.749/
      DATA (BTABLE(I,4),I=1,5)/0.049,0.367,0.551,0.689,0.781/
      DATA (BTABLE(I,5),I=1,5)/0.098,0.454,0.626,0.745,0.821/
      DATA (BTABLE(I,6),I=1,5)/1.36,1.36,1.28,1.21,1.15/
      DATA (BTABLE(I,7),I=1,5)/1.66,1.53,1.45,1.29,1.21/
      DATA (BTABLE(I,8),I=1,5)/1.94,1.66,1.52,1.36,1.26/
      DATA (BTABLE(I,9),I=1,5)/2.03,1.75,1.55,1.38,1.27/
      DATA (BTABLE(I,10),I=1,5)/2.3,2.0,1.65,1.45,1.32/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='LO  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLO')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLLO--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,N
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLLO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN LOGISTIC MAXIMUM LIKELIHOOD ESTIMATION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)
 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE RESPONSE ',
     1         'VARIABLE IS LESS THAN OR EQUAL TO ONE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
      IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM LOGISTIC MAXIMUM LIKELIHOOD--RESPONSE ',
     1'VARIABLE HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
 1290 CONTINUE
C
C               ********************************
C               **  STEP 41--                 **
C               **  CARRY OUT CALCULATIONS    **
C               **  FOR LOGISTIC MLE ESTIMATE **
C               ********************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
      IERROR='NO'
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL SORT(Y,N,Y)
      XMIN=Y(1)
      XMAX=Y(N)
      XPAR(1)=DBLE(XMEAN)
      XPAR(2)=DBLE((SQRT(3.0)/PI)*XSD)
C
      IOPT=2
      TOL=1.0D-6
      NVAR=2
      NPRINT=-1
      INFO=0
      LWA=MAXNXT
      CALL DNSQE(LOGFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1           DTEMP1,MAXNXT,Y,N)
C
      ALOC=REAL(XPAR(1))
      ASCALE=REAL(XPAR(2))
C
C               ***********************************************
C               **  STEP 41B-                                **
C               **  COMPUTE 90% AND 95% CONFIDENCE INTERVALS **
C               **  USING METHOD GIVEN IN ANTLE PAPER        **
C               ***********************************************
C
      AN=REAL(N)
      IF(N.EQ.2)THEN
        A1=ATABLE(1,2)
        A2=ATABLE(1,3)
      ELSEIF(N.GE.3 .AND. N.LE.4)THEN
        AFACT=REAL(N-2)/REAL(5-2)
        A1=ATABLE(2,2) - AFACT*ABS(ATABLE(2,2)-ATABLE(1,2))
        A2=ATABLE(2,3) - AFACT*ABS(ATABLE(2,3)-ATABLE(1,3))
      ELSEIF(N.EQ.5)THEN
        A1=ATABLE(2,2)
        A2=ATABLE(2,3)
      ELSEIF(N.GE.6 .AND. N.LE.9)THEN
        AFACT=REAL(N-5)/REAL(10-5)
        A1=ATABLE(3,2) - AFACT*ABS(ATABLE(3,2)-ATABLE(2,2))
        A2=ATABLE(3,3) - AFACT*ABS(ATABLE(3,3)-ATABLE(2,3))
      ELSEIF(N.EQ.10)THEN
        A1=ATABLE(3,2)
        A2=ATABLE(3,3)
      ELSEIF(N.GE.11 .AND. N.LE.19)THEN
        AFACT=REAL(N-10)/REAL(20-10)
        A1=ATABLE(4,2) - AFACT*ABS(ATABLE(4,2)-ATABLE(3,2))
        A2=ATABLE(4,3) - AFACT*ABS(ATABLE(4,3)-ATABLE(3,3))
      ELSEIF(N.EQ.20)THEN
        A1=ATABLE(4,2)
        A2=ATABLE(4,3)
      ELSEIF(N.GE.21 .AND. N.LE.39)THEN
        AFACT=REAL(N-20)/REAL(40-20)
        A1=ATABLE(5,2) - AFACT*ABS(ATABLE(5,2)-ATABLE(4,2))
        A2=ATABLE(5,3) - AFACT*ABS(ATABLE(5,3)-ATABLE(4,3))
      ELSEIF(N.EQ.40)THEN
        A1=ATABLE(5,2)
        A2=ATABLE(5,3)
      ELSEIF(N.GT.40)THEN
        A1=ATABLE(6,2)
        A2=ATABLE(6,3)
      ENDIF
      ALOW90=ALOC - A1*ASCALE/SQRT(AN)
      AHIG90=ALOC + A1*ASCALE/SQRT(AN)
      ALOW95=ALOC - A2*ASCALE/SQRT(AN)
      AHIG95=ALOC + A2*ASCALE/SQRT(AN)
C
      IF(N.EQ.2)THEN
        B1=BTABLE(1,4)
        B2=BTABLE(1,7)
        B3=BTABLE(1,3)
        B4=BTABLE(1,8)
      ELSEIF(N.GE.3 .AND. N.LE.4)THEN
        AFACT=REAL(N-2)/REAL(5-2)
        B1=BTABLE(1,4) + AFACT*ABS(BTABLE(2,4)-BTABLE(1,4))
        B2=BTABLE(1,7) + AFACT*ABS(BTABLE(2,7)-BTABLE(1,7))
        B3=BTABLE(1,3) + AFACT*ABS(BTABLE(2,3)-BTABLE(1,3))
        B4=BTABLE(1,8) + AFACT*ABS(BTABLE(2,8)-BTABLE(1,8))
      ELSEIF(N.EQ.5)THEN
        B1=BTABLE(2,4)
        B2=BTABLE(2,7)
        B3=BTABLE(2,3)
        B4=BTABLE(2,8)
      ELSEIF(N.GE.6 .AND. N.LE.9)THEN
        AFACT=REAL(N-5)/REAL(10-5)
        B1=BTABLE(2,4) + AFACT*ABS(BTABLE(3,4)-BTABLE(2,4))
        B2=BTABLE(2,7) + AFACT*ABS(BTABLE(3,7)-BTABLE(2,7))
        B3=BTABLE(2,3) + AFACT*ABS(BTABLE(3,3)-BTABLE(2,3))
        B4=BTABLE(2,8) + AFACT*ABS(BTABLE(3,8)-BTABLE(2,8))
      ELSEIF(N.EQ.10)THEN
        B1=BTABLE(3,4)
        B2=BTABLE(3,7)
        B3=BTABLE(3,3)
        B4=BTABLE(3,8)
      ELSEIF(N.GE.11 .AND. N.LE.19)THEN
        AFACT=REAL(N-10)/REAL(20-10)
        B1=BTABLE(3,4) + AFACT*ABS(BTABLE(4,4)-BTABLE(3,4))
        B2=BTABLE(3,7) + AFACT*ABS(BTABLE(4,7)-BTABLE(3,7))
        B3=BTABLE(3,3) + AFACT*ABS(BTABLE(4,3)-BTABLE(3,3))
        B4=BTABLE(3,8) + AFACT*ABS(BTABLE(4,8)-BTABLE(3,8))
      ELSEIF(N.EQ.20)THEN
        B1=BTABLE(4,4)
        B2=BTABLE(4,7)
        B3=BTABLE(4,3)
        B4=BTABLE(4,8)
      ELSEIF(N.GE.21 .AND. N.LE.39)THEN
        AFACT=REAL(N-20)/REAL(40-20)
        B1=BTABLE(4,4) + AFACT*ABS(BTABLE(5,4)-BTABLE(4,4))
        B2=BTABLE(4,7) + AFACT*ABS(BTABLE(5,7)-BTABLE(4,7))
        B3=BTABLE(4,3) + AFACT*ABS(BTABLE(5,3)-BTABLE(4,3))
        B4=BTABLE(4,8) + AFACT*ABS(BTABLE(5,8)-BTABLE(4,8))
      ELSEIF(N.GE.40)THEN
        B1=BTABLE(5,4)
        B2=BTABLE(5,7)
        B3=BTABLE(5,3)
        B4=BTABLE(5,8)
      ENDIF
      BLOW90=ASCALE/B2
      BHIG90=ASCALE/B1
      BLOW95=ASCALE/B4
      BHIG95=ASCALE/B3
C
C               *********************************
C               **   STEP 42--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR LOGISTIC MLE ESTIMATE **
C               **********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLLO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5016   FORMAT('      <B>Logistic Maximum Likelihood Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5016)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=350>')
 5045   FORMAT('         Number of Observations:')
 5061   FORMAT('         Sample Mean:')
 5062   FORMAT('         Sample Standard Deviation:')
 5063   FORMAT('         Sample Minimum:')
 5064   FORMAT('         Sample Maximum:')
 5065   FORMAT('         Maximum Likelihood Estimate of Location:')
 5066   FORMAT('         Maximum Likelihood Estimate of Scale:')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5059   FORMAT('   </TR>')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5045)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALOC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ASCALE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Limits for the Location ',
     1         'Parameter</B>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5134   FORMAT('         &nbsp;')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=3>')
 5162   FORMAT('          <HR>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        ATEMP=90.0
        WRITE(ICOUT,5141)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)ATEMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)ALOW90
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)AHIG90
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5159)
        CALL DPWRST('XXX','WRIT')
C
        ATEMP=95.0
        WRITE(ICOUT,5141)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)ATEMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)ALOW95
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)AHIG95
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5159)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5217   FORMAT('      <B>Confidence Limits for the Scale ',
     1         'Parameter</B>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5217)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
        ATEMP=90.0
        WRITE(ICOUT,5141)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)ATEMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)BLOW90
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)BHIG90
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5159)
        CALL DPWRST('XXX','WRIT')
C
        ATEMP=95.0
        WRITE(ICOUT,5141)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)ATEMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)BLOW95
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5149)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)BHIG95
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5159)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5199   FORMAT('<PRE>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5199)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Logistic Maximum Likelihood Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Maximum Likelihood Estimate of Location Parameter: ',
     1       '& ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,'Maximum Likelihood Estimate of Scale Parameter: & ',
     1       G15.7,2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)ALOC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)ASCALE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8093 FORMAT(A1,'end{center}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for Location Parameter}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8111)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper ',2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit',2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,2X,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        ATEMP=90.0
        WRITE(ICOUT,8131)ATEMP,ALOW90,AHIG90,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        ATEMP=95.0
        WRITE(ICOUT,8131)ATEMP,ALOW95,AHIG95,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8191   FORMAT(A1,'end{table}')
 8193   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8211 FORMAT(5X,'{',A1,'bf Confidence Limits for Scale Parameter}')
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8211)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        ATEMP=90.0
        WRITE(ICOUT,8131)ATEMP,BLOW90,BHIG90,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        ATEMP=95.0
        WRITE(ICOUT,8131)ATEMP,BLOW95,BHIG95,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8191)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8899)IBASLC
 8899   FORMAT(A1,'begin{verbatim}')
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4111)
 4111   FORMAT(10X,'LOGISTIC MAXIMUM LIKELIHOOD ESTIMATION:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4122)N
 4122   FORMAT(
     1  'NUMBER OF OBSERVATIONS                             = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4123)XMEAN
 4123   FORMAT(
     1  'SAMPLE MEAN                                        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4125)XSD
 4125   FORMAT(
     1  'SAMPLE STANDARD DEVIATION                          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4127)XMIN
 4127   FORMAT(
     1  'SAMPLE MINIMUM                                     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4129)XMAX
 4129   FORMAT(
     1  'SAMPLE MAXIMUM                                     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4131)ALOC
 4131   FORMAT(
     1  'MAXIMUM LIKELIHOOD ESTIMATE OF LOCATION PARAMETER  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4133)ASCALE
 4133   FORMAT(
     1  'SCALE PARAMETER SCALE                              = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4640)
 4640   FORMAT('CONFIDENCE INTERVAL FOR LOCATION PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4643)
 4643   FORMAT('   CONFIDENCE           LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4645)
 4645   FORMAT('   VALUE (%)            LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4646)
 4646   FORMAT('-------------------------------------------')
        CALL DPWRST('XXX','WRIT')
C
        ATEMP=90.0
        WRITE(ICOUT,4647)ATEMP,ALOW90,AHIG90
 4647   FORMAT('   ',F8.3,10X,G12.6,2X,G12.6)
        CALL DPWRST('XXX','WRIT')
        ATEMP=95.0
        WRITE(ICOUT,4647)ATEMP,ALOW95,AHIG95
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4680)
 4680   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4643)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4645)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4646)
        CALL DPWRST('XXX','WRIT')
C
        ATEMP=90.0
        WRITE(ICOUT,4647)ATEMP,BLOW90,BHIG90
        CALL DPWRST('XXX','WRIT')
        ATEMP=95.0
        WRITE(ICOUT,4647)ATEMP,BLOW95,BHIG95
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4691)
 4691   FORMAT('LOCML AND SCALEML WILL BE SAVED AS INTERNAL ',
     1         'PARAMETERS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLO')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLLO--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLLN(Y,N,
     1XTEMP,MAXNXT,
     1XSD,XSCALE,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR LOGNORMAL DISTRIBUTION
C     EXAMPLE--LOGNORMAL MAXIMUM LIKELIHOOD Y
C     REFERENCE--"STATISTICAL DISTRIBUTIONS", THIRD EDITION,
C                EVANS, HASTINGS, AND PEACOCK, WILEY, 2001.
C              --"METHODS FOR STATISTICAL ANALYSIS OF RELIABILITY
C                AND LIFE DATA", MANN, SCHAFER, AND SINGPURWALLA,
C                WILEY, 1974, PP. 264-268.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/5
C     ORIGINAL VERSION--MAY       1998.
C     UPDATED         --MARCH     2004. SUPPORT HTML/LATEX OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*1 IBASLC
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
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='DPML'
      ISUBN2='PA  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLLN')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLLN--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLLN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR FOR LOGNORMAL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 1 ',
     1         'IS NON-POSITIVE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR FROM LOGNORMAL MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
 1290 CONTINUE
C
C               *********************************
C               **  STEP 41--                  **
C               **  CARRY OUT CALCULATIONS     **
C               **  FOR LOGNORMAL MLE ESTIMATE **
C               *********************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      CALL MEAN(Y,N,IWRITE,AMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,ASD,IBUGA3,IERROR)
      DO4110I=1,N
        IF(Y(I).LE.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4111)
 4111     FORMAT('***** ERROR FROM LOGNORMAL MAXIMUM LIKELIHOOD--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4113)
 4113     FORMAT('      NON-POSITIVE VALUE DETECTED.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
        Y(I)=LOG(Y(I))
 4110 CONTINUE
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      XSCALE=EXP(XMEAN)
C
      IDF=N-1
      ADF=REAL(N-1)
      CALL TPPF(0.025,IDF,T025)
      CALL TPPF(0.975,IDF,T975)
      XSCALL=XSCALE + T025*XSD/SQRT(ADF)
      XSCAUL=XSCALE + T975*XSD/SQRT(ADF)
      CALL CHSPPF(0.05,IDF,CS005)
      XSDUL=SQRT(REAL(N)*XSD*XSD/CS005)
C
C               *********************************
C               **   STEP 42--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR LOGNORMAL MLE ESTIMATE**
C               **********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Lognormal 2-Parameter Maximum Likelihood ',
     1         'Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=250>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Mean:')
 5063   FORMAT('         Sample Standard Deviation:')
 5064   FORMAT('         <B>Maximum Likelihood Estimates:</B>')
 5065   FORMAT('         Estimate of Shape Parameter XSD:')
 5066   FORMAT('         Estimate of Scale Parameter XSCALE:')
 5067   FORMAT('         95% Upper Confidence Bound for XSD:')
 5068   FORMAT('         95% Lower Confidence Limit for XSCALE:')
 5069   FORMAT('         95% Upper Confidence Limit for XSCALE:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ASD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSCALE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSDUL
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSCALL
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSCAUL
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Lognormal 2-Parameter Maximum Likelihood ',
     1       'Estimate}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'{',A1,'bf Maximum Likelihood Estimates:} & ',2X,A1,A1)
 8025 FORMAT(5X,'Estimate of Shape Parameter XSD: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Estimate of Scale Parameter XSCALE: & ',
     1       G15.7,2X,A1,A1)
 8027 FORMAT(5X,'95',A1,'% Upper Condidence Limit for XSD: & ',
     1       G15.7,2X,A1,A1)
 8028 FORMAT(5X,'95',A1,'% Lower Condidence Limit for XSCALE: & ',
     1       G15.7,2X,A1,A1)
 8029 FORMAT(5X,'95',A1,'% Upper Condidence Limit for XSCALE: & ',
     1       G15.7,2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)AMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)ASD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)XSCALE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,XSDUL,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,XSCALL,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC,XSCAUL,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{center}')
 8093 FORMAT(A1,'end{table}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT('LOGNORMAL 2-PARAMETER MAXIMUM LIKELIHOOD ESTIMATE:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)N
 4242   FORMAT(6X,'NUMBER OF OBSERVATIONS      = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4343)AMEAN
 4343   FORMAT(6X,'SAMPLE MEAN                 = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4344)ASD
 4344   FORMAT(6X,'SAMPLE STANDARD DEVIATION   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4347)XSD
 4347   FORMAT(6X,'ESTIMATE OF SHAPE PARAMETER XSD         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4349)XSCALE
 4349   FORMAT(6X,'ESTIMATE OF SCALE PARAMETER XSCALE      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4351)XSDUL
 4351   FORMAT(6X,'95% UPPER CONFIDENCE LIMIT FOR XSD      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4353)XSCALL
 4353   FORMAT(6X,'95% LOWER CONFIDENCE LIMIT FOR XSCALE   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4355)XSCAUL
 4355   FORMAT(6X,'95% UPPER CONFIDENCE LIMIT FOR XSCALE   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4341)
 4341   FORMAT('XSD AND XSCALE WILL BE SAVED AS INTERNAL PARAMETERS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLLN')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMLLN--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMLL1(Y,TAG,N,
     1XTEMP,DTEMP,MAXNXT,
     1SIGMA,SIGMSE,SCALE,SCALSE,UHAT,UHATSE,
     1NUMV,ICENTY,TEND,
     1ICAPSW,ICAPTY,
     1QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
     1IOUNI1,IOUNI2,ALPHAP,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR LOGNORMAL DISTRIBUTION
C              FOR THE FULL SAMPLE CASE.
C     EXAMPLE--LOGNORMAL MAXIMUM LIKELIHOOD Y
C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
C                1999, CHAPTER 13.
C              --"STATISTICAL DISTRIBUTIONS", THIRD EDITION,
C                EVANS, HASTINGS, AND PEACOCK, WILEY, 2001.
C              --"METHODS FOR STATISTICAL ANALYSIS OF RELIABILITY
C                AND LIFE DATA", MANN, SCHAFER, AND SINGPURWALLA,
C                WILEY, 1974, PP. 264-268.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/11
C     ORIGINAL VERSION--NOVEMBER  2004. NOTE: THIS REPLACES AN
C                                       EARLIER IMPLEMENTATION.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICENTY
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      PARAMETER (NUMALP=6)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWSC(NUMALP)
      DIMENSION AUPPSC(NUMALP)
      DIMENSION ALOWUH(NUMALP)
      DIMENSION AUPPUH(NUMALP)
      DIMENSION ALOWSH(NUMALP)
      DIMENSION AUPPSH(NUMALP)
      DIMENSION ALOWS2(NUMALP)
      DIMENSION AUPPS2(NUMALP)
      DIMENSION ALOWG2(NUMALP)
      DIMENSION AUPPG2(NUMALP)
C
      DIMENSION Y(*)
      DIMENSION TAG(*)
      DIMENSION XTEMP(*)
      DIMENSION QP(*)
      DIMENSION XQPHAT(*)
      DIMENSION XQPSE(*)
      DIMENSION XQPLCL(*)
      DIMENSION XQPUCL(*)
      DOUBLE PRECISION DTEMP(*)
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
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='L1  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL1')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLL1--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,NUMV,ICENTY
   55   FORMAT('N,NUMV,NPERC,ICENTY = ',3I8,2X,A4)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I),TAG(I)
   57     FORMAT('I,Y(I),TAG(I) = ',I8,2E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN LOGNORMAL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)
 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 1 ',
     1         'IS <= 1')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)N
 1113   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      DO1125I=1,N
        IF(Y(I).LE.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1121)
 1121     FORMAT('***** ERROR FROM LOGNORMAL MAXIMUM LIKELIHOOD--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1132)I,Y(I)
 1122     FORMAT('      ROW ',I8,' HAS THE VALUE = ',E15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
 1125 CONTINUE
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** WARNING FROM LOGNORMAL MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1132)HOLD
 1132 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
      IF(NPERC.GT.0)THEN
        DO1145I=1,NPERC
          IF(QP(I).LE.0.0 .OR. QP(I).GE.100.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1141)
 1141       FORMAT('***** WARNING IN LOGNORMAL MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1143)QP(I)
 1143       FORMAT('      REQUESTED PERCENTILE (',G15.7,') IS ',
     1             'OUTSIDE THE (0,100) INTERVAL')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1144)
 1144       FORMAT('      NO PERCENTILE CONFIDENCE LIMITS WILL BE ',
     1             'COMPUTED.')
            CALL DPWRST('XXX','WRIT')
            NPERC=0
          ENDIF
 1145   CONTINUE
      ENDIF
C
C
C               **********************************
C               **  STEP 41--                   **
C               **  CARRY OUT CALCULATIONS      **
C               **  FOR LOGNORMAL MLE           **
C               **  ESTIMATE (FULL SAMPLE CASE) **
C               **********************************
C
 4100 CONTINUE
C
C  THE MAXIMUM LIKELIHOOD ESTIMATES ARE:
C
C  NOTE THAT A COMMON PARAMETERIZATION USES
C
C    U = LOG(SCALE)
C
C    UHAT      = (1/N)*SUM[i=1 to N][LOG(Y(I))]
C    SCALEHAT  = EXP(UHAT)
C    SIGMAHAT  = SQRT((1/N)*SUM[i=1 to N][(LOG(Y(I)) - UHAT)**2]
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      AN=REAL(N)
C
C  COMPUTE SOME SAMPLE STATISTICS ON UNTRANSFORMED DATA
C
      CALL MINIM(Y,N,IWRITE,AMIN,IBUGA3,IERROR)
      CALL MEAN(Y,N,IWRITE,AMEAN,IBUGA3,IERROR)
      CALL MEDIAN(Y,N,IWRITE,XTEMP,MAXNXT,AMED,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,ASD,IBUGA3,IERROR)
C
C  COMPUTE SOME SAMPLE STATISTICS ON LOG OF DATA
C
      DO4103I=1,N
        XTEMP(I)=LOG(Y(I))
 4103 CONTINUE
C
      CALL MEAN(XTEMP,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(XTEMP,N,IWRITE,XSD,IBUGA3,IERROR)
C
C  COMPUTE MLE ESTIMATES
C
      UHAT=XMEAN
      SCALE=EXP(XMEAN)
      SIGMA=XSD
C
C  COMPUTE STANDARD ERRORS
C
      UHATSE=SIGMA/SQRT(AN)
      SCALSE=SIGMA/SQRT(AN)
      SIGMSE=SIGMA/SQRT(2.0*(AN-1.0))
C
C  CONFIDENCE INTERVALS FOR PARAMETERS.  NOTE THAT FOR THE
C  FULL SAMPLE CASE, THE SAMPLING DISTRIBUTIONS ARE EXACT.
C
      IDF=N-1
      ADF=REAL(N-1)
      DO4110I=1,NUMALP
        ALP=ALPHA(I)
        P1=ALP/2.0
        P2=1.0-(ALP/2.0)
        CALL TPPF(P1,IDF,TLOW)
        CALL TPPF(P2,IDF,TUPP)
        ALOWUH(I)=UHAT + TLOW*UHATSE
        AUPPUH(I)=UHAT + TUPP*UHATSE
        ALOWSC(I)=SCALE + TLOW*UHATSE
        AUPPSC(I)=SCALE + TUPP*UHATSE
        CALL CHSPPF(P1,IDF,CSLOW)
        CALL CHSPPF(P2,IDF,CSUPP)
        ALOWSH(I)=SIGMA*SQRT(ADF/CSUPP)
        AUPPSH(I)=SIGMA*SQRT(ADF/CSLOW)
 4110 CONTINUE
C
C  CONFIDENCE INTERVALS FOR SELECTED PERCENTILES.
C
C  FULL SAMPLE CASE BASED ON NON-CENTRAL T
C
      IF(NPERC.GE.1)THEN
C
        C1=SIGMA/SQRT(AN)
        ANU=REAL(N-1)
        ALPHL=ALPHAP/2.0
        ALPHU=1.0 - ALPHAP/2.0
C
        WRITE(IOUNI1,4191)
 4191   FORMAT(15X,'       POINT     ','     LOWER     ',
     1         '     UPPER')
        WRITE(IOUNI1,4192)
 4192   FORMAT('    PERCENTILE ','     ESTIMATE   ',
     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
        DO4190I=1,NPERC
          QPTEMP=QP(I)/100.0
C
          CALL NORPPF(QPTEMP,APPF)
          DELTA=APPF*SQRT(AN)
C
          CALL LGNPPF(QPTEMP,SIGMA,ATEMP)
          XQPHAT(I)=SCALE*ATEMP
C
          IF(DELTA.LT.0.0)THEN
            DELTA2=-DELTA
            CALL NCTPPF(ALPHU,ANU,DELTA2,C2)
            C2=-C2
            CALL NCTPPF(ALPHL,ANU,DELTA2,C3)
            C3=-C3
          ELSE
            CALL NCTPPF(ALPHL,ANU,DELTA,C2)
            CALL NCTPPF(ALPHU,ANU,DELTA,C3)
          ENDIF
          ATEMP1=EXP(UHAT + C1*C2)
          ATEMP2=EXP(UHAT + C1*C3)
          XQPLCL(I)=MIN(ATEMP1,ATEMP2)
          XQPUCL(I)=MAX(ATEMP1,ATEMP2)
          WRITE(IOUNI1,'(3E15.7,2X,E15.7)')
     1         QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I)
          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLL1')THEN
            WRITE(ICOUT,4193)XMEAN,XSD,ANU,ALPHA
 4193       FORMAT('XMEAN,XSD,ANU,ALPHA = ',4G15.7)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4195)DELTA,C1,C2,C3
 4195       FORMAT('DELTA,C1,C2,C3 = ',4G15.7)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4197)ATEMP1,ATEMP2
 4197       FORMAT('ATEMP1,ATEMP2 = ',2G15.7)
            CALL DPWRST('XXX','BUG ')
          ENDIF
 4190   CONTINUE
C
      ENDIF
C
C               *************************************
C               **   STEP 42--                     **
C               **   WRITE OUT EVERYTHING          **
C               **   FOR LOGNORMAL MLE ESTIMATE    **
C               *************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL1')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5002   FORMAT('<B>LOGNORMAL MAXIMUM LIKELIHOOD ESTIMATION:')
 5004   FORMAT('<BR>FULL SAMPLE CASE</B>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Two-Parameter Model (Location = 0)</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=325>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Minimum:')
 5063   FORMAT('         Sample Mean:')
 5064   FORMAT('         Sample Median:')
 5065   FORMAT('         Sample Standard Deviation:')
 5066   FORMAT('         ML Estimate of Shape Parameter:')
 5067   FORMAT('         Standard Error of Shape Parameter:')
 5068   FORMAT('         ML Estimate of Scale Parameter:')
 5069   FORMAT('         ML Estimate of mu (= LOG(SCALE))):')
 5070   FORMAT('         Standard Error of Scale/mu:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMED
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ASD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SIGMA
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SIGMSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)UHAT
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5070)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)UHATSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Limits for the Shape ',
     1         'Parameter</B><BR>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5134   FORMAT('         &nbsp;')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=3>')
 5162   FORMAT('          <HR>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        DO5140I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWSH(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPSH(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5140   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5217   FORMAT('      <B>Confidence Limits for the Scale/mu ',
     1         'Parameter</B>')
 5236   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM COLSPAN=2>')
 5237   FORMAT('         Scale Parameter')
 5238   FORMAT('         mu Parameter')
 5261   FORMAT('      <TD COLSPAN=5>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5217)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5236)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5237)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5236)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5238)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5261)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
        DO5240I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWSC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPSC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWUH(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPUH(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5240   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  START THE TABLE FOR PERCENTILE CONFIDENCE INTERVALS
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,999)
          WRITE(ICOUT,5811)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5813)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5815)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5817)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5816)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5819)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5861)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5863)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5864)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5870)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5872)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5847)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          DO55880I=1,NPERC
            WRITE(ICOUT,5841)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)QP(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPHAT(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPLCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPUCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5859)
            CALL DPWRST('XXX','WRIT')
55880     CONTINUE
C
C  END THE TABLE AND RESET ASIS MODE
C
          WRITE(ICOUT,5191)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5193)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,5801)
        CALL DPWRST('XXX','WRIT')
C
 5801   FORMAT('</PRE>')
 5811   FORMAT('<UL>')
 5813   FORMAT('<TABLE NOBORDER>')
 5815   FORMAT('   <CAPTION ALIGN=CENTER>')
 5816   FORMAT('      <BR><B>Alpha = ',F7.3,'</B>')
 5817   FORMAT('      <B>Confidence Limits (Based on Non-Central ',
     1         '<i>t</i>) for Selected Percentiles</B>')
 5819   FORMAT('   </CAPTION>')
 5841   FORMAT('   <TR>')
 5843   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5847   FORMAT('      </TD>')
 5848   FORMAT('      </TH>')
 5849   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5851   FORMAT('         ',G15.7)
 5859   FORMAT('   </TR>')
 5861   FORMAT('         Percentile')
 5862   FORMAT('         Point <br> Estimate')
 5863   FORMAT('         Lower <br>Confidence Limit')
 5864   FORMAT('         Upper <br>Confidence Limit')
 5870   FORMAT('      <TD COLSPAN=4>')
 5872   FORMAT('         <HR WIDTH=600>')
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001   FORMAT(A1,'end{verbatim}')
 8003   FORMAT(A1,'begin{table}')
 8004   FORMAT(A1,'end{table}')
 8005   FORMAT('{',A1,'bf Lognormal Maximum Likelihood ',
     1         'Estimation: Full Sample Case}')
 8007   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009   FORMAT(A1,'begin{center}')
 8011   FORMAT(5X,'{',A1,'bf Two-Parameter Model ($',A1,
     1         'theta$ = 0 Case)}')
 8013   FORMAT(A1,'end{center}')
 8015   FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020   FORMAT(5X,A1,'begin{tabular} {lr}')
 8021   FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022   FORMAT(5X,'Sample Minimum : & ',G15.7,2X,A1,A1)
 8023   FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8024   FORMAT(5X,'Sample Median: & ',G15.7,2X,A1,A1)
 8025   FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8026   FORMAT(5X,'ML Estimate of Shape Parameter: & ',G15.7,2X,A1,A1)
 8027   FORMAT(5X,'Standard Error of Shape Parameter: & ',
     1         G15.7,2X,A1,A1)
 8028   FORMAT(5X,'ML Estimate of Scale Parameter: & ',G15.7,2X,A1,A1)
 8029   FORMAT(5X,'ML Estimate of $',A1,
     1         'mu$ (=LOG(Scale)) Parameter: & ',
     1         G15.7,2X,A1,A1)
 8030   FORMAT(5X,'Standard Error of Scale/$',A1,'mu$ Parameter: & ',
     1         G15.7,2X,A1,A1)
 8035   FORMAT(5X,'  & ',2X,A1,A1)
 8049   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)AMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)AMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)AMED,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)ASD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8035)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)SIGMA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)SIGMSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)SCALE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC,UHAT,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC,SCALSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8093   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for Shape Parameter}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8111)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper ',2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit',2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,2X,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8130I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWSH(I),AUPPSH(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8130   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8191   FORMAT(A1,'end{table}')
 8193   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8211   FORMAT(5X,'{',A1,'bf Confidence Limits for Scale Parameter}')
 8220   FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8221   FORMAT(5X,'Confidence & Lower & Upper & Lower & Upper ',
     1         2X,A1,A1)
 8222   FORMAT(5X,'Value (',A1,'%) & Limit & Limit & Limit & Limit',
     1         2X,A1,A1)
 8226   FORMAT(5X,'& ',A1,'multicolumn{2}{c}{Scale Parameter}',
     1         ' & ',A1,'multicolumn{2}{c}{$',A1,'mu$ Parameter}',
     1         2X,A1,A1)
 8231   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,' & ',G15.7,' & ',
     1         G15.7,2X,A1,A1)
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8211)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8220)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8226)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8221)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8222)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8230I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8231)ATEMP,ALOWSC(I),AUPPSC(I),ALOWUH(I),
     1                     AUPPUH(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8230   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8191)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C WRITE SELECTED PERCENTILES (IF ANY)
C
        IF(NPERC.GT.0)THEN
C
          CALL DPCONA(92,IBASLC)
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8803)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8810)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8812)IBASLC,IBASLC,ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8813)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8820)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8821)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8822)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8840)IBASLC
          CALL DPWRST('XXX','WRIT')
          DO8830I=1,NPERC
            WRITE(ICOUT,8823)QP(I),XQPHAT(I),XQPLCL(I),
     1                       XQPUCL(I),IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
 8830     CONTINUE
          WRITE(ICOUT,8849)IBASLC
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8891)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8893)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
 8801   FORMAT(A1,'end{verbatim}')
 8803   FORMAT(A1,'begin{table}')
 8807   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8809   FORMAT(A1,'begin{center}')
 8810   FORMAT(5X,'{',A1,'bf Confidence Limits ',
     1         '(Based on Non-Central t) ',
     1         'for Selected Percentiles}',2X,A1,A1)
 8812   FORMAT(5X,'{',A1,'bf $',A1,'alpha$ = ',F7.3,'}')
 8813   FORMAT(A1,'end{center}')
 8815   FORMAT(5X,'} ',A1,A1)
 8820   FORMAT(5X,A1,'begin{tabular} {cccc}')
 8821   FORMAT(5X,' & {',A1,'bf Point} & {',A1,
     1         'bf Lower} & {',A1,'bf Upper}',2X,A1,A1)
 8822   FORMAT(5X,'{',A1,'bf Percentile} & {',A1,'bf Estimate} & {',
     1         A1,'bf Confidence Limit} & {',A1,
     1         'bf Confidence Limit}',2X,A1,A1)
 8823   FORMAT(5X,G15.7,' & ',G15.7,' & ',G15.7,
     1         ' & ',G15.7,2X,A1,A1)
 8840   FORMAT(5X,A1,'hline')
 8849   FORMAT(A1,'end{tabular}')
 8891   FORMAT(A1,'end{center}')
 8893   FORMAT(A1,'end{table}')
C
 8899   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8899)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(6X,'LOGNORMAL MAXIMUM LIKELIHOOD ESTIMATION:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4212)
 4212   FORMAT(6X,'FULL SAMPLE CASE')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4213)
 4213   FORMAT('TWO-PARAMETER MODEL (LOCATION = 0)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4214)N
 4214   FORMAT('NUMBER OF OBSERVATIONS                       = ',
     1         I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4215)AMIN
 4215   FORMAT('SAMPLE MINIMUM                               = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4216)AMEAN
 4216   FORMAT('SAMPLE MEAN                                  = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4217)AMED
 4217   FORMAT('SAMPLE MEDIAN                                = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4218)ASD
 4218   FORMAT('SAMPLE STANDARD DEVIATION                    = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4221)SIGMA
 4221   FORMAT('ML ESTIMATE OF SHAPE PARAMETER (SIGMA)       = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4222)SIGMSE
 4222   FORMAT('STANDARD ERROR OF SHAPE PARAMETER            = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)SCALE
 4223   FORMAT('ML ESTIMATE OF SCALE PARAMETER               = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)UHAT
 4225   FORMAT('ML ESTIMATE OF MU (= LOG(SCALE))             = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4227)UHATSE
 4227   FORMAT('STANDARD ERROR OF SCALE/MU                   = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4240)
 4240   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)
 4242   FORMAT('                          SCALE PARAMETER  ',
     1         '             MU PARAMETER ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)
 4243   FORMAT('   CONFIDENCE           LOWER         UPPER',
     1         '         LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)
 4245   FORMAT('   VALUE (%)            LIMIT         LIMIT',
     1         '         LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4246)
 4246   FORMAT('---------------------------------------------------',
     1         '--------------------')
        CALL DPWRST('XXX','WRIT')
        DO4249I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4247)ATEMP,ALOWSC(I),AUPPSC(I),ALOWUH(I),
     1                     AUPPUH(I)
 4247     FORMAT('   ',F8.3,10X,4(G12.6,2X))
          CALL DPWRST('XXX','WRIT')
 4249   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4252)
 4252   FORMAT('CONFIDENCE INTERVAL FOR SHAPE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4256)
 4256   FORMAT('   CONFIDENCE           LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4257)
 4257   FORMAT('   VALUE (%)            LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4266)
 4266   FORMAT('-------------------------------------------')
        CALL DPWRST('XXX','WRIT')
        DO4259I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4258)ATEMP,ALOWSH(I),AUPPSH(I)
 4258     FORMAT('   ',F8.3,10X,G12.6,2X,G12.6)
          CALL DPWRST('XXX','WRIT')
 4259   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,4911)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4915)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4921)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4922)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4346)
          CALL DPWRST('XXX','WRIT')
C
 4911   FORMAT('CONFIDENCE LIMITS (BASED ON NON-CENTRAL T) FOR ',
     1         'SELECTED PERCENTILES:')
 4915   FORMAT('ALPHA = ',F7.4)
 4921   FORMAT(15X,'       POINT     ',
     1             '          LOWER     ', '      UPPER')
 4922   FORMAT('    PERCENTILE ','     ESTIMATE   ',
     1         '    CONFIDENCE LIMIT ',' CONFIDENCE LIMIT')
 4346   FORMAT('---------------------------------------',
     1         '-----------------------------')
C
          DO4981I=1,NPERC
            WRITE(ICOUT,4932)QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I)
 4932       FORMAT(2G15.7,6X,G15.7,2X,G15.7)
            CALL DPWRST('XXX','WRIT')
 4981     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,4291)
 4291     FORMAT('THE FOLLOWING INTERNAL PARAMETERS ARE SAVED:')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4293)
 4293     FORMAT('      SIGMAML, SIGMASE, SCALEML, UHATML, UHATSE')
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IF(IFEEDB.EQ.'ON')THEN
          IF(NPERC.GT.0)THEN
            WRITE(ICOUT,4943)
 4943       FORMAT('PERCENTILE CONFIDENCE LIMITS  WRITTEN TO ',
     1             'FILE  dpst1f.dat')
            CALL DPWRST('XXX','BUG ')
          ENDIF
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL1')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLL1--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLL2(Y,TAG,N,
     1XTEMP,DTEMP,MAXNXT,
     1SIGMML,SIGMSE,SCALML,SCALSE,UHATML,UHATSE,COVSE,
     1NUMV,ICENTY,TEND,
     1ICAPSW,ICAPTY,
     1QP,XQPHAT,XQPLCL,XQPUCL,XQPLC2,XQPUC2,XQPSE,NPERC,
     1IOUNI1,IOUNI2,ALPHAP,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR LOGNORMAL DISTRIBUTION
C              FOR THE TIME CENSORED CASE.  CURRENTLY, ONLY
C              SINGLY CENSORED DATA IS SUPPORTED (I.E., ALL
C              CENSOR TIMES ARE THE SAME).  THE MAXIMUM LIKELIHOOD
C              EQUATIONS ARE:
C
C                 SUM[i=1 to r][Z(I)] + M*H(Z(I)) = 0
C
C                 SUM[i=1 to r][Z(I)**2] + M*Z*H(Z) - R = 0
C
C              WHERE
C
C                 R        = NUMBER OF FAILURES
C                 M        = NUMBER OF CENSORING TIMES
C                 C        = CENSORING TIME (ALL CENSORED DATA WILL
C                            HAVE THE SAME CENSORING TIME)
C                 Z(I)     = [LOG(X(I) - UHAT]/SHAT
C                 UHAT     = FVEC(1) = CURRENT ESTIMATE OF MU PARAMETER
C                 SHAT     = FVEC(2) = CURRENT ESTIMATE OF SIGMA
C                            PARAMETER
C                 Z        = [LOG(C) - UHAT]/SHAT
C                 H(Z)     = NORPDF(Z)/(1 - NOCDF(Z))
C
C     EXAMPLE--LOGNORMAL MAXIMUM LIKELIHOOD Y X
C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
C                1999, CHAPTER 11.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/11
C     ORIGINAL VERSION--NOVEMBER  2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICENTY
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASE
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      PARAMETER (NUMALP=6)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWSC(NUMALP)
      DIMENSION AUPPSC(NUMALP)
      DIMENSION ALOWUH(NUMALP)
      DIMENSION AUPPUH(NUMALP)
      DIMENSION ALOWSI(NUMALP)
      DIMENSION AUPPSI(NUMALP)
      DIMENSION ALOWG2(NUMALP)
      DIMENSION AUPPG2(NUMALP)
      DIMENSION ALOWS2(NUMALP)
      DIMENSION AUPPS2(NUMALP)
      DIMENSION ALOWU2(NUMALP)
      DIMENSION AUPPU2(NUMALP)
C
      DIMENSION Y(*)
      DIMENSION TAG(*)
      DIMENSION XTEMP(*)
      DIMENSION QP(*)
      DIMENSION XQPHAT(*)
      DIMENSION XQPSE(*)
      DIMENSION XQPLCL(*)
      DIMENSION XQPUCL(*)
      DIMENSION XQPLC2(*)
      DIMENSION XQPUC2(*)
      DOUBLE PRECISION DTEMP(*)
C
      DOUBLE PRECISION LG1FUN
      DOUBLE PRECISION LG2FUN
      DOUBLE PRECISION LG4FUN
      DOUBLE PRECISION LG6FUN
      EXTERNAL SUM
      EXTERNAL LG1FUN
      EXTERNAL LG2FUN
      EXTERNAL LG4FUN
      EXTERNAL LG6FUN
C
      DOUBLE PRECISION C
      INTEGER IN
      INTEGER IM
      COMMON/LG1COM/C,IN,IM
C
      INTEGER N2
      INTEGER IR2
      INTEGER IM2
      DOUBLE PRECISION DLLUS
      DOUBLE PRECISION DC
      DOUBLE PRECISION DK
      DOUBLE PRECISION DSIGMA
      COMMON/LG2COM/DLLUS,DC,DK,DSIGMA,N2,IR2,IM2
C
      INTEGER N3
      INTEGER IR3
      INTEGER IM3
      DOUBLE PRECISION DLLUS2
      DOUBLE PRECISION DC2
      DOUBLE PRECISION DK2
      DOUBLE PRECISION DU2
      COMMON/LG4COM/DLLUS2,DC2,DK2,DU2,N3,IR3,IM3
C
      INTEGER N4
      INTEGER IR4
      INTEGER IM4
      DOUBLE PRECISION DLLUS3
      DOUBLE PRECISION DC3
      DOUBLE PRECISION DK3
      DOUBLE PRECISION DSIGMA3
      DOUBLE PRECISION DU3
      DOUBLE PRECISION DX05
      DOUBLE PRECISION DZ05
      DOUBLE PRECISION SEXQP
      COMMON/LG6COM/DLLUS3,DC3,DK3,DSIGMA3,DU3,DX05,DZ05,SEXQP,
     1N4,IR4,IM4
C
      DOUBLE PRECISION TOL
      DOUBLE PRECISION XPAR(2)
      DOUBLE PRECISION FVEC(2)
C
      DIMENSION FISH(2,2)
      DIMENSION COV(2,2)
      DIMENSION D(2)
C
      DOUBLE PRECISION DXLOW
      DOUBLE PRECISION DXUP
      DOUBLE PRECISION DXSTRT
      DOUBLE PRECISION DN
      DOUBLE PRECISION DR
      DOUBLE PRECISION DM
      DOUBLE PRECISION DX
      DOUBLE PRECISION AE
      DOUBLE PRECISION RE
      DOUBLE PRECISION DS
      DOUBLE PRECISION DU
      DOUBLE PRECISION DZ
      DOUBLE PRECISION DH
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DTERM2
      DOUBLE PRECISION DTERM3
      DOUBLE PRECISION DTERM4
      DOUBLE PRECISION DSUM
      DOUBLE PRECISION DCDF
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
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='L2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLL2--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,NUMV
   55   FORMAT('N,NUMV,NPERC = ',3I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I),TAG(I)
   57     FORMAT('I,Y(I),TAG(I) = ',I8,2E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
        WRITE(ICOUT,59)ICENTY
   59   FORMAT('ICENTY = ',A4)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN LOGNORMAL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)
 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 1 ',
     1         'IS <= 1')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)N
 1113   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      DO1125I=1,N
        IF(Y(I).LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1121)
 1121     FORMAT('***** ERROR FROM LOGNORMAL MAXIMUM LIKELIHOOD--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1122)
 1122     FORMAT('      A NEGATIVE VALUE WAS ENCOUNTERED.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1123)I,Y(I)
 1123     FORMAT('      ROW ',I8,' HAS THE VALUE = ',E15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
 1125 CONTINUE
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** WARNING FROM LOGNORMAL MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1132)HOLD
 1132 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
      IF(NPERC.GT.0)THEN
        DO1145I=1,NPERC
          IF(QP(I).LE.0.0 .OR. QP(I).GE.100.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1141)
 1141       FORMAT('***** WARNING IN LOGNORMAL MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1143)QP(I)
 1143       FORMAT('      REQUESTED PERCENTILE (',G15.7,') IS ',
     1             'OUTSIDE THE (0,100) INTERVAL')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1144)
 1144       FORMAT('      NO PERCENTILE CONFIDENCE LIMITS WILL BE ',
     1             'COMPUTED.')
            CALL DPWRST('XXX','WRIT')
            NPERC=0
          ENDIF
 1145   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 21--                             **
C               **  CHECK THE CENSORING VARIABLE: SHOULD  **
C               **  BE AT MOST 2 DISTINCT VALUES, 1       **
C               **  INDICATES FAILURE TIME, 0 INDICATES   **
C               **  CENSORING TIME.                       **
C               ********************************************
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC NOVEMBER 2004.  FOR CENSORED CASE, CHECK THAT SECOND VARIABLE
CCCCC                 CONTAINS TWO DISTINCT VALUES, SET TO 1 AND 0.
C
      CALL DISTIN(TAG,N,IWRITE,XTEMP,NDIST,IBUGA3,IERROR)
      IF(NDIST.EQ.1)THEN
        DO2102I=1,N
          TAG(I)=1.0
 2102   CONTINUE
      ELSEIF(NDIST.EQ.2)THEN
        IF(XTEMP(1).EQ.1.0 .OR. XTEMP(2).EQ.1.0)THEN
          DO2103I=1,N
            IF(TAG(I).NE.1.0)TAG(I)=0.0
 2103     CONTINUE
        ELSE
          ATEMP1=MIN(XTEMP(1),XTEMP(2))
          ATEMP2=MAX(XTEMP(1),XTEMP(2))
          DO2108I=1,N
            IF(TAG(I).EQ.ATEMP1)TAG(I)=1.0
            IF(TAG(I).EQ.ATEMP2)TAG(I)=0.0
 2108     CONTINUE
        ENDIF
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2104)
 2104   FORMAT('***** ERROR IN LOGNORMAL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2105)
 2105   FORMAT('      FOR CENSORED DATA, THE CENSORING VARIABLE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2106)
 2106   FORMAT('      SHOULD CONTAIN AT MOST TWO DISTINCT VALUES.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2107)NDIST
 2107   FORMAT('      ',I8,' DISTINCT VALUES FOUND.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      CALL SORTC(Y,TAG,N,Y,TAG)
      IR=0
      DO2120I=1,N
        IF(TAG(I).EQ.1.0)IR=IR+1
 2120 CONTINUE
C
      ICNT=0
      DO2122I=1,N
        IF(TAG(I).EQ.1.0)THEN
          ICNT=ICNT+1
          XTEMP(ICNT)=Y(I)
        ENDIF
 2122 CONTINUE
      DO2124I=1,N
        IF(TAG(I).EQ.0.0)THEN
          ICNT=ICNT+1
          XTEMP(ICNT)=Y(I)
        ENDIF
 2124 CONTINUE
      DO2126I=1,N
        Y(I)=XTEMP(I)
        IF(I.LE.IR)THEN
          TAG(I)=1.0
        ELSE
          TAG(I)=0.0
        ENDIF
 2126 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLL2')THEN
        DO2128I=1,N
          WRITE(ICOUT,2129)I,Y(I),TAG(I)
 2129     FORMAT(1X,'I,Y(I),TAG(I)=',I8,2E15.7)
          CALL DPWRST('XXX','BUG ')
 2128   CONTINUE
      ENDIF
C
      IM=N-IR
      IR1=IR
      IR2=IR
      IR3=IR
C
      AR=REAL(IR)
      DR=DBLE(IR)
      AN=REAL(N)
      AM=REAL(IM)
C
      IF(IM.EQ.0)THEN
        ICASE='NONE'
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2131)
 2131   FORMAT('***** WARNING FROM LOGNORMAL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2133)
 2133   FORMAT('      NO CENSORING TIMES DETECTED.  IT IS RECOMMENDED')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2135)
 2135   FORMAT('      THAT THE FULL SAMPLE SYNTAX BE USED:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2137)
 2137   FORMAT('      LOGNORMAL MAXIMUM LIKELIHOOD  Y')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSE
        ICASE='SING'
        AHOLD=Y(IR+1)
        DO2140I=IR+1,N
          IF(Y(I).NE.AHOLD)THEN
            ICASE='MULT'
            GOTO2149
          ENDIF
 2140   CONTINUE
 2149   CONTINUE
        C=DBLE(AHOLD)
      ENDIF
C
      IF(ICASE.EQ.'MULT')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2141)
 2141   FORMAT('***** ERROR FROM LOGNORMAL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2143)
 2143   FORMAT('      CURRENTLY, ONLY SINGLY CENSORED DATA IS ',
     1         'SUPPORTED FOR THE LOGNORMAL DISTRIBUTION.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2145)
 2145   FORMAT('      MULTIPLY CENSORED DATA WAS DETECTED.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ************************************
C               **  STEP 41--                     **
C               **  CARRY OUT CALCULATIONS        **
C               **  FOR LOGNORMAL MLE             **
C               **  ESTIMATE (TIME CENSORED CASE) **
C               ************************************
C
 3100 CONTINUE
C
C  THE MAXIMUM LIKELIHOOD EQUATIONS ARE SOLVED USING THE DNSQE
C  ROUTINE.
C
C
      ISTEPN='31'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      AN=REAL(N)
C
C  COMPUTE STATISTICS FOR FAILURE ONLY DATA
C
      CALL MEAN(Y,IR,IWRITE,AMEAN,IBUGA3,IERROR)
      CALL SD(Y,IR,IWRITE,ASD,IBUGA3,IERROR)
      CALL MINIM(Y,IR,IWRITE,AMIN,IBUGA3,IERROR)
C
C  USE PARAMETERS ESTIMATED FROM FAILURE DATA AS STARTING VALUES
C  FOR EQUATION SOLVER.
C
      DO3103I=1,IR
        XTEMP(I)=LOG(Y(I))
 3103 CONTINUE
C
      CALL MEAN(XTEMP,IR,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(XTEMP,IR,IWRITE,XSD,IBUGA3,IERROR)
C
      XPAR(1)=DBLE(XMEAN)
      XPAR(2)=DBLE(XSD)
C
      IN=N
      JAC=0
      IOPT=2
      TOL=1.0D-6
      NVAR=2
      NPRINT=-1
      INFO=0
      LWA=MAXNXT
      FVEC(1)=0.0D0
      FVEC(2)=0.0D0
      CALL DNSQE(LG1FUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1           DTEMP,MAXNXT,Y,IR)
C
      UHATML=REAL(XPAR(1))
      SCALML=EXP(UHATML)
      SIGMML=REAL(XPAR(2))
C
C  COMPUTE STANDARD ERRORS.  FORMULAS FOR LOCAL FISHER INFORMATION
C  MATRIX GIVEN ON PAGE 162 OF BURY.
C
      DN=DBLE(N)
      DR=DBLE(IR)
      DM=DBLE(IM)
      DS=DBLE(SIGMML)
      DU=DBLE(UHATML)
      DZ=(DLOG(C)-DU)/DS
      CALL NODPDF(DZ,DTERM1)
      CALL NODCDF(DZ,DTERM2)
      DH=DTERM1/(1.0D0 - DTERM2)
      DSUM1=0.0D0
      DSUM2=0.0D0
      DO100I=1,IR
        DX=DBLE(Y(I))
        DX=(DLOG(DX) - DU)/DS
        DSUM1=DSUM1 + DX
        DSUM2=DSUM2 + DX*DX
  100 CONTINUE
C
      DTERM1=(1.0D0/DS**2)*(DR + DM*DH*(DH-DZ))
      FISH(1,1)=REAL(DTERM1)
      DTERM1=(1.0D0/DS**2)*(2.0D0*DSUM1 +DM*DH*(1.0D0 + DZ*(DH-DZ)))
      FISH(2,1)=REAL(DTERM1)
      FISH(1,2)=FISH(2,1)
      DTERM1=(1.0D0/DS**2)*
     1       (3.0D0*DSUM2 +DM*DZ*DH*(2.0D0 + DZ*DH -DZ**2) - DR)
      FISH(2,2)=REAL(DTERM1)
C
      NDIM=2
      CALL SGECO(FISH,NDIM,NDIM,ITEMP,RCOND,XTEMP)
      IJOB=1
      CALL SGEDI(FISH,NDIM,NDIM,ITEMP,XTEMP,XTEMP(MAXNXT/2),IJOB)
      DO2410J=1,NDIM
        DO2415I=1,NDIM
          COV(I,J)=FISH(I,J)
 2415   CONTINUE
 2410 CONTINUE
C
      SCALSE=0.0
      SIGMSE=0.0
      IF(COV(1,1).GE.0.0)SCALSE=SQRT(COV(1,1))
      IF(COV(2,2).GE.0.0)SIGMSE=SQRT(COV(2,2))
      COVSE=COV(2,1)
      UHATSE=SCALSE
C
C  CONFIDENCE INTERVALS FOR PARAMETERS.  CAN BASE ON EITHER NORMAL
C  APPROXIMATION OR ON LIKELIHOOD RATIO APPROXIMATION.
C
C  NORMAL APPROXIMATION FIRST.
C
      DO4110I=1,NUMALP
        ALP=ALPHA(I)
        P=1.0-(ALP/2.0)
        CALL NORPPF(P,PPF)
        ALOWSC(I)=SCALML - PPF*SCALSE
        AUPPSC(I)=SCALML + PPF*SCALSE
        ALOWUH(I)=UHATML - PPF*UHATSE
        AUPPUH(I)=UHATML + PPF*UHATSE
        ALOWSI(I)=SIGMML - PPF*SIGMSE
        AUPPSI(I)=SIGMML + PPF*SIGMSE
 4110 CONTINUE
C
C  NOW DO LIKELIHOOD RATIO APPROXIMATION (SEE COMMENTS IN
C  LG2FUN FOR FORMULAS).
C
C  COMPUTE LL(UHAT,SIGMA) AND SAVE IN COMMOM BLOCK.
C
      N2=N
      IR2=IR
      IM2=IM
      DSIGMA=DBLE(SIGMML)
      DC=C
      N3=N
      IR3=IR
      IM3=IM
      DSIGM2=DBLE(SIGMML)
      DC2=C
      DU2=DBLE(UHATML)
C
      DX=(DLOG(DC) - DBLE(UHATML))/DSIGMA
      CALL NODCDF(DX,DTERM2)
      DTERM1=-DR*DLOG(DSIGMA) + DM*DLOG(1.0D0 - DTERM2)
      DSUM1=0.0D0
      DSUM2=0.0D0
      DO4118I=1,IR
        DTEMP(I)=DBLE(Y(I))
        DX=DLOG(DTEMP(I))
        DSUM1=DSUM1 + DX
        DSUM2=DSUM2 + ((DX - DBLE(UHATML))/DSIGMA)**2
 4118 CONTINUE
      DLLUS=DTERM1 - DSUM1 - 0.5D0*DSUM2
      DLLUS2=DLLUS
C
      DN=DBLE(N)
      AE=1.D-7
      RE=1.D-7
      NUTEMP=1
C
      DO4120I=1,NUMALP
        ALP=ALPHA(I)
        CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
        DK=DBLE(APPF)
        DK2=DK
C
        DXSTRT=DBLE(ALOWSI(I))
        DXLOW=DXSTRT/5.0D0
        DXUP=DBLE(SIGMML)
        CALL DFZER2(LG4FUN,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG,DTEMP)
        ALOWG2(I)=REAL(DXLOW)
C
        DXSTRT=DBLE(AUPPSI(I))
        DXUP=DXSTRT*5.0D0
        DXLOW=DBLE(SIGMML)
        CALL DFZER2(LG4FUN,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG,DTEMP)
        AUPPG2(I)=REAL(DXLOW)
C
        DXSTRT=DBLE(ALOWUH(I))
        DXLOW=DXSTRT/2.0D0
        DXUP=DBLE(UHATML)
        CALL DFZER2(LG2FUN,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG,DTEMP)
        ALOWU2(I)=REAL(DXLOW)
        ALOWS2(I)=EXP(ALOWU2(I))
C
        DXSTRT=DBLE(AUPPUH(I))
        DXUP=DXSTRT*2.0D0
        DXLOW=DBLE(UHATML)
        CALL DFZER2(LG2FUN,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG,DTEMP)
        AUPPU2(I)=REAL(DXLOW)
        AUPPS2(I)=EXP(AUPPU2(I))
 4120 CONTINUE
C
C  CONFIDENCE INTERVALS FOR SELECTED PERCENTILES.
C
C  BASE ON EITHER THE ASYMPTOTIC NORMAL APPROXIMATION OR THE
C  LIKELIHOOD RATIO.
C
C  NOTE: I HAVEN'T BEEN ABLE TO GET THE LIKELIHOOD RATION METHOD
C        TO WORK.  COMMENT OUT FOR NOW.  
C
      IF(NPERC.GE.1)THEN
C
        ALPHL=ALPHAP/2.0
        ALPHU=1.0 - ALPHAP/2.0
        CALL NORPPF(ALPHU,Z95)
        DU=DBLE(UHATML)
        DS=DBLE(SIGMML)
C
        WRITE(IOUNI1,4191)
 4191   FORMAT(15X,'       POINT     ','   STANDARD   ',
     1         '     LOWER     ','     UPPER')
        WRITE(IOUNI1,4192)
 4192   FORMAT('    PERCENTILE ','     ESTIMATE   ','     ERROR     ',
     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
C
        N4=N
        IR4=IR
        IM4=IM
        DSIGMA3=DBLE(SIGMML)
        DC3=C
        DU3=DBLE(UHATML)
        DLLUS3=DLLUS
C
        NUTEMP=1
        CALL CHSPPF(1.0-ALPHAP,NUTEMP,APPF)
        DK=DBLE(APPF)
        DK3=DK
C
        DO4190I=1,NPERC
          QPTEMP=QP(I)/100.0
C
          CALL LGNPPF(QPTEMP,SIGMML,ATEMP)
          XQPHAT(I)=SCALML*ATEMP
C
          CALL NORPPF(QPTEMP,X95)
          D0=DEXP(DU + DBLE(X95)*DS)
          D1=DBLE(X95)*DEXP(DU + DBLE(X95)*DS)
          DTERM1=D0*D0*UHATSE**2
          DTERM2=D1*D1*SIGMSE**2
          DTERM3=D0*D1*COVSE
          DTERM4=D1*D0*COVSE
          DSUM=DTERM1 + DTERM2 + DTERM3 + DTERM4
          SEXQP=0.0
          IF(DSUM.GE.0.0D0)SEXQP=DSQRT(DSUM)
          XQPSE(I)=REAL(SEXQP)
          XQPLCL(I)=XQPHAT(I) - Z95*XQPSE(I)
          XQPUCL(I)=XQPHAT(I) + Z95*XQPSE(I)
C
CCCCC     DX05=DBLE(XQPHAT(I))
CCCCC     DZ05=DBLE(X95)
CCCCC     DXSTRT=DBLE(XQPLCL(I))
CCCCC     DXLOW=DXSTRT/2.0D0
CCCCC     DXUP=DBLE(XQPHAT(I))
CCCCC     CALL DFZER2(LG6FUN,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG,DTEMP)
CCCCC     write(19,*)'i,iflag=',i,iflag
CCCCC     XQPLC2(I)=REAL(DXLOW)
C
CCCCC     DXSTRT=DBLE(XQPUCL(I))
CCCCC     DXUP=DXSTRT*5.0D0
CCCCC     DXLOW=DBLE(XQPHAT(I))
CCCCC     CALL DFZER2(LG6FUN,DXLOW,DXUP,DXSTRT,RE,AE,IFLAG,DTEMP)
CCCCC     XQPUC2(I)=REAL(DXLOW)
          write(19,*)'i,xqphat(i),xqplc2(i)=',i,xqphat(i),xqplc2(i)
C
          WRITE(IOUNI1,'(4E15.7,2X,E15.7)')
     1         QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLL2')THEN
            WRITE(ICOUT,4193)D0,D1
 4193       FORMAT('D0,D1,DSUM = ',3G15.7)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4195)DTERM1,DTERM2,DTERM3,DTERM4
 4195       FORMAT('DTERM1,DTERM2,DTERM3,DTERM4 = ',4G15.7)
            CALL DPWRST('XXX','BUG ')
          ENDIF
 4190   CONTINUE
C
      ENDIF
C
C               *************************************
C               **   STEP 42--                     **
C               **   WRITE OUT EVERYTHING          **
C               **   FOR LOGNORMAL MLE ESTIMATE    **
C               *************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL2')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5002   FORMAT('<B>LOGNORMAL MAXIMUM LIKELIHOOD ESTIMATION:')
 5004   FORMAT('<BR>TIME (SINGLY) CENSORED CASE</B>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Two-Parameter Model (Location = 0)</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=375>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5060   FORMAT('         Number of Observations:')
 5061   FORMAT('         Number of Failure Times:')
 5062   FORMAT('         Minimum of Failure Times:')
 5063   FORMAT('         Mean of Failure Times:')
 5064   FORMAT('         Standard Deviation of Failure Times:')
 5065   FORMAT('         ML Estimate of Shape Parameter:')
 5066   FORMAT('         Standard Error of Shape Parameter:')
 5067   FORMAT('         ML Estimate of MU (= LOG(Scale)) Parameter:')
 5068   FORMAT('         ML Estimate of Scale Parameter:')
 5069   FORMAT('         Standard Error of Scale/MU Parameter:')
 5070   FORMAT('         Covariance of Scale and ',
     1         'Shape Parameter:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)IR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ASD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SIGMML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SIGMSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)UHATML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5070)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)COVSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Interval for the Scale ',
     1         'Parameter (Normal Approximation)</B><BR>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5134   FORMAT('         &nbsp;')
 5136   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM COLSPAN=2>')
 5137   FORMAT('         Scale')
 5138   FORMAT('         MU')
 5139   FORMAT('   </TR>')
 5237   FORMAT('         Normal Approximation')
 5238   FORMAT('         Likelihood Ratio')
 5161   FORMAT('      <TD COLSPAN=5>')
 5162   FORMAT('          <HR>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5138)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        DO5140I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWSC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPSC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWUH(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPUH(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5140   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5118   FORMAT('      <B>Confidence Interval for the Scale ',
     1         'Parameter (Likelihood Ratio)</B><BR>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5118)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5138)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
        DO5240I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWS2(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPS2(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWU2(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPU2(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5240   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5217   FORMAT('      <B>Confidence Limits for the Shape ',
     1         'Parameter</B>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5217)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5237)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5238)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
        DO5340I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWSI(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPSI(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWG2(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPG2(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5340   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  START THE TABLE FOR PERCENTILE CONFIDENCE INTERVALS
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5811)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5813)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5815)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5817)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5816)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5819)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5861)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,55862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5863)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5864)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5870)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5872)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5847)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          DO55880I=1,NPERC
            WRITE(ICOUT,5841)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)QP(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPHAT(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPSE(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPLCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPUCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5859)
            CALL DPWRST('XXX','WRIT')
55880     CONTINUE
C
C  END THE TABLE AND RESET ASIS MODE
C
          WRITE(ICOUT,5191)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5193)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
 5811   FORMAT('<UL>')
 5813   FORMAT('<TABLE NOBORDER>')
 5815   FORMAT('   <CAPTION ALIGN=CENTER>')
 5816   FORMAT('      <BR><B>Alpha = ',F7.3,'</B>')
 5817   FORMAT('      <B>Confidence Limits (Based on Normal ',
     1         'Approximation) for Selected Percentiles</B>')
 5819   FORMAT('   </CAPTION>')
 5841   FORMAT('   <TR>')
 5843   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5847   FORMAT('      </TD>')
 5848   FORMAT('      </TH>')
 5849   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5851   FORMAT('         ',G15.7)
 5859   FORMAT('   </TR>')
 5861   FORMAT('         Percentile')
 5862   FORMAT('         Point <br> Estimate')
55862   FORMAT('         Standard <br> Error')
 5863   FORMAT('         Lower <br>Confidence Limit')
 5864   FORMAT('         Upper <br>Confidence Limit')
 5870   FORMAT('      <TD COLSPAN=5>')
 5872   FORMAT('         <HR WIDTH=600>')
C
        WRITE(ICOUT,5199)
 5199   FORMAT('<PRE>')
        CALL DPWRST('XXX','WRIT')
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001   FORMAT(A1,'end{verbatim}')
 8003   FORMAT(A1,'begin{table}')
 8004   FORMAT(A1,'end{table}')
 8005   FORMAT('{',A1,'bf Lognormal Maximum Likelihood ',
     1         'Estimation: Time (Singly) Censored Case}')
 8007   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009   FORMAT(A1,'begin{center}')
 8011   FORMAT(5X,'{',A1,'bf Two-Parameter Model ($',A1,
     1         'mu$ = 0 Case)}')
 8013   FORMAT(A1,'end{center}')
 8015   FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020   FORMAT(5X,A1,'begin{tabular} {lr}')
 8021   FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022   FORMAT(5X,'Number of Failure Times: & ',I8,2X,A1,A1)
 8023   FORMAT(5X,'Minimum of Failure Times: & ',G15.7,2X,A1,A1)
 8024   FORMAT(5X,'Mean of Failure Times: & ',G15.7,2X,A1,A1)
 8025   FORMAT(5X,'Standard Deviation of Failure Times: & ',
     1         G15.7,2X,A1,A1)
 8026   FORMAT(5X,'ML Estimate of Shape Parameter: & ',G15.7,2X,A1,A1)
 8027   FORMAT(5X,'Standard Error of Shape Parameter: & ',
     1         G15.7,2X,A1,A1)
 8028   FORMAT(5X,'ML Estimate of Scale Parameter: & ',G15.7,2X,A1,A1)
 8029   FORMAT(5X,'ML Estimate of $',A1, 
     1         'mu$ = (LOG(Scale Parameter)): & ',
     1         G15.7,2X,A1,A1)
 8030   FORMAT(5X,'Standard Error of Scale/$',A1,'mu$ Parameter: & ',
     1         G15.7,2X,A1,A1)
 8031   FORMAT(5X,'Standard Error of Covariance of Scale and Shape ',
     1         'Parameter: & ',G15.7,2X,A1,A1)
 8035   FORMAT(5X,' & ',2X,A1,A1)
 8049   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)IR,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)AMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)AMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)ASD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8035)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)SIGMML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)SIGMSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)SCALML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC,UHATML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC,SCALSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)COVSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8093   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for Scale Parameter ',
     1       '(Normal Approximation)}')
 8112 FORMAT(5X,'{',A1,'bf Confidence Limits for Scale Parameter ',
     1       '(Likelihood Ratio)}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8111)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120   FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper & Lower & Upper ',
     1         2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit & Limit & Limit',
     1         2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,' & ',G15.7,' & ',
     1         G15.7,2X,A1,A1)
 8126   FORMAT(5X,'& ',A1,'multicolumn{2}{c}{Normal Approximation}',
     1         ' & ',A1,'multicolumn{2}{c}{Likelihood Ratio}',
     1         2X,A1,A1)
 8226   FORMAT(5X,'& ',A1,'multicolumn{2}{c}{Scale}',
     1         ' & ',A1,'multicolumn{2}{c}{$',A1,'mu$}',
     1         2X,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8226)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8130I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWSC(I),AUPPSC(I),ALOWUH(I),
     1                     AUPPUH(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8130   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8191   FORMAT(A1,'end{table}')
 8193   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
CCCCC   WRITE(ICOUT,8003)IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8112)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8226)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8230I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWS2(I),AUPPS2(I),ALOWU2(I),
     1                     AUPPU2(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8230   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8191)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8211 FORMAT(5X,'{',A1,'bf Confidence Limits for Shape Parameter}')
C
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8211)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8126)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8250I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWSI(I),AUPPSI(I),ALOWG2(I),
     1                     AUPPG2(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8250   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8191)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C WRITE SELECTED PERCENTILES (IF ANY)
C
        IF(NPERC.GT.0)THEN
C
          CALL DPCONA(92,IBASLC)
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8803)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8810)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8811)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8812)IBASLC,IBASLC,ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8813)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8820)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8821)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8822)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,
     1                     IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8840)IBASLC
          CALL DPWRST('XXX','WRIT')
          DO8830I=1,NPERC
            WRITE(ICOUT,8823)QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),
     1                       XQPUCL(I),IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
 8830     CONTINUE
          WRITE(ICOUT,8849)IBASLC
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8891)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8893)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
 8801   FORMAT(A1,'end{verbatim}')
 8803   FORMAT(A1,'begin{table}')
 8807   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8809   FORMAT(A1,'begin{center}')
 8810   FORMAT(5X,'{',A1,'bf Confidence Limits for Selected ',
     1         'Percentiles}',2X,A1,A1)
 8811   FORMAT(5X,'{',A1,'bf (Based on Normal Approximation)}',2X,A1,A1)
 8812   FORMAT(5X,'{',A1,'bf $',A1,'alpha$ = ',F7.3,'}')
 8813   FORMAT(A1,'end{center}')
 8815   FORMAT(5X,'} ',A1,A1)
 8820   FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8821   FORMAT(5X,' & {',A1,'bf Point} & {',A1,'bf Standard} & {',A1,
     1         'bf Lower} & {',A1,'bf Upper}',2X,A1,A1)
 8822   FORMAT(5X,'{',A1,'bf Percentile} & {',A1,'bf Estimate} & {',
     1         A1,'bf Error} & {',
     1         A1,'bf Confidence Limit} & {',A1,
     1         'bf Confidence Limit}',2X,A1,A1)
 8823   FORMAT(5X,G15.7,' & ',G15.7,' & ',G15.7,' & ',G15.7,
     1         ' & ',G15.7,2X,A1,A1)
 8840   FORMAT(5X,A1,'hline')
 8849   FORMAT(A1,'end{tabular}')
 8891   FORMAT(A1,'end{center}')
 8893   FORMAT(A1,'end{table}')
C
 8899   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8899)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(6X,'LOGNORMAL MAXIMUM LIKELIHOOD ESTIMATION:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4212)
 4212   FORMAT(6X,'TIME (SINGLY) CENSORED CASE')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4213)
 4213   FORMAT('TWO-PARAMETER MODEL (LOCATION = 0)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4215)N
 4215   FORMAT('NUMBER OF OBSERVATIONS                            = ',
     1         I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4216)IR
 4216   FORMAT('NUMBER OF FAILURE TIMES                           = ',
     1         I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4217)AMIN
 4217   FORMAT('MINIMUM OF FAILURE TIMES                          = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4218)AMEAN
 4218   FORMAT('MEAN OF FAILURE TIMES                             = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4219)ASD
 4219   FORMAT('STANDARD DEVIATION OF FAILURE TIMES               = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4227)SIGMML
 4227   FORMAT('ML ESTIMATE OF SHAPE PARAMETER                    = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4229)SIGMSE
 4229   FORMAT('STANDARD ERROR OF SHAPE PARAMETER                 = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)SCALML
 4223   FORMAT('ML ESTIMATE OF SCALE PARAMETER                    = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4224)UHATML
 4224   FORMAT('ML ESTIMATE OF MU (=LOG(SCALE)) PARAMETER         = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)SCALSE
 4225   FORMAT('STANDARD ERROR OF SCALE/MU PARAMETER              = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4231)COVSE
 4231   FORMAT('COVARIANCE OF THE SHAPE AND SCALE PARAMETERS      = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4240)
 4240   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER (NORMAL ',
     1         'APPROXIMATION)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)
 4242   FORMAT('                              SCALE        ',
     1         '                   MU       ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)
 4243   FORMAT('   CONFIDENCE           LOWER         UPPER',
     1         '         LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)
 4245   FORMAT('   VALUE (%)            LIMIT         LIMIT',
     1         '         LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4246)
 4246   FORMAT('---------------------------------------------------',
     1         '--------------------')
        CALL DPWRST('XXX','WRIT')
        DO4249I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4247)ATEMP,ALOWSC(I),AUPPSC(I),ALOWUH(I),
     1                     AUPPUH(I)
 4247     FORMAT('   ',F8.3,10X,4(G12.6,2X))
          CALL DPWRST('XXX','WRIT')
 4249   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4260)
 4260   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER (LIKELIHOOD ',
     1         'RATIO)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4246)
        CALL DPWRST('XXX','WRIT')
        DO4269I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4247)ATEMP,ALOWS2(I),AUPPS2(I),ALOWU2(I),
     1                     AUPPU2(I)
          CALL DPWRST('XXX','WRIT')
 4269   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4252)
 4252   FORMAT('CONFIDENCE INTERVAL FOR SHAPE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4254)
 4254   FORMAT('                       NORMAL APPROXIMATION',
     1         '            LIKELIHOOD RATIO')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4246)
        CALL DPWRST('XXX','WRIT')
        DO4259I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4247)ATEMP,ALOWSI(I),AUPPSI(I),ALOWG2(I),
     1                     AUPPG2(I)
          CALL DPWRST('XXX','WRIT')
 4259   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,4911)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4915)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4921)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4922)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4346)
          CALL DPWRST('XXX','WRIT')
C
 4911   FORMAT('CONFIDENCE LIMITS (BASED ON NORMAL APPROXIMATION) FOR ',
     1         'SELECTED PERCENTILES:')
 4915   FORMAT('ALPHA = ',F7.4)
 4921   FORMAT(10X,'      POINT     ','  STANDARD   ',
     1             '        LOWER     ', '       UPPER')
 4922   FORMAT('PERCENTILE','   ESTIMATE   ','      ERROR     ',
     1         'CONFIDENCE LIMIT ',' CONFIDENCE LIMIT')
 4346   FORMAT('-----------------------------------',
     1         '-----------------------------------')
C
          DO4981I=1,NPERC
            WRITE(ICOUT,4932)QP(I),XQPHAT(I),XQPSE(I),
     1                       XQPLCL(I),XQPUCL(I)
 4932       FORMAT(2X,F8.4,2G15.7,2X,G15.7,2X,G15.7)
            CALL DPWRST('XXX','WRIT')
 4981     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,4291)
 4291     FORMAT('THE FOLLOWING INTERNAL PARAMETERS ARE SAVED:')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4293)
 4293     FORMAT('      SIGMAML, SIGMASE, SCALEML, UHATML, SCALESE, ',
     1           'COVSE')
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLL2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLL2--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLMX(Y,N,AMXMIN,
     1XTEMP,MAXNXT,
     1ALOCML,SCALEML,ALOCM2,SCALEM2,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR THE MAXWELL DISTRIBUTION
C     EXAMPLE--MAXWELL MAXIMUM LIKELIHOOD Y
C     REFERENCE--"CONTINUOUS UNIVARIATE DISTRIBUTIONS--VOLUME 1",
C                SECOND EDITION, JOHNSON, KOTZ, AND BALAKRISHNAN,
C                WILEY, 1994, P. 453.
C                THE MAXIMUM LIKELIHOOD ESTIMATE OF SCALE IS:
C
C                    SIGMAHAT = SQRT(SUM[i=1 to n][X(i)**2]/(3*N)]
C
C                WITH N DENOTING THE SAMPLE SIZE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/6
C     ORIGINAL VERSION--JUNE      2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*1 IBASLC
C
      DOUBLE PRECISION DSUM
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION DTEMP
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
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='DPML'
      ISUBN2='MX  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLMX')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLMX--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLMX')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN MAXWELL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS NON-POSITIVE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)N
 1112   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR FROM MAXWELL MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
C               **********************************
C               **  STEP 21--                   **
C               **  CARRY OUT CALCULATIONS      **
C               **  FOR MAXWELL           MLE   **
C               **  ESTIMATE (FULL SAMPLE CASE) **
C               **********************************
C
 2100 CONTINUE
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLMX')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
C
      IWRITE='OFF'
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
C
      IF(AMXMIN.NE.CPUMIN)THEN
        IF(AMXMIN.LE.XMIN)THEN
          ALOCML=AMXMIN
        ELSE
          ALOCML=XMIN
        ENDIF
      ELSE
        ALOCML=XMIN
      ENDIF
      AZERO=0.0
      IF(XMIN.LT.0.0)AZERO=XMIN
      ALOCM2=AZERO
C
      DSUM=0.0D0
      DSUM2=0.0D0
      DO2110I=1,N
        DSUM=DSUM + DBLE(Y(I) - ALOCML)**2
        DSUM2=DSUM2 + DBLE(Y(I) - AZERO)**2
 2110 CONTINUE
      DTEMP=DSQRT(DSUM/(3.0D0*DBLE(N)))
      SCALEML=REAL(DTEMP)
      DTEMP=DSQRT(DSUM2/(3.0D0*DBLE(N)))
      SCALEM2=REAL(DTEMP)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Maxwell Parameter Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=250>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5060   FORMAT('         Summary Statistics:')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Mean:')
 5063   FORMAT('         Sample Standard Deviation:')
 5064   FORMAT('         Sample Minimum:')
 5065   FORMAT('         Sample Maximum:')
 5066   FORMAT('         Maximum Likelihood Estimates:<br>')
 5067   FORMAT('         (Location = Data Minimum)')
 5068   FORMAT('         (Location = User Specified)')
 5069   FORMAT('         (Location = Zero)')
 5071   FORMAT('         Estimate for Location Parameter:')
 5072   FORMAT('         Estimate of Scale ',
     1         'Parameter:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        IF(XMIN.EQ.ALOCML)THEN
          WRITE(ICOUT,5067)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,5068)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALOCML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALEML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALOCM2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALEM2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Maxwell Parameter Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8031 FORMAT(5X,'Estimate of Location Parameter: & ',G15.7,2X,A1,A1)
 8032 FORMAT(5X,'Maximum Likelihood Estimate of Scale Parameter: & ',
     1       G15.7,2X,A1,A1)
 8027 FORMAT(5X,' & ',2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)ALOCML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)SCALEML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)ALOCM2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)SCALEM2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{center}')
 8093 FORMAT(A1,'end{table}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4101)
 4101   FORMAT(12X,'MAXWELL PARAMETER ESTIMATION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4110)
 4110   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4111)N
 4111   FORMAT('THE NUMBER OF OBSERVATIONS        = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4113)XMEAN
 4113   FORMAT('THE SAMPLE MEAN                   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4115)XSD
 4115   FORMAT('THE SAMPLE STANDARD DEVIATION     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4117)XMIN
 4117   FORMAT('THE SAMPLE MINIMUM                = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4118)XMAX
 4118   FORMAT('THE SAMPLE MAXIMUM                = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(ALOCML.EQ.XMIN)THEN
          WRITE(ICOUT,4120)
 4120     FORMAT('MAXIMUM LIKELIHOOD ESTIMATES (LOCATION = ',
     1           'DATA MINIMUM:')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4122)
 4122     FORMAT('MAXIMUM LIKELIHOOD ESTIMATES (LOCATION = ',
     1           'USER SPECIFIED:')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,4126)ALOCML
 4126   FORMAT('ESTIMATE OF LOCATION PARAMETER    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4128)SCALEML
 4128   FORMAT('ESTIMATE OF SCALE PARAMETER    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4130)
 4130   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES (LOCATION = ZERO:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4126)ALOCM2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4128)SCALEM2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4131)
 4131   FORMAT(6X,'THE LOCATION AND SCALE PARAMETERS WILL BE SAVED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4133)
 4133   FORMAT('AS THE INTERNAL PARAMETERS LOCML, SCALEML, ',
     1        'LOCM2, AND SCALEM2.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLMX')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLMX--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLNB(Y,N,AK,
     1XTEMP,MAXNXT,
     1PMOM,AKMOM,PML,PMLBC,PMLBCV,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES AND METHOD OF MOMENT ESTIMATES FOR
C              NEGATIVE BINOMIAL DISTRIBUTION.  THE METHOD OF
C              MOMENT ESTIMATES ARE:
C                 PHAT = ((S**2/XBAR) -1)
C                 KHAT = XBAR**2/(S**2 - XBAR)
C              WITH XBAR AND S**2 DENOTING THE SAMPLE MEAN AND
C              VARIANCE, RESPECTIVELY.  THE MAXIMUM LIKELIHOOD
C              ESTIMATE OF P (ASSUMING K IS KNOWN) IS:
C                  PHAT = XBAR/(K + XBAR)
C              FOR ML, WE ALLOW USER TO SPECIFY K.  IF K IS NOT
C              SPECIFIED, THEN USE THE MOMENT ESTIMATOR FOR K.
C     EXAMPLE--NEGATIVE BINOMIAL MAXIMUM LIKELIHOOD Y
C     REFERENCE--"UNIVARIATE DISCRETE DISTRIBUTIONS", SECOND EDITION,
C                JOHNSON, KOTZ, AND KEMP, WILEY, PP. 202.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/3
C     ORIGINAL VERSION--MARCH     2004.
C     UPDATED         --AUGUST    2005. REFORMAT OUTPUT FOR
C                                       CONSISTENCY WITH OTHER ML
C                                       ROUTINES
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*1 IBASLC
C
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
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='DPML'
      ISUBN2='NB  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLNB')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLNB--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN NEGATIVE BINOMIAL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS NON-POSITIVE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** WARNING FROM NEGATIVE BINOMIAL MAXIMUM ',
     1       'LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
 1139 CONTINUE
C
C               ******************************************
C               **  STEP 41--                           **
C               **  CARRY OUT CALCULATIONS              **
C               **  FOR NEGATIVE BINOMIAL MLE ESTIMATE  **
C               ******************************************
C
 2100 CONTINUE
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLNB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
C
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
C
      DO2105I=1,N
        ITEMP=INT(Y(I)+0.5)
        Y(I)=REAL(ITEMP)
 2105 CONTINUE
      IF(XMIN.LT.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2111)
 2111   FORMAT('***** ERROR FROM NEGATIVE BINOMIAL MAXIMUM ',
     1         'LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2113)
 2113   FORMAT('      NEGATIVE VALUE ENCOUNTERED.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      AKMOM=XMEAN*XMEAN/(XSD*XSD - XMEAN)
      PMOM=((XSD*XSD/XMEAN) - 1.0)
      PMLBC=0.0
      PMLBCV=0.0
      IF(AK.GT.0)THEN
        PML=AK/(XMEAN+AK)
        IF(AK.GE.2.0)THEN
          PMLBC=(AK-1.0)/(XMEAN+AK-1.0)
          PMLBCV=(1.0/REAL(N))*PMLBC*PMLBC*(1.0-PMLBC)/
     1           (AK-1.0-PMLBC)
        ENDIF
      ELSE
        PML=AKMOM/(XMEAN+AKMOM)
        IF(AKMOM.GE.2.0)THEN
          PMLBC=(AKMOM-1.0)/(XMEAN+AKMOM-1.0)
          PMLBCV=(1.0/REAL(N))*PMLBC*PMLBC*(1.0-PMLBC)/
     1           (AKMOM-1.0-PMLBC)
        ENDIF
      ENDIF
C
C               ******************************************
C               **   STEP 42--                          **
C               **   WRITE OUT EVERYTHING               **
C               **   FOR NEGATIVE BINOMIAL MLE ESTIMATE **
C               ******************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Negative Binomial  Parameter ',
     1         'Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=250>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5060   FORMAT('         Summary Statistics::')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Mean:')
 5063   FORMAT('         Sample Standard Deviation:')
 5064   FORMAT('         Sample Minimum:')
 5065   FORMAT('         Sample Maximum:')
 5066   FORMAT('         Method of Moment Estimates:')
 5067   FORMAT('         Estimate of <i>k</i>:')
 5068   FORMAT('         Estimate of <i>p</i>:')
 5069   FORMAT('         Maximum Likelihood Estimates')
 5070   FORMAT('         Value for <i>k</i> (User-Specified):')
 5071   FORMAT('         Value for <i>k</i> (Method of Moments):')
 5072   FORMAT('         Bias Corrected Estimate of <i>p</i>:')
 5073   FORMAT('         Sampling Variance of Bias Corrected Estimate ',
     1         'of <i>p</i>:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AKMOM
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)PMOM
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        IF(AK.GT.0.0)THEN
          AKTEMP=AK
          WRITE(ICOUT,5070)
        ELSE
          AKTEMP=AKMOM
          WRITE(ICOUT,5071)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AKTEMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)PML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        AKTEMP=AK
        IF(AKTEMP.LE.0.0)AKTEMP=AKMOM
        IF(AKTEMP.GE.2.0)THEN
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5072)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)PMLBC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5073)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)PMLBCV
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Negative Binomial Parameter ',
     1       'Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Summary Statistics: & ',2X,A1,A1)
 8022 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8023 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,' & ',2X,A1,A1)
 8028 FORMAT(5X,'Method of Moment Estimates: & ',2X,A1,A1)
 8029 FORMAT(5X,'Maximum Likelihood Estimates: & ',2X,A1,A1)
 8030 FORMAT(5X,'Estimate of k: ',G15.7,2X,A1,A1)
 8031 FORMAT(5X,'Estimate of p: ',G15.7,2X,A1,A1)
 8032 FORMAT(5X,'Value for k (User-Specified): ',G15.7,2X,A1,A1)
 8033 FORMAT(5X,'Value for k (Method of Moments): ',G15.7,2X,A1,A1)
 8034 FORMAT(5X,'Bias Corrected Estimate of p: ',G15.7,2X,A1,A1)
 8035 FORMAT(5X,'Sampling Variance of Bias Corrected Estimate: ',
     1       G15.7,2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)AKMOM,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)PMOM,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8029)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(AK.GT.0)THEN
          WRITE(ICOUT,8032)AK,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8033)AKMOM,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8031)PML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        AKTEMP=AK
        IF(AKTEMP.LE.0.0)AKTEMP=AKMOM
        IF(AKTEMP.GE.2.0)THEN
          WRITE(ICOUT,8034)PMLBC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8035)PMLBCV,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{center}')
 8093 FORMAT(A1,'end{table}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4301)
 4301   FORMAT(12X,'NEGATIVE BINOMIAL PARAMETER ESTIMATION:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4310)
 4310   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4311)N
 4311   FORMAT('NUMBER OF OBSERVATIONS             = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4313)XMEAN
 4313   FORMAT('SAMPLE MEAN                        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4315)XSD
 4315   FORMAT('SAMPLE STANDARD DEVIATION          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4317)XMIN
 4317   FORMAT('SAMPLE MINIMUM                     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4319)XMAX
 4319   FORMAT('SAMPLE MAXIMUM                     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4320)
 4320   FORMAT('METHOD OF MOMENT ESTIMATES:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4323)AKMOM
 4323   FORMAT('ESTIMATE OF K                      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4325)PMOM
 4325   FORMAT('ESTIMATE OF P                      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4330)
 4330   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES:')
        CALL DPWRST('XXX','WRIT')
        IF(AK.GT.0)THEN
          WRITE(ICOUT,4331)
 4331     FORMAT('VALUE OF K (USER-SPECIFIED)        = ',G15.7)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4333)
 4333     FORMAT('VALUE OF K (METHOD OF MOMENT)      = ',G15.7)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,4335)PML
 4335   FORMAT('ESTIMATE OF P                      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        AKTEMP=AK
        IF(AKTEMP.LE.0.0)AKTEMP=AKMOM
        IF(AKTEMP.GE.2.0)THEN
          WRITE(ICOUT,4337)PMLBC
 4337     FORMAT('BIAS CORRECTED ESTIMATE OF P       = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4339)PMLBCV
 4339     FORMAT('SAMPLING VARIANCE OF P             = ',G15.7)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4341)
 4341   FORMAT('PMOM, KMOM, PML, PMLBC, PMLVAR WILL BE SAVED AS ',
     1         'INTERNAL PARAMETERS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLNB')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLNB--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLNM(Y,X,N,NVAR,Y2,X2,N2,
     1TEMP1,TEMP2,WORK,ITEMP1,MAXNXT,
     1CLLIMI,CLWIDT,NCOMP,
     1TEMP5,IHSTCW,MAXOBV,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR THE NORMAL MIXTURE DISTRIBUTION.
C              IT USES APPLIED STATISTICS ALGORITHM 203 TO
C              PERFORM THE MAXIMUM LIKELIHOOD ESTIMATION.
C
C              THERE ARE TWO CASES:
C
C              1) ONE VARIABLE CASE: Y IS RAW DATA
C                 A) CALL DPBIN TO BIN DATA
C                 B) IF USER HAS SPECIFIED CLASS LIMITS OR WIDTH,
C                    PASS TO DPBIN.
C              2) TWO VARIABLE CASE: Y IS FREQUENCY, X IS CLASS
C                 MID-POINT.
C
C              NCOMP DEFINES NUMBER OF NORMAL DISTRIBUTIONS BEING
C              FIT.  MAXIMUM OF 20 ALLOWED.
C
C     EXAMPLE--NORMAL MIXTURE MAXIMUM LIKELIHOOD Y
C            --NORMAL MIXTURE MAXIMUM LIKELIHOOD Y X
C     REFERENCE--"MAXIMUM LIKELIHOOD ESTIMATION OF MIXTURES OF
C                DISTRIBUTIONS", M. AGHA AND T. IBRAHIM,
C                APPLIED STATISTICS, 1984, VOLUME 33, NO. 3,
C                PP. 327-329.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBUG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/8
C     ORIGINAL VERSION--AUGUST    2004.
C     UPDATED         --MARCH     2006. SUPPORT FOR DIFFERENT DEFAULT
C                                       BINNING ALGORITHMS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-----------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IHSTCW
      CHARACTER*4 IRELAT
      CHARACTER*4 IRHSTG
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
C
      INCLUDE 'DPCOF2.INC'
C
      CHARACTER*4 ISUBN0
C
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IERRF1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
C
C-------------------------------------------------------------------
C
      PARAMETER (KMAX=20)
      PARAMETER (MMAX=200)
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION TEMP1(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP5(*)
      DIMENSION CLLIMI(*)
      DIMENSION CLWIDT(*)
      INTEGER   ITEMP1(*)
C
      REAL TOL
C
      REAL ALPHA(KMAX)
      REAL XMEAN(KMAX)
      REAL XSD(KMAX)
C
C  FOR STORAGE EFFICIENCY, USE SINGLE "WORK" ARRAY FOR FOLLOWING.
C  TO AVOID CONFUSION, LEAVE ALPHA, XMEAN, AND XSD AS DISTINCT
C  ARRAYS (THESE TAKE A MINIMAL AMOUNT OF STORAGE, SINCE THESE
C  REFERENCED IN THIS ROUTINE, KEEP CLARITY IN CODE)
C
      DIMENSION WORK(*)
C
CCCCC REAL NEWALP(KMAX)
CCCCC REAL NEWMEA(KMAX)
CCCCC REAL NEWSD(KMAX)
CCCCC REAL DT(KMAX)
CCCCC REAL NT(KMAX)
CCCCC REAL VT(KMAX)
CCCCC REAL G(MMAX)
CCCCC REAL F(MMAX,KMAX)
C
CCCCC EQUIVALENCE(NEWALP(1), WORK(1))
CCCCC EQUIVALENCE(NEWMEA(1), WORK(KMAX + 1))
CCCCC EQUIVALENCE(NEWSD(1),  WORK(2*KMAX + 1))
CCCCC EQUIVALENCE(DT(1),     WORK(3*KMAX + 1))
CCCCC EQUIVALENCE(NT(1),     WORK(4*KMAX + 1))
CCCCC EQUIVALENCE(VT(1),     WORK(5*KMAX + 1))
CCCCC EQUIVALENCE(G(1),      WORK(6*KMAX + 1))
CCCCC EQUIVALENCE(F(1,1),    WORK(7*KMAX + 1))
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='DPML'
      ISUBN2='NM  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLNM')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLNM--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,NCOMP,NVAR
   55   FORMAT('N,NCOMP,NVAR = ',3I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,N
          WRITE(ICOUT,57)I,Y(I),X(I)
   57     FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN NORMAL MIXTURE ',
     1         'MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS LESS THAN 3')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(NCOMP.LT.2 .OR. NCOMP.GT.KMAX)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1121)
 1121   FORMAT('***** ERROR IN NORMAL MIXTURE ',
     1         'MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1123)
 1123   FORMAT('      THE SPECIFIED NUMBER OF COMPONENT ',
     1         'DISTRIBUTIONS IS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1125)KMAX
 1125   FORMAT('      LESS THAN 2 OR GREATER THAN ',I8,'.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1127)NCOMP
 1127   FORMAT('      NUMBER OF COMPONENTS = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      IF(NVAR.EQ.1)THEN
        HOLD=Y(1)
        DO1135I=2,N
          IF(Y(I).NE.HOLD)GOTO1139
 1135   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1131)
 1131   FORMAT('***** ERROR IN NORMAL MIXTURE ',
     1         'MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1133)HOLD
 1133   FORMAT('      HAS ALL ELEMENTS = ',E15.7)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
 1139   CONTINUE
C
CCCCC   DO1145I=1,N
CCCCC     IF(Y(I).LE.0.0)THEN
CCCCC       WRITE(ICOUT,999)
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,1147)
C1147       FORMAT('***** ERROR IN NORMAL MIXTURE MAXIMUM ',
CCCCC1             'LIKELIHOOD ESTIMATION')
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       WRITE(ICOUT,1148)I,Y(I)
C1148       FORMAT('      ROW ',I8,' IS NON-POSITIVE (VALUE = ',
CCCCC1             G15.7,')')
CCCCC       CALL DPWRST('XXX','WRIT')
CCCCC       IERROR='YES'
CCCCC       GOTO9000
CCCCC     ENDIF
C1145   CONTINUE
C
        CALL SORT(Y,N,TEMP2)
        DO1160I=1,N
          Y(I)=TEMP2(I)
 1160   CONTINUE
C
      ELSEIF(NVAR.EQ.2)THEN
        CALL SORTC(X,Y,N,TEMP1,TEMP2)
        DO1210I=1,N
          X(I)=TEMP1(I)
          Y(I)=TEMP2(I)
 1210   CONTINUE
C
        DO1220I=1,N
          IF(Y(I).LT.0.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1221)
 1221       FORMAT('***** ERROR IN NORMAL MIXTURE ',
     1             'MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1223)
 1223       FORMAT('      A NEGATIVE FREQUENCY WAS SPECIFIED.')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1225)I,Y(I)
 1225       FORMAT('      ROW ',I8,' (AFTER SORTING) HAS FREQUENCY ',
     1             G15.7)
            CALL DPWRST('XXX','WRIT')
          ENDIF
 1220   CONTINUE
      ENDIF
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLNM')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1301)N
 1301   FORMAT('AFTER SORT, N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO1310I=1,MAX(N,100)
          WRITE(ICOUT,1311)I,X(I),Y(I)
 1311     FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
          CALL DPWRST('XXX','WRIT')
 1310   CONTINUE
      ENDIF
C
C               *****************************************
C               **  STEP 21--                          **
C               **  CARRY OUT CALCULATIONS             **
C               **  FOR NORMAL MIXTURE MLE ESTIMATION  **
C               *****************************************
C
 2100 CONTINUE
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      TOL=1.0E-6
      IA = 1
      K = NCOMP
      IC = 0
C
      IF(NVAR.EQ.1)THEN
        NTOT=N
        CALL MEAN(Y,N,IWRITE,AMEAN,IBUGA3,IERROR)
        CALL SD(Y,N,IWRITE,ASD,IBUGA3,IERROR)
        AMIN=Y(1)
        AMAX=Y(N)
        IRELAT='OFF'
        IRHSTG='PERC'
        CLWID=CLWIDT(1)
        CALL DPBIN(Y,N,IRELAT,CLWID,CLLIMI(1),CLLIMI(2),IRHSTG,
     1             TEMP5,MAXOBV,IHSTCW,
     1             Y2,X2,N2,IBUGA3,IERROR)
C
        M=N2
        DO2210I=1,N2
          ITEMP1(I)=INT(Y2(I)+0.5)
 2210   CONTINUE
C
      ELSE
        M=N
        DO2310I=1,M
          ITEMP1(I)=INT(Y(I)+0.5)
          X2(I)=X(I)
 2310   CONTINUE
        AMIN=X2(1)
        AMAX=X2(M)
        DSUM1=0.0D0
        NTOT=0
        DO2220I=1,M
          NTOT=NTOT + ITEMP1(I)
          DSUM1= DSUM1 + DBLE(ITEMP1(I))*DBLE(X2(I))
 2220   CONTINUE
        AMEAN=REAL(DSUM1/DBLE(NTOT))
        DSUM1=0.0D0
        DO2230I=1,M
          TERM1=X2(I) - AMEAN
          DSUM1= DSUM1 + DBLE(ITEMP1(I))*(DBLE(TERM1)**2)
 2230   CONTINUE
        ASD=REAL(DSUM1/DBLE(NTOT))
      ENDIF
C
      ACOMP=REAL(NCOMP)
      PTEMP=1.0/ACOMP
      DO2410I=1,NCOMP
        ALPHA(I)=PTEMP
        XSD(I)=ASD
        XMEAN(I)=AMIN + REAL(I)*PTEMP*(AMAX-AMIN)
 2410 CONTINUE
      XMEAN(NCOMP)=XMEAN(NCOMP) - 0.5*PTEMP*(AMAX-AMIN)
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLNM')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        DO2412I=1,M
          WRITE(ICOUT,2411)I,X2(I),ITEMP1(I)
 2411     FORMAT('I,X2(I),ITEMP1(I) = ',I8,G15.7,I8)
          CALL DPWRST('XXX','WRIT')
 2412   CONTINUE
      ENDIF
C
      CALL MIXTUR(IA,K,M,IC,X2,ITEMP1,
     1            ALPHA,XMEAN,XSD,TOL,NTOT,
CCCCC1            NEWALP,NEWMEA,NEWSD,DT,NT,VT,G,F,KMAX,MMAX,
     1            WORK(1),WORK(KMAX+1),WORK(2*KMAX+1),WORK(3*KMAX+1),
     1            WORK(4*KMAX+1),WORK(5*KMAX+1),WORK(6*KMAX+1),
     1            WORK(7*KMAX+1),
     1            KMAX,MMAX,
     1            ALOGL,ICOUNT,IFAULT)
C
      IF(IFAULT.EQ.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2011)
 2011   FORMAT('**** ERROR: FOR NORMAL MIXTURE MAXIMUM LIKELIHOOD ',
     1         'ESTIMATION,')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2013)
 2013   FORMAT('     AN INVALID  CHOICE FOR DISTRIBUTION WAS MADE.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2015)
 2015   FORMAT('     VALUE OF IA = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSEIF(IFAULT.EQ.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2021)
 2021   FORMAT('**** ERROR: FOR NORMAL MIXTURE MAXIMUM LIKELIHOOD ',
     1         'ESTIMATION,')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2023)
 2023   FORMAT('     A MIXING PARAMETER OUTSIDE THE (0,1] ',
     1         'INTERVAL WAS SPECIFIED.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSEIF(IFAULT.EQ.3)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2031)
 2031   FORMAT('**** ERROR: FOR NORMAL MIXTURE MAXIMUM LIKELIHOOD ',
     1         'ESTIMATION,')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2033)
 2033   FORMAT('     MEAN IS OUTSIDE THE RANGE OF THE DATA.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSEIF(IFAULT.EQ.4)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2041)
 2041   FORMAT('**** ERROR: FOR NORMAL MIXTURE MAXIMUM LIKELIHOOD ',
     1         'ESTIMATION,')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2043)
 2043   FORMAT('     A NON-POSITIVE STANDARD DEVIATION WAS ',
     1         'SPECIFIED.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSEIF(IFAULT.EQ.5)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2051)
 2051   FORMAT('**** ERROR: FOR NORMAL MIXTURE MAXIMUM LIKELIHOOD ',
     1         'ESTIMATION,')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2053)
 2053   FORMAT('     INPUT DATA WAS NOT SORTED.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSEIF(IFAULT.EQ.6)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2061)
 2061   FORMAT('**** ERROR: FOR NORMAL MIXTURE MAXIMUM LIKELIHOOD ',
     1         'ESTIMATION,')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2063)
 2063   FORMAT('     A NEGATIVE FREQUENCY WAS SPECIFIED OR THE ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2065)
 2065   FORMAT('     TOTAL FREQUENCY IS LESS THAN 2 TIMES THE ',
     1         'NUMBER OF CLASSES.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSEIF(IFAULT.EQ.7)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2071)
 2071   FORMAT('**** ERROR: FOR NORMAL MIXTURE MAXIMUM LIKELIHOOD ',
     1         'ESTIMATION,')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2073)
 2073   FORMAT('     NEGATIVE FREQUENCY SPECIFIED FOR NON-NORMAL ',
     1         'DISTRIBUTION.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSEIF(IFAULT.EQ.8)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2081)
 2081   FORMAT('**** ERROR: FOR NORMAL MIXTURE MAXIMUM LIKELIHOOD ',
     1         'ESTIMATION,')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2083)
 2083   FORMAT('     EQUAL MEANS SPECIFIED FOR NON-NORMAL ',
     1         'DISTRIBUTION.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSEIF(IFAULT.EQ.9)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2091)
 2091   FORMAT('**** ERROR: FOR NORMAL MIXTURE MAXIMUM LIKELIHOOD ',
     1         'ESTIMATION,')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2093)
 2093   FORMAT('     ALL MEANS AND ALL STANDARD DEVIATIONS ',
     1         'WERE SPECIFIED EQUAL.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='MLNM'
      IERRF1='NO'
C
      IREWI1='ON'
      CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      DO2300I=1,NCOMP
        WRITE(IOUNI1,2301)ALPHA(I),XMEAN(I),XSD(I)
 2300 CONTINUE
 2301 FORMAT(3(E15.7,1X))
C
      IENDF1='OFF'
      IREWI1='ON'
      CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
C
C               ***********************************************
C               **   STEP 42--                               **
C               **   WRITE OUT EVERYTHING                    **
C               **   FOR NORMAL MIXTURE MLE ESTIMATION       **
C               ***********************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Normal Mixture Maximum ',
     1         'Likelihood Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=350>')
 5044   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM COLSPAN=2>')
 5045   FORMAT('         Number of Observations:')
 5061   FORMAT('         Sample Mean:')
 5062   FORMAT('         Sample Standard Deviation:')
 5063   FORMAT('         Sample Minimum:')
 5064   FORMAT('         Sample Maximum:')
 5065   FORMAT('         Number of Components:')
 5066   FORMAT('         <b>Maximum Likelihood Estimates of ',
     1         'Component ',I8,'</b>')
 5067   FORMAT('         Maximum Likelihood Estimate of Mixing ',
     1         'Proportion:')
 5068   FORMAT('         Maximum Likelihood Estimate of Mean:')
 5069   FORMAT('         Maximum Likelihood Estimate of Standard ',
     1         'Deviation:')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5056   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp;')
 5059   FORMAT('   </TR>')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5045)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ASD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)NCOMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        DO5080I=1,NCOMP
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5055)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5055)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5044)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5066)I
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5067)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)ALPHA(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5068)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)XMEAN(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5069)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)XSD(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
 5080 CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Normal Mixture ',
     1       'Maximum Likelihood Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Number of Components: & ',I8,2X,A1,A1)
 8027 FORMAT(5X,'{',A1,'bf Maximum Likelihood Estimates of ',
     1       'Component ',I2,'} & ',2X,A1,A1)
 8028 FORMAT(5X,'Estimate of Mixing Proportion: & ',
     1       G15.7,2X,A1,A1)
 8029 FORMAT(5X,'Estimate of Mean: & ',
     1       G15.7,2X,A1,A1)
 8030 FORMAT(5X,'Estimate of Standard Deviation: & ',
     1       G15.7,2X,A1,A1)
 8039 FORMAT(5X,' & ',2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)AMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)ASD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)AMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)AMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)NCOMP,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8035I=1,NCOMP
          WRITE(ICOUT,8039)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8027)IBASLC,I,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8028)ALPHA(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8029)XMEAN(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8030)XSD(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8035   CONTINUE
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{table}')
 8093 FORMAT(A1,'end{center}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(10X,
     1  'NORMAL MIXTURE MAXIMUM LIKELIHOOD ',
     1  'ESTIMATION:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)N
 4221   FORMAT('NUMBER OF OBSERVATIONS                   = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4222)AMEAN
 4222   FORMAT('SAMPLE MEAN                              = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)ASD  
 4223   FORMAT('SAMPLE STANDARD DEVIATION                = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)AMIN  
 4225   FORMAT('SAMPLE MINIMUM                           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4227)AMAX  
 4227   FORMAT('SAMPLE MAXIMUM                           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4229)NCOMP  
 4229   FORMAT('NUMBER OF COMPONENTS                     = ',I8)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        DO4230I=1,NCOMP
          WRITE(ICOUT,4231)I
 4231     FORMAT('MAXIMUM LIKELIHOOD ESTIMATES OF COMPONENT  ',I8)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4233)ALPHA(I)
 4233     FORMAT(6X,'ESTIMATE OF MIXING PROPORTION      = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4235)XMEAN(I)
 4235     FORMAT(6X,'ESTIMATE OF MEAN                   = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4237)XSD(I)
 4237     FORMAT(6X,'ESTIMATE OF STANDARD DEVIATION     = ',G15.7)
          CALL DPWRST('XXX','WRIT')
 4230   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4241)
 4241   FORMAT('THE MAXIMUM LIKELIHOOD ESTIMATES FOR THE MIXING ',
     1         'PROPORTION, MEAN, AND')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4242)
 4242   FORMAT('STANDARD DEVIATION WERE WRITTEN TO THE FILE ',
     1         'dpst1f.dat')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLNM')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLNM--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLNO(Y,X,N,
     1XTEMP,DTEMP1,MAXNXT,
     1QP,XQPHAT,XQPLCL,XQPUCL,NPERC,
     1XMEAN,XSD,
     1ICAPSW,ICAPTY,NUMV,
     1IOUNI1,IOUNI2,ALPHAP,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR NORMAL DISTRIBUTION.  IT WILL
C              CONSIDER EITHER THE FULL SAMPLE CASE OR THE
C              MULTIPLY (RIGHT) CENSORED CASE.  FOR THE
C              CENSORED CASE, X SHOULD CONTAIN A 1 TO
C              INDICATE A FAILURE TIME AND A 0 TO INDICATE A
C              CENSORING TIME.
C     EXAMPLE--NORMAL MAXIMUM LIKELIHOOD Y
C            --NORMAL MAXIMUM LIKELIHOOD Y CENSOR
C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN ENGINEERING",
C                CAMBRIDGE UNIVERSITY PRESS, 1999, CHAPTER 10.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/5
C     ORIGINAL VERSION--MAY       1998.
C     UPDATED         --MARCH     2004. SUPPORT HTML/LATEX OUTPUT
C     UPDATED         --OCTOBER   2004. SUPPORT FOR CENSORED SAMPLES
C     UPDATED         --OCTOBER   2004. CONFIDENCE INTERVALS FOR
C                                       SELECTED PERCENTILES
C     UPDATED         --DECEMBER  2004. MODIFY THE OUTPUT FORMAT TO
C                                       BE MORE CONSISTENT WITH OTHER
C                                       DISTRIBUTIONS.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*1 IBASLC
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION XTEMP(*)
      DIMENSION QP(*)
      DIMENSION XQPHAT(*)
      DIMENSION XQPLCL(*)
      DIMENSION XQPUCL(*)
      DOUBLE PRECISION DTEMP1(*)
C
      PARAMETER (NUMALP=6)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWSC(NUMALP)
      DIMENSION AUPPSC(NUMALP)
      DIMENSION ALOWLO(NUMALP)
      DIMENSION AUPPLO(NUMALP)
C
      DIMENSION FISH(2,2)
      DIMENSION COV(2,2)
      DIMENSION D(2)
C
      COMMON/NORCML/IR
      DOUBLE PRECISION TOL
      DOUBLE PRECISION XPAR(2)
      DOUBLE PRECISION FVEC(2)
C
      EXTERNAL NORFUN
C
      DOUBLE PRECISION DN
      DOUBLE PRECISION DR
      DOUBLE PRECISION DX
      DOUBLE PRECISION MU
      DOUBLE PRECISION DCDF
      DOUBLE PRECISION DPDF
      DOUBLE PRECISION DHAZ
      DOUBLE PRECISION SIGMA
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION DSUM3
      DOUBLE PRECISION DSUM4
      DOUBLE PRECISION DSUM5
      DOUBLE PRECISION DSUM6
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
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='NO  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLNO')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLNO--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,NUMV,NPERC
   55   FORMAT('N,NUMV,NPERC = ',3I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I),X(I)
   57     FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
        IF(NPERC.GT.0)THEN
          DO66I=1,NPERC
            WRITE(ICOUT,67)I,QP(I)
   67       FORMAT('I,QP(I) = ',I8,G15.7)
            CALL DPWRST('XXX','WRIT')
   66     CONTINUE
        ENDIF
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN NORMAL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS NON-POSITIVE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN NORMAL MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
      IF(NPERC.GT.0)THEN
        DO1145I=1,NPERC
          IF(QP(I).LE.0.0 .OR. QP(I).GE.100.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1141)
 1141       FORMAT('***** WARNING IN NORMAL MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1143)QP(I)
 1143       FORMAT('      REQUESTED PERCENTILE (',G15.7,') IS ',
     1             'OUTSIDE THE (0,100) INTERVAL')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1144)
 1144       FORMAT('      NO PERCENTILE CONFIDENCE LIMITS WILL BE ',
     1             'COMPUTED.')
            CALL DPWRST('XXX','WRIT')
            NPERC=0
          ENDIF
 1145   CONTINUE
      ENDIF
C
      IF(NUMV.EQ.2)THEN
        CALL DISTIN(X,N,IWRITE,XTEMP,NDIST,IBUGA3,IERROR)
        IF(NDIST.EQ.1)THEN
          DO1202I=1,N
            X(I)=1.0
 1202     CONTINUE
          IR=N
        ELSEIF(NDIST.EQ.2)THEN
          IF(XTEMP(1).EQ.1.0 .OR. XTEMP(2).EQ.1.0)THEN
            IR=0
            DO1203I=1,N
              IF(X(I).NE.1.0)THEN
                X(I)=2.0
              ELSE
                IR=IR+1
              ENDIF
 1203       CONTINUE
          ELSE
            ATEMP1=MIN(XTEMP(1),XTEMP(2))
            ATEMP2=MAX(XTEMP(1),XTEMP(2))
            IR=0
            DO1208I=1,N
              IF(X(I).EQ.ATEMP1)THEN
                X(I)=1.0
                IR=IR+1
              ENDIF
              IF(X(I).EQ.ATEMP2)X(I)=2.0
 1208       CONTINUE
          ENDIF
        ELSE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1304)
 1304     FORMAT('***** ERROR IN NORMAL MAXIMUM LIKELIHOOD--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1305)
 1305     FORMAT('      FOR CENSORED DATA, THE CENSORING VARIABLE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1306)
 1306     FORMAT('      SHOULD CONTAIN AT MOST TWO DISTINCT VALUES.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1307)NDIST
 1307     FORMAT('      ',I8,' DISTINCT VALUES FOUND.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
        CALL SORTC(X,Y,N,X,Y)
      ENDIF
C
C               ******************************
C               **  STEP 41--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR NORMAL MLE ESTIMATE **
C               ******************************
C
 4000 CONTINUE
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      AN=REAL(N)
C
      IF(NUMV.LE.1)THEN
        CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
        CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
C
        XSDMEA=XSD/SQRT(AN)
        XSDSD=XSD/SQRT(2.0*(AN-1.0))
C
        IDF=N-1
        ADF=REAL(IDF)
        DO4010I=1,NUMALP
C
          ALP=ALPHA(I)
          P1=ALP/2.0
          P2=1.0-(ALP/2.0)
C
          CALL TPPF(P1,IDF,TLOW)
          CALL TPPF(P2,IDF,TUPP)
          ALOWLO(I)=XMEAN + TLOW*XSDMEA
          AUPPLO(I)=XMEAN + TUPP*XSDMEA
C
          CALL CHSPPF(P1,IDF,APPF1)
          CALL CHSPPF(P2,IDF,APPF2)
          ALOWSC(I)=XSD*SQRT(ADF/APPF2)
          AUPPSC(I)=XSD*SQRT(ADF/APPF1)
C
 4010   CONTINUE
      ELSE
        CALL MEAN(Y,IR,IWRITE,XMEAN,IBUGA3,IERROR)
        CALL SD(Y,IR,IWRITE,XSD,IBUGA3,IERROR)
        XPAR(1)=DBLE(XMEAN)
        XPAR(2)=DBLE(XSD)
        IOPT=2
        TOL=1.0D-6
        NVAR=2
        NPRINT=-1
        INFO=0
        LWA=MAXNXT
        CALL DNSQE(NORFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1             DTEMP1,MAXNXT,Y,N)
C
        XMEAN=REAL(XPAR(1))
        XSD=REAL(XPAR(2))
C
C  NOW COMPUTE THE FISHER INFORMATION MATRIX, INVERT TO GET THE
C  PARAMETER VARIANCE-COVARIANCE MATRIX.
C
        MU=DBLE(XMEAN)
        SIGMA=DBLE(XSD)
        DN=DBLE(N)
        DR=DBLE(IR)
C
        DSUM1=0.0D0
        DSUM2=0.0D0
        DO4150I=1,IR
          DX=(DBLE(Y(I)) - MU)/SIGMA
          DSUM1=DSUM1 + DX
          DSUM2=DSUM2 + DX*DX
 4150   CONTINUE
C
        DSUM3=0.0D0
        DSUM4=0.0D0
        DSUM5=0.0D0
        DSUM6=0.0D0
        IF(IR.LT.N)THEN
          DO4180I=IR+1,N
            DX=(DBLE(Y(I)) - MU)/SIGMA
            CALL NODPDF(DX,DPDF)
            CALL NODCDF(DX,DCDF)
            DHAZ=DPDF/(1.0D0 - DCDF)
            DSUM3=DSUM3 + DHAZ*(DHAZ - DX)
            DSUM4=DSUM4 + DHAZ*(1.0D0 + DX*(DHAZ - DX))
            DSUM5=DSUM5 + DX*DHAZ
            DSUM6=DSUM6 + DX*DX*DHAZ*(DHAZ - DX)
 4180     CONTINUE
        ENDIF
        XVAR=XSD*XSD
        FISH(1,1)=(1.0/XVAR)*REAL(DR + DSUM3)
        FISH(1,2)=(1.0/XVAR)*REAL(2.0D0*DSUM1 + DSUM4)
        FISH(2,1)=FISH(1,2)
        FISH(2,2)=(1.0/XVAR)*REAL(3.0D0*DSUM2+2.0D0*DSUM5+DSUM6-DR)
C
        NDIM=2
        CALL SGECO(FISH,NDIM,NDIM,ITEMP,RCOND,XTEMP)
        IJOB=1
        CALL SGEDI(FISH,NDIM,NDIM,ITEMP,XTEMP,XTEMP(MAXNXT/2),IJOB)
        DO4210J=1,NDIM
          DO4215I=1,NDIM
            COV(I,J)=FISH(I,J)
 4215     CONTINUE
 4210   CONTINUE
        DO4219I=1,NDIM
          WRITE(IOUNI2,'(2E15.7)')(COV(I,J),J=1,NDIM)
 4219   CONTINUE
C
        XSDMEA=SQRT(COV(1,1))
        XSDSD=SQRT(COV(2,2))
C
        IDF=N-1
        ADF=REAL(IDF)
C
        DO4260I=1,NUMALP
C
          ALP=ALPHA(I)
          P1=ALP/2.0
          P2=1.0-(ALP/2.0)
          CALL NORPPF(P1,APPF1)
          CALL NORPPF(P2,APPF2)
          ALOWLO(I)=0.0
          AUPPLO(I)=0.0
          ALOWSC(I)=0.0
          AUPPSC(I)=0.0
C
          IF(COV(1,1).GE.0.0)THEN
            ALOWLO(I)=XMEAN + APPF1*SQRT(COV(1,1))
            AUPPLO(I)=XMEAN + APPF2*SQRT(COV(1,1))
          ENDIF
          IF(COV(2,2).GE.0.0)THEN
            ALOWSC(I)=XMEAN + APPF1*SQRT(COV(2,2))
            AUPPSC(I)=XMEAN + APPF2*SQRT(COV(2,2))
          ENDIF
 4260   CONTINUE
C
      ENDIF
C
C               **********************************************
C               **  STEP 41B--                              **
C               **  ESTIMATE CONFIDENCE LIMITS FOR SELECTED **
C               **  PERCENTILES                             **
C               **********************************************
C
      ISTEPN='41B'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NPERC.GE.1)THEN
C
C  FULL SAMPLE CASE BASED ON NON-CENTRAL T
C
        IF(NUMV.EQ.1)THEN
          C1=XSD/SQRT(AN)
          ANU=REAL(N-1)
          ALPHL=ALPHAP/2.0
          ALPHU=1.0 - ALPHAP/2.0
C
          WRITE(IOUNI1,4111)
 4111     FORMAT(15X,'       POINT     ','     LOWER     ',
     1           '     UPPER')
          WRITE(IOUNI1,4112)
 4112     FORMAT('    PERCENTILE ','     ESTIMATE   ',
     1           'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
          DO4110I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL NORPPF(QPTEMP,APPF)
            XQPHAT(I)=XMEAN + XSD*APPF
            DELTA=APPF*SQRT(AN)
            IF(DELTA.LT.0.0)THEN
              DELTA2=-DELTA
              CALL NCTPPF(ALPHU,ANU,DELTA2,C2)
              C2=-C2
              CALL NCTPPF(ALPHL,ANU,DELTA2,C3)
              C3=-C3
            ELSE
              CALL NCTPPF(ALPHL,ANU,DELTA,C2)
              CALL NCTPPF(ALPHU,ANU,DELTA,C3)
            ENDIF
            ATEMP1=XMEAN + C1*C2
            ATEMP2=XMEAN + C1*C3
            XQPLCL(I)=MIN(ATEMP1,ATEMP2)
            XQPUCL(I)=MAX(ATEMP1,ATEMP2)
            WRITE(IOUNI1,'(3E15.7,2X,E15.7)')
     1           QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I)
            IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNO')THEN
              WRITE(ICOUT,4113)XMEAN,XSD,ANU,ALPHAP
 4113         FORMAT('XMEAN,XSD,ANU,ALPHAP = ',4G15.7)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4115)DELTA,C1,C2,C3
 4115         FORMAT('DELTA,C1,C2,C3 = ',4G15.7)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4117)ATEMP1,ATEMP2
 4117         FORMAT('ATEMP1,ATEMP2 = ',2G15.7)
              CALL DPWRST('XXX','BUG ')
            ENDIF
 4110     CONTINUE
C
C  CENSORED CASE BASED ON NORMAL APPROXIMATION
C
        ELSE
          D(1)=1.0
          ALPHL=ALPHAP/2.0
          ALPHU=1.0 - ALPHAP/2.0
          CALL NORPPF(ALPHU,ZALPU)
C
          WRITE(IOUNI1,4111)
          WRITE(IOUNI1,4112)
          DO4360I=1,NPERC
            QPTEMP=QP(I)/100.0
            CALL NORPPF(QPTEMP,D(2))
            XQPHAT(I)=XMEAN + XSD*D(2)
            DSUM1=0.0D0
            DO4370II=1,2
              DO4380JJ=1,2
                DSUM1=DSUM1 + D(II)*D(JJ)*COV(II,JJ)
 4380         CONTINUE
 4370       CONTINUE
            XQPSE=SQRT(REAL(DSUM1))
            ATEMP1=XQPHAT(I) - ZALPU*XQPSE
            ATEMP2=XQPHAT(I) + ZALPU*XQPSE
            XQPLCL(I)=MIN(ATEMP1,ATEMP2)
            XQPUCL(I)=MAX(ATEMP1,ATEMP2)
            WRITE(IOUNI1,'(3E15.7,2X,E15.7)')
     1           QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I)
            IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNO')THEN
              WRITE(ICOUT,4361)I,QP(I),XQPHAT(I)
 4361         FORMAT('I,QP(I),XQPHAT(I) = ',I8,2G15.7)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4363)XMEAN,XSD,ALPHAP,ZALPU
 4363         FORMAT('XMEAN,XSD,ALPHAP,ZALPU = ',4G15.7)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4365)DSUM1,XQPSE
 4365         FORMAT('DSUM1,XQPSE = ',2G15.7)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4367)ATEMP1,ATEMP2
 4367         FORMAT('ATEMP1,ATEMP2 = ',2G15.7)
              CALL DPWRST('XXX','BUG ')
            ENDIF
 4360     CONTINUE
        ENDIF
      ENDIF
C
C               *********************************
C               **   STEP 42--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR NORMAL MLE ESTIMATE   **
C               **********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5016   FORMAT('      <B>Normal Maximum Likelihood Estimation</B>')
 5017   FORMAT('      <BR><B>Full Sample Case</B>')
 5018   FORMAT('      <BR><B>Time Censored Case</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5016)
        CALL DPWRST('XXX','WRIT')
        IF(NUMV.EQ.1)THEN
          WRITE(ICOUT,5017)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,5018)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=350>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Number of Censoring Times:')
 5063   FORMAT('         Maximum Likelihood Estimate of Location:')
 5064   FORMAT('         Standard Error of Maximum Likelihood ',
     1         'Estimate of Location:')
 5065   FORMAT('         Maximum Likelihood Estimate of Sale:')
 5066   FORMAT('         Standard Error of Maximum Likelihood ',
     1         'Estimate of Scale:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        IF(NUMV.EQ.2)THEN
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5062)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5053)N-IR
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSDMEA
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSDSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Limits for the Location ',
     1         'Parameter</B>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5134   FORMAT('         &nbsp;')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=3>')
 5162   FORMAT('          <HR>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        DO5140I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWLO(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPLO(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5140   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5217   FORMAT('      <B>Confidence Limits for the Scale ',
     1         'Parameter</B>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5217)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
        DO5240I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWSC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPSC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5240   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
C
C  START THE TABLE
C
 5811     FORMAT('<UL>')
 5813     FORMAT('<TABLE NOBORDER>')
 5815     FORMAT('   <CAPTION ALIGN=CENTER>')
 5816     FORMAT('      <BR><B>Alpha = ',F7.3,'</B>')
 5817     FORMAT('      <B>Confidence Limits for Selected ',
     1           'Percentiles:<br> Full Sample Case (Based on ',
     1           'Non-Central <i>t</i>)</B>')
 5818     FORMAT('      <B>Confidence Limits for Selected ',
     1           'Percentiles:<br> Censored Case (Based on ',
     1           'Normal Approximation)</B>')
 5819     FORMAT('   </CAPTION>')
          WRITE(ICOUT,999)
          WRITE(ICOUT,5811)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5813)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5815)
          CALL DPWRST('XXX','WRIT')
          IF(NUMV.LE.1)THEN
            WRITE(ICOUT,5817)
            CALL DPWRST('XXX','WRIT')
          ELSE
            WRITE(ICOUT,5818)
            CALL DPWRST('XXX','WRIT')
          ENDIF
          WRITE(ICOUT,5816)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5819)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5841     FORMAT('   <TR>')
 5843     FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5847     FORMAT('      </TD>')
 5848     FORMAT('      </TH>')
 5849     FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5851     FORMAT('         ',G15.7)
 5859     FORMAT('   </TR>')
 5861     FORMAT('         Percentile')
 5862     FORMAT('         Point <br> Estimate')
 5863     FORMAT('         Lower <br>Confidence Limit')
 5864     FORMAT('         Upper <br>Confidence Limit')
 5870     FORMAT('      <TD COLSPAN=4>')
 5872     FORMAT('         <HR WIDTH=500>')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5861)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5863)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5864)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5870)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5872)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5847)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          DO5880I=1,NPERC
            WRITE(ICOUT,5841)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)QP(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPHAT(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPLCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPUCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5859)
            CALL DPWRST('XXX','WRIT')
 5880     CONTINUE
C
C  END THE TABLE AND RESET ASIS MODE
C
 5891     FORMAT('</TABLE>')
 5893     FORMAT('</UL>')
          WRITE(ICOUT,5891)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5893)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5899)
 5899   FORMAT('<PRE>')
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Normal Maximum Likelihood Estimate: ',
     1       'Full Sample Case}')
 8012 FORMAT(5X,'{',A1,'bf Normal Maximum Likelihood Estimate: ',
     1       'Time Censored Case}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(NUMV.EQ.1)THEN
          WRITE(ICOUT,8011)IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8012)IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Number of Censoring Times: & ',I8,2X,A1,A1)
 8023 FORMAT(5X,'Maximum Likelihood Estimate of Location: & ',
     1       G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Standard Error of Maximum Likelihood Estimate ',
     1       'of Location: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Maximum Likelihood Estimate of Scale: & ',
     1       G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Standard Error of Maximum Likelihood Estimate ',
     1       'of Scale: & ',G15.7,2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(NUMV.EQ.2)THEN
          WRITE(ICOUT,8022)N-IR,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8023)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XSDMEA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)XSDSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{center}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for Location Parameter}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8111)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper ',2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit',2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,2X,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8130I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWLO(I),AUPPLO(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8130   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8191   FORMAT(A1,'end{table}')
 8193   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8211 FORMAT(5X,'{',A1,'bf Confidence Limits for Scale Parameter}')
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8211)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8230I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWSC(I),AUPPSC(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8230   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8191)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8803 FORMAT(A1,'begin{table}')
 8807 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8809 FORMAT(A1,'begin{center}')
 8810 FORMAT(5X,'{',A1,'bf Confidence Limits for Selected ',
     1       'Percentiles:}')
 8811 FORMAT(5X,'{',A1,'bf Full Sample Case (Based on Non-Central t)}')
88811 FORMAT(5X,'{',A1,'bf Censored Case (Based on Normal ',
     1       'Approximation)}')
 8812 FORMAT(5X,'{',A1,'bf $',A1,'alpha$ = ',F7.3,'}')
 8813 FORMAT(A1,'end{center}')
 8815 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8803)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8809)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8810)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(NUMV.LE.1)THEN
          WRITE(ICOUT,8811)IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,88811)IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8812)IBASLC,IBASLC,ALPHAP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8813)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8820 FORMAT(5X,A1,'begin{tabular} {cccc}')
 8821 FORMAT(5X,' & {',A1,'bf Point} & {',A1,'bf Lower} & {',A1,
     1       'bf Upper}',2X,A1,A1)
 8822 FORMAT(5X,'{',A1,'bf Percentile} & {',A1,'bf Estimate} & {',A1,
     1       'bf Confidence Limit} & {',A1,
     1       'bf Confidence Limit}',2X,A1,A1)
 8823 FORMAT(5X,G15.7,' & ',G15.7,' & ',G15.7,' & ',G15.7,2X,A1,A1)
 8840 FORMAT(5X,A1,'hline')
 8849 FORMAT(A1,'end{tabular}')
C
        WRITE(ICOUT,8809)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8820)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8821)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8822)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8840)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8830I=1,NPERC
          WRITE(ICOUT,8823)QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I),
     1                     IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8830   CONTINUE
        WRITE(ICOUT,8849)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8891 FORMAT(A1,'end{center}')
 8893 FORMAT(A1,'end{table}')
        WRITE(ICOUT,8891)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8893)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        ENDIF
        WRITE(ICOUT,8899)IBASLC
 8899   FORMAT(A1,'begin{verbatim}')
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4611)
 4611   FORMAT(10X,'NORMAL MAXIMUM LIKELIHOOD ESTIMATE:')
        CALL DPWRST('XXX','WRIT')
        IF(NUMV.EQ.1)THEN
          WRITE(ICOUT,4612)
 4612     FORMAT(10X,'FULL SAMPLE CASE')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4613)
 4613     FORMAT(10X,'TIME CENSORED CASE')
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4622)N
 4622   FORMAT('NUMBER OF OBSERVATIONS                     = ',I8)
        CALL DPWRST('XXX','WRIT')
        IF(NUMV.EQ.2)THEN
          WRITE(ICOUT,4623)N-IR
          CALL DPWRST('XXX','WRIT')
        ENDIF
 4623   FORMAT('NUMBER OF CENSORING TIMES                  = ',I8)
        WRITE(ICOUT,4624)XMEAN
 4624   FORMAT('MAXIMUM LIKELIHOOD ESTIMATE OF LOCATION    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4625)XSDMEA
 4625   FORMAT('STANDARD ERROR OF ML ESTIMATE OF LOCATION  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4626)XSD
 4626   FORMAT('MAXIMUM LIKELIHOOD ESTIMATE OF SCALE       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4628)XSDSD
 4628   FORMAT('STANDARD ERROR OF ML ESTIMATE OF SCALE     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4640)
 4640   FORMAT('CONFIDENCE INTERVAL FOR LOCATION PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4643)
 4643   FORMAT('   CONFIDENCE           LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4645)
 4645   FORMAT('   VALUE (%)            LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4646)
 4646   FORMAT('-------------------------------------------')
        CALL DPWRST('XXX','WRIT')
C
        DO4649I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4647)ATEMP,ALOWLO(I),AUPPLO(I)
 4647     FORMAT('   ',F8.3,10X,G12.6,2X,G12.6)
          CALL DPWRST('XXX','WRIT')
 4649   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4680)
 4680   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4643)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4645)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4646)
        CALL DPWRST('XXX','WRIT')
C
        DO4689I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4647)ATEMP,ALOWSC(I),AUPPSC(I)
          CALL DPWRST('XXX','WRIT')
 4689   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,4911)
 4911     FORMAT('CONFIDENCE LIMITS FOR SELECTED PERCENTILES:')
          CALL DPWRST('XXX','WRIT')
          IF(NUMV.LE.1)THEN
            WRITE(ICOUT,4912)
 4912       FORMAT('FULL SAMPLE CASE (BASED ON NON-CENTRAL T)')
            CALL DPWRST('XXX','WRIT')
          ELSE
            WRITE(ICOUT,4914)
 4914       FORMAT('CENSORED CASE (BASED ON NORMAL APPROXIMATION)')
            CALL DPWRST('XXX','WRIT')
          ENDIF
          WRITE(ICOUT,4915)ALPHAP
 4915     FORMAT('ALPHA = ',F7.4)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4921)
 4921     FORMAT(15X,'         POINT     ','          LOWER     ',
     1          '         UPPER')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4922)
 4922     FORMAT('     PERCENTILE','      ESTIMATE    ',
     1           'CONFIDENCE LIMIT ','  CONFIDENCE LIMIT')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4924)
 4924     FORMAT('---------------','------------------',
     1           '-----------------','------------------')
          CALL DPWRST('XXX','WRIT')
C
          DO4930I=1,NPERC
            WRITE(ICOUT,4932)QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I)
 4932       FORMAT(F15.3,2X,G15.7,6X,G15.7,4X,G15.7)
            CALL DPWRST('XXX','WRIT')
 4930     CONTINUE
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IF(IFEEDB.EQ.'ON')THEN
          IF(NPERC.GT.0)THEN
            WRITE(ICOUT,4943)
 4943       FORMAT('PERCENTILE CONFIDENCE LIMITS WRITTEN TO FILE  ',
     1             'dpst1f.dat')
          ENDIF
          IF(NUMV.GT.1)THEN
            WRITE(ICOUT,4945)
 4945       FORMAT('PARAMETER VARIANCE-COVARIANCE MATRIX WRITTEN ',
     1             'TO FILE  dpst2f.dat')
          ENDIF
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLNO')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMLNO--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMLPA(Y,N,
     1XTEMP,MAXNXT,
     1GAMMML,AML,GAMMSE,AMLSE,
     1QP,XQPHAT,XQPLCL,XQPUCL,NPERC,ALPHAP,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR PARETO DISTRIBUTION
C     EXAMPLE--PARETO MAXIMUM LIKELIHOOD Y
C     REFERENCE--XX
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/5
C     ORIGINAL VERSION--MAY       1998.
C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML, LATEX OUTPUT
C     UPDATED         --OCTOBER   2003. CONFIDENCE INTERVAL FOR SHAPE
C                                       PARAMETER
C     UPDATED         --DECEMBER  2004. MODIFY FORMAT OF OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DSUM
      DOUBLE PRECISION DTERM1
C
      PARAMETER (NUMALP=6)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWGA(NUMALP)
      DIMENSION AUPPGA(NUMALP)
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
C
      DIMENSION QP(*)
      DIMENSION XQPHAT(*)
      DIMENSION XQPLCL(*)
      DIMENSION XQPUCL(*)
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
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='PA  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLPA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPMLPA--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,55)N
   55 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,MIN(N,100)
      WRITE(ICOUT,57)I,Y(I)
   57 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
   66 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLPA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN PARETO MAXIMUM LIKELIHOOD.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS IS LESS THAN TWO.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
      IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM PARETO MAXIMUM LIKELIHOOD--VARIABLE 1 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
      DO1145I=1,N
        IF(Y(I).LE.0.0)THEN
          WRITE(ICOUT,1111)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1147)
 1147     FORMAT('      ROW ',I8,' IS NEGATIVE.  THE VALUE IS ',
     1           G15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
1145  CONTINUE
C
      IF(NPERC.GT.0)THEN
        DO1155I=1,NPERC
          IF(QP(I).LE.0.0 .OR. QP(I).GE.100.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1151)
 1151       FORMAT('***** WARNING IN PARETO MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1153)QP(I)
 1153       FORMAT('      REQUESTED PERCENTILE (',G15.7,') IS ',
     1             'OUTSIDE THE (0,100) INTERVAL')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1154)
 1154       FORMAT('      NO PERCENTILE CONFIDENCE LIMITS WILL BE ',
     1             'COMPUTED.')
            CALL DPWRST('XXX','WRIT')
            NPERC=0
          ENDIF
 1155   CONTINUE
      ENDIF
C
 1290 CONTINUE
C
C               ******************************
C               **  STEP 41--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR PARETO MLE ESTIMATE **
C               ******************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLPA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
C
      DSUM=0.0D0
      DO4110I=1,N
        IF(Y(I).LE.0.0)THEN
          IERROR='YES'
          GOTO9000
        ENDIF
        DTERM1=DBLE(LOG(Y(I)/XMIN))
        DSUM=DSUM + DTERM1
 4110 CONTINUE
      GAMMA=REAL(DSUM)/REAL(N)
      GAMMA=1.0/GAMMA
      GAMMML=GAMMA
      AML=XMIN
C
      AN=REAL(N)
      GAMMSE=0.0
      AMLSE=0.0
      IF(N.GT.3)THEN
        TERM1=AN*GAMMA**2/((AN-2.0)**2*(AN-3.0))
        GAMMSE=SQRT(TERM1)
      ENDIF
      IF(AN.GT.2.0/GAMMA)THEN
        TERM1=AN*AML*GAMMA**2/((AN*GAMMA-1.0)**2*(AN*GAMMA-2.0))
        AMLSE=SQRT(TERM1)
      ENDIF
C
      NU=2*(N-1)
C
      DO4120I=1,NUMALP
        ALP=ALPHA(I)
        PL=ALP/2.0
        PU=1.0-(ALP/2.0)
        CALL CHSPPF(PL,NU,PPF1)
        CALL CHSPPF(PU,NU,PPF2)
        ALOWGA(I)=GAMMA*PPF1/REAL(2*N)
        AUPPGA(I)=GAMMA*PPF2/REAL(2*N)
 4120 CONTINUE
C
C  CONFIDENCE INTERVALS FOR SELECTED PERCENTILES.
C
C  METHOD OF ASTRABADI AS DESCRIBED ON PP. 591-592 OF JOHNSON, KOTZ,
C  AND BALAKRISHNAN (SEE REFERENCE ABOVE).  THESE ARE APPROXIMATE
C  INTERVALS.
C
C  STILL NEED SOME DEBUGGING ON THIS.
C
      NPERC=0
      IF(NPERC.GE.1)THEN
C
        ALPHL=ALPHAP/2.0
        ALPHU=1.0 - ALPHAP/2.0
        NUTEMP=2*N
        CALL CHSPPF(ALPHL,NUTEMP,ZUPP)
        CALL CHSPPF(ALPHU,NUTEMP,ZLOW)
C
CCCCC   WRITE(IOUNI1,4131)
CCCCC   WRITE(IOUNI1,4132)
        DO4139I=1,NPERC
          QPTEMP=QP(I)/100.0
          CALL PARPPF(QPTEMP,GAMMML,AML,APPF)
          XQPHAT(I)=APPF
C
          TERM1=2.0*GAMMML*LOG(APPF/AML)/ZLOW
          TERM2=TERM1**(AN-1.0)
          print *,'term1,term2=',term1,term2
          XQPLCL(I)=1.0 - TERM1
          TERM2=1.0 - (1.0 - 2.0*GAMMML*LOG(APPF/AML)/ZUPP)**(AN-1.0)
          XQPUCL(I)=TERM2
CCCCC     WRITE(IOUNI1,'(4E15.7)')
CCCCC1         QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I)
 4139   CONTINUE
 4131   FORMAT(15X,'       POINT     ','     LOWER     ',
     1         '     UPPER')
 4132   FORMAT('    PERCENTILE ','     ESTIMATE   ',
     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
C
      ENDIF
C
C               *********************************
C               **   STEP 42--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR PARETO MLE ESTIMATE   **
C               **********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5002   FORMAT('<B>PARETO PARAMETER ESTIMATION</B>')
 5004   FORMAT('<BR><B>FULL SAMPLE CASE</B>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
C5015   FORMAT('   <CAPTION ALIGN=CENTER>')
C5017   FORMAT('      <B>Method of Maximum Likelihood</B>')
C5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5015)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5017)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5019)
CCCCC   CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=350>')
 5045   FORMAT('         Summary Statistics:')
 5060   FORMAT('         Number of Observations:')
 5061   FORMAT('         Sample Minimum:')
 5062   FORMAT('         Sample Maximum:')
 5063   FORMAT('         Sample Mean:')
 5064   FORMAT('         Sample Standard Deviation:')
 5065   FORMAT('         Estimate of the ',
     1         'Tail Length Shape Parameter:')
 5066   FORMAT('         Estimate of the ',
     1         'Location Shape Parameter:')
 5067   FORMAT('         Standard Error of the ',
     1         'Estimate of the Tail Length Shape Parameter:')
 5068   FORMAT('         Standard Error of the ',
     1         'Estimate of the Lower Bound Shape Parameter:')
 5069   FORMAT('         Maximum Likelihood Estimates:')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5045)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        IF(N.GT.3)THEN
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5067)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)GAMMSE
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        IF(AN.GT.2.0/GAMMA)THEN
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5068)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)AMLSE
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Limits for the Shape ',
     1         '(Tail Length) Parameter</B><BR>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5134   FORMAT('         &nbsp;')
 5136   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM COLSPAN=2>')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=3>')
 5162   FORMAT('          <HR>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        DO5140I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWGA(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPGA(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5140   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Pareto Parameter Estimation: ',
     1       'Full Sample Case}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Estimate of Tail Length ',
     1       'Shape Parameter: & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,'Estimate of Lower Bound ',
     1       'Shape Parameter: & ',G15.7,2X,A1,A1)
 8028 FORMAT(5X,' & ',2X,A1,A1)
 8029 FORMAT(5X,'Standard Error of the ',
     1       'Estimate of Tail Length ',
     1       'Shape Parameter: & ',G15.7,2X,A1,A1)
 8030 FORMAT(5X,'Standard Error of the ',
     1       'Estimate of Lower Bound ',
     1       'Shape Parameter: & ',G15.7,2X,A1,A1)
 8031 FORMAT(5X,'Summary Statistics: & ',2X,A1,A1)
 8032 FORMAT(5X,'Maximum Likelihood Estimates: & ',2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)GAMMML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)GAMMSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)AML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)AMLSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{table}')
 8093 FORMAT(A1,'end{center}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for Shape ',
     1       '(Tail Length) Parameter}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8111)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper ',
     1         2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit ',
     1         2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8130I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWGA(I),AUPPGA(I),
     1                     IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8130   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(12X,'PARETO MAXIMUM LIKELIHOOD ESTIMATION')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4220)
 4220   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)N
 4221   FORMAT('NUMBER OF OBSERVATIONS                          = ',
     1         I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4222)XMIN
 4222   FORMAT('SAMPLE MINIMUM                                  = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)XMAX
 4223   FORMAT('SAMPLE MAXIMUM                                  = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4224)XMEAN
 4224   FORMAT('SAMPLE MEAN                                     = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)XSD
 4225   FORMAT('SAMPLE STANDARD DEVIATION                       = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4226)
 4226   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4227)GAMMML
 4227   FORMAT('ESTIMATE OF SHAPE (TAIL LENGTH) PARAMETER       = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        IF(N.GT.3)THEN
          WRITE(ICOUT,4228)GAMMSE
 4228   FORMAT('STANDARD ERROR OF TAIL LENGTH PARAMETER         = ',
     1         G15.7)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,4229)AML
 4229   FORMAT('ESTIMATE OF SHAPE (LOWER BOUND) PARAMETER       = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        IF(AN.GT.2.0/GAMMA)THEN
          WRITE(ICOUT,4230)AMLSE
 4230   FORMAT('STANDARD ERROR OF LOWER BOUND PARAMETER         = ',
     1         G15.7)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4240)
 4240   FORMAT('CONFIDENCE INTERVAL FOR SHAPE (TAIL LENGTH) PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)
 4243   FORMAT('   CONFIDENCE           LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)
 4245   FORMAT('   VALUE (%)            LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4246)
 4246   FORMAT('---------------------------------------------------')
        CALL DPWRST('XXX','WRIT')
        DO4249I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4247)ATEMP,ALOWGA(I),AUPPGA(I)
 4247     FORMAT('   ',F8.3,10X,2(G12.6,2X))
          CALL DPWRST('XXX','WRIT')
 4249   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,4911)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4915)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4921)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4922)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4346)
          CALL DPWRST('XXX','WRIT')
C
 4911   FORMAT('CONFIDENCE LIMITS (ASRABADI APPROXIMATION) FOR ',
     1         'SELECTED PERCENTILES:')
 4915   FORMAT('ALPHA = ',F7.4)
 4921   FORMAT(10X,'      POINT     ',
     1             '        LOWER     ', '       UPPER')
 4922   FORMAT('PERCENTILE','   ESTIMATE   ',
     1         'CONFIDENCE LIMIT ',' CONFIDENCE LIMIT')
 4346   FORMAT('-----------------------------------',
     1         '--------------------')
C
          DO4981I=1,NPERC
            WRITE(ICOUT,4932)QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I)
 4932       FORMAT(2X,F8.4,G15.7,2X,G15.7,2X,G15.7)
            CALL DPWRST('XXX','WRIT')
 4981     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,4241)
 4241     FORMAT('GAMMA, GAMMASE, AML, AND AMLSE WILL BE SAVED AS ',
     1           'INTERNAL PARAMETERS.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLPA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMLPA--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMLPO(Y,N,
     1XTEMP,MAXNXT,
     1ALAMB,ALMBSE,XMIN,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR POISSON DISTRIBUTION
C     EXAMPLE--POISSON MAXIMUM LIKELIHOOD Y
C     REFERENCE--XX
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/3
C     ORIGINAL VERSION--MARCH     1998.
C     UPDATED         --MARCH     2004. SUPPORT FOR HTML, LATEX
C     UPDATED         --AUGUST    2005. REFORMAT FOR CONSISTENCY WITH
C                                       OTHER ML ROUTINES
C     UPDATED         --SEPTEMBER 2005. CONFIDENCE INTERVALS FOR
C                                       LAMBDA
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*4 IBASLC
C
      PARAMETER (NUMALP=5)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWNO(NUMALP)
      DIMENSION AUPPNO(NUMALP)
C
      EXTERNAL SUM
      EXTERNAL POIFUN
      COMMON/POICOM/NTEMP,XSUM,CONST
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
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
CCCCC DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='PO  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPO')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLPO--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLPO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN POISSON MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 1 ',
     1         'IS NON-POSITIVE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR FROM POISSON MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
C               ******************************
C               **  STEP 21--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR POISSON MLE ESTIMATE**
C               ******************************
C
 2100 CONTINUE
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO2105I=1,N
        ITEMP=INT(Y(I)+0.5)
        Y(I)=REAL(ITEMP)
 2105 CONTINUE
      IERROR='NO'
      IWRITE='OFF'
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      IF(XMIN.LT.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2111)
 2111   FORMAT('***** ERROR FROM DPMLPO--NEGATIVE VALUE ENCOUNTERED.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL SUM(Y,N,IWRITE,XSUM,IBUGA3,IERROR)
      ALAMB=XMEAN
      ALMBSE=SQRT(ALAMB/REAL(N))
C
      NTEMP=N
      AE=1.E-5
      RE=1.E-5
      IFLAG=0
C
      DO2210I=1,NUMALP
C
        ALP=ALPHA(I)
        P1=ALP/2.0
        P2=1.0-(ALP/2.0)
C
        CONST=P2
        ALAHAT=ALAMB
        ALOWLI=ALAHAT - 5.0*ALMBSE
        IF(ALOWLI.LE.0.0)ALOWLI=0.00001
        AUPPLI=ALAHAT + 5.0*ALMBSE
        CALL FZERO(POIFUN,ALOWLI,AUPPLI,ALAHAT,RE,AE,IFLAG)
        ALOWNO(I)=ALOWLI
        IF(IFLAG.EQ.2)THEN
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2211)
 2211     FORMAT('***** WARNING FROM POISSON MAXIMUM LIKELIHOOD--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2213)
 2213     FORMAT('      ESTIMATE OF LOWER CONFIDENCE VALUE FOR ',
     1           'LAMBDA MAY NOT BE COMPUTED TO DESIRED TOLERANCE.')
          CALL DPWRST('XXX','BUG ')
        ELSEIF(IFLAG.EQ.3)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2211)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2223)
 2223     FORMAT('      ESTIMATE OF LOWER CONFIDENCE VALUE FOR ',
     1             'LAMBDA MAY BE NEAR A SINGULAR POINT.')
          CALL DPWRST('XXX','BUG ')
        ELSEIF(IFLAG.EQ.4)THEN
CCCCC     WRITE(ICOUT,999)
CCCCC     CALL DPWRST('XXX','BUG ')
CCCCC     WRITE(ICOUT,2211)
CCCCC     CALL DPWRST('XXX','BUG ')
CCCCC     WRITE(ICOUT,2233)
C2233     FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
CCCCC     CALL DPWRST('XXX','BUG ')
        ELSEIF(IFLAG.EQ.5)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2211)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2243)
 2243     FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        IFLAG=0
        CONST=P1
        ALAHAT=ALAMB
        ALOWLI=ALAHAT - 5.0*ALMBSE
        IF(ALOWLI.LE.0.0)ALOWLI=0.00001
        AUPPLI=ALAHAT + 5.0*ALMBSE
        CALL FZERO(POIFUN,ALOWLI,AUPPLI,ALAHAT,RE,AE,IFLAG)
        AUPPNO(I)=ALOWLI
        IF(IFLAG.EQ.2)THEN
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2211)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2263)
 2263     FORMAT('      ESTIMATE OF UPPER CONFIDENCE VALUE FOR P ',
     1           'MAY NOT BE COMPUTED TO DESIRED TOLERANCE.')
          CALL DPWRST('XXX','BUG ')
        ELSEIF(IFLAG.EQ.3)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2211)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2273)
 2273     FORMAT('      ESTIMATE OF UPPER CONFIDENCE VALUE FOR P ',
     1           'MAY BE NEAR A SINGULAR POINT.')
          CALL DPWRST('XXX','BUG ')
        ELSEIF(IFLAG.EQ.4)THEN
CCCCC     WRITE(ICOUT,999)
CCCCC     CALL DPWRST('XXX','BUG ')
CCCCC     WRITE(ICOUT,2211)
CCCCC     CALL DPWRST('XXX','BUG ')
CCCCC     WRITE(ICOUT,2233)
C2233     FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
CCCCC     CALL DPWRST('XXX','BUG ')
        ELSEIF(IFLAG.EQ.5)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2211)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2283)
 2283     FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
 2210 CONTINUE
C
C               *********************************
C               **   STEP 42--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR POISSON MLE ESTIMATE  **
C               **********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLPO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Poisson  Parameter Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=250>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5060   FORMAT('         Summary Statistics:')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Mean:')
 5063   FORMAT('         Sample SD:')
 5064   FORMAT('         Sample Minimum:')
 5065   FORMAT('         Sample Maximum:')
 5066   FORMAT('         Maximum Likelihood Estimates:')
 5067   FORMAT('         Estimate of Shape Parameter Lambda:')
 5068   FORMAT('         Standard Error of Lambda:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALAMB
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALMBSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Limits for the ',
     1         'Lambda Parameter</B><BR>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5134   FORMAT('         &nbsp;')
 5136   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM COLSPAN=2>')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=3>')
 5162   FORMAT('          <HR>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        DO5140I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWNO(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPNO(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5140   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Poisson Parameter Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Summary Statistics: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8023 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,' & ',2X,A1,A1)
 8028 FORMAT(5X,'Maximum Likelihood Estimates: & ',I8,2X,A1,A1)
 8029 FORMAT(5X,'Estimate of Shape Parameter $',A1,'lambda$: & ',
     1       G15.7,2X,A1,A1)
 8030 FORMAT(5X,'Standard Error of $',A1,'lambda$: & ',
     1       G15.7,2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC,ALAMB,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC,ALMBSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{center}')
 8093 FORMAT(A1,'end{table}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for the ',
     1      '$',A1,'lambda$ Parameter}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8111)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper ',
     1         2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit ',
     1         2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,
     1         2X,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8130I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWNO(I),AUPPNO(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8130   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(12X,'POISSON PARAMETER ESTIMATION')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4240)
 4240   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4241)N
 4241   FORMAT('NUMBER OF OBSERVATIONS               = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)XMEAN
 4243   FORMAT('SAMPLE MEAN                          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)XSD
 4245   FORMAT('SAMPLE STANDARD DEVIATION            = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4247)XMIN
 4247   FORMAT('SAMPLE MINIMUM                       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4249)XMAX
 4249   FORMAT('SAMPLE MAXIMUM                       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4250)
 4250   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4253)ALAMB
 4253   FORMAT('ESTIMATE OF SHAPE PARAMETER LAMBDA   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4255)ALMBSE
 4255   FORMAT('STANDARD ERROR OF LAMBDA             = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4310)
 4310   FORMAT('CONFIDENCE INTERVAL FOR LAMBDA PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4321)
 4321   FORMAT('   CONFIDENCE           LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4323)
 4323   FORMAT('   VALUE (%)            LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4326)
 4326   FORMAT('-------------------------------------------')
        CALL DPWRST('XXX','WRIT')
        DO4341I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4347)ATEMP,ALOWNO(I),AUPPNO(I)
 4347     FORMAT('   ',F8.3,10X,2(G12.6,2X))
          CALL DPWRST('XXX','WRIT')
 4341   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4391)
 4391   FORMAT('LAMBDAML AND LAMBDASE  WILL BE SAVED AS INTERNAL ',
     1         'PARAMETERS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPO')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLPO--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLPW(Y,N,
     1XTEMP,MAXNXT,
     1C,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR THE POWER DISTRIBUTION
C     EXAMPLE--POWER MAXIMUM LIKELIHOOD Y
C     REFERENCE--XX
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/6
C     ORIGINAL VERSION--JUNE      1998.
C     UPDATED         --MARCH     2004. SUPPORT FOR HTML, LATEX
C     UPDATED         --AUGUST    2005. REFORMAT OUTPUT FOR CONSISTENCY
C                                       WITH OTHER ML ROUTINES
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*1 IBASLC
C
      DOUBLE PRECISION DSUM
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
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='DPML'
      ISUBN2='PO  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPO')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLPW--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN POWER MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS NON-POSITIVE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)N
 1112   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR FROM POWER MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
C               **********************************
C               **  STEP 41--                   **
C               **  CARRY OUT CALCULATIONS      **
C               **  FOR POWER              MLE  **
C               **  ESTIMATE (FULL SAMPLE CASE) **
C               **********************************
C
 2100 CONTINUE
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
C
      DSUM=0.0D0
      DO2110I=1,N
        IF(Y(I).LE.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2108)
 2108     FORMAT('***** ERROR FROM POWER MAXIMUM LIKELIHOOD--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2109)
 2109     FORMAT('      A NON-POSITIVE DATA VALUE WAS ENCOUNTERED.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
        DSUM=DSUM + DBLE(LOG(Y(I)))
 2110 CONTINUE
      C=-REAL(N)/REAL(DSUM)
      IWRITE='OFF'
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Power Parameter Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=250>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5060   FORMAT('         Summary Statistics:')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Mean:')
 5063   FORMAT('         Sample Standard Deviation:')
 5064   FORMAT('         Sample Minimum:')
 5065   FORMAT('         Sample Maximum:')
 5066   FORMAT('         Maximum Likelihood Estimates:')
 5067   FORMAT('         Estmate of Shape Parameter C:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)C
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Power Maximum Likelihood Estimate}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Summary Statistics: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8023 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,'Maximum Likelihood Estimates: & ',I8,2X,A1,A1)
 8028 FORMAT(5X,' & ',I8,2X,A1,A1)
 8029 FORMAT(5X,'Estimate of Shape Parameter C: & ',
     1       G15.7,2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)C,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{center}')
 8093 FORMAT(A1,'end{table}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4101)
 4101   FORMAT(12X,'POWER PARAMETER ESTIMATION')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4110)
 4110   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4111)N
 4111   FORMAT('NUMBER OF OBSERVATIONS           = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4117)XMEAN
 4113   FORMAT('THE SAMPLE MEAN                  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4115)XSD
 4115   FORMAT('SAMPLE STANDARD DEVIATION        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4117)XMIN
 4117   FORMAT('SAMPLE MINIMUM                   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4119)XMAX
 4119   FORMAT('SAMPLE MAXIMUM                   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4130)
 4130   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4133)C
 4133   FORMAT('ESTIMATE OF SHAPE PARAMETER C    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4149)
 4149   FORMAT('THE SHAPE PARAMETER WILL BE SAVED AS ',
     1            'THE INTERNAL PARAMETER CML.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLPW')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLPW--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLRA(Y,N,RAYMIN,
     1XTEMP,MAXNXT,
     1ALOCML,SCALML,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR THE RAYLEIGH DISTRIBUTION
C     EXAMPLE--RAYLEIGH MAXIMUM LIKELIHOOD Y
C     REFERENCE--"CONTINUOUS UNIVARIATE DISTRIBUTIONS--VOLUME 1",
C                SECOND EDITION, JOHNSON, KOTZ, AND BALAKRISHNAN,
C                WILEY, 1994, P. 453.
C                THE MAXIMUM LIKELIHOOD ESTIMATE OF SCALE IS:
C
C                    SIGMAHAT = SQRT(SUM[i=1 to n][X(i)**2](2*N)]
C
C                WITH N DENOTING THE SAMPLE SIZE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/6
C     ORIGINAL VERSION--JUNE      2004.
C     UPDATED         --AUGUST    2005. MODIFY FORMAT OF OUTPUT TO MAKE MORE
C                                       CONSISTENT WITH OTHER ML ROUTINES
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*1 IBASLC
C
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION DTEMP
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
C
      PARAMETER (NUMALP=4)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWB(NUMALP)
      DIMENSION AHIGHB(NUMALP)
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
      DATA ALPHA /0.10, 0.05, 0.01, 0.001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='PO  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLRA')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLRA--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLRA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN RAYLEIGH MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS NON-POSITIVE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)N
 1112   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR FROM RAYLEIGH MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
C               **********************************
C               **  STEP 41--                   **
C               **  CARRY OUT CALCULATIONS      **
C               **  FOR RAYLEIGH           MLE  **
C               **  ESTIMATE (FULL SAMPLE CASE) **
C               **********************************
C
 2100 CONTINUE
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLRA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
C
      IWRITE='OFF'
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
C
      IF(RAYMIN.NE.CPUMIN)THEN
        IF(RAYMIN.LE.XMIN)THEN
          ALOCML=RAYMIN
        ELSE
          ALOCML=XMIN
        ENDIF
      ELSE
        ALOCML=XMIN
      ENDIF
C
      DSUM2=0.0D0
      DO2110I=1,N
        DSUM2=DSUM2 + DBLE(Y(I) - ALOCML)**2
 2110 CONTINUE
      DTEMP=DSQRT(DSUM2/(2.0D0*DBLE(N)))
      SCALML=REAL(DTEMP)
      SCALSE=SCALML/(2.0*SQRT(REAL(N)))
C
      NU=2*N
      DO2120I=1,NUMALP
        ALP=ALPHA(I)
        P=1.0-(ALP/2.0)
        CALL CHSPPF(P,NU,PPF1)
        P=ALP/2.0
        CALL CHSPPF(P,NU,PPF2)
        ALOWB(I)=SQRT(REAL(DSUM2)/PPF1)
        AHIGHB(I)=SQRT(REAL(DSUM2)/PPF2)
 2120 CONTINUE
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Rayleigh Parameter Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=250>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Mean:')
 5063   FORMAT('         Sample Standard Deviation:')
 5064   FORMAT('         Sample Minimum:')
 5069   FORMAT('         Sample Maximum:')
 5065   FORMAT('         Location Parameter (Data Minimum):')
 5068   FORMAT('         Location Parameter (User-Specified):')
 5066   FORMAT('         Estimate of Scale Parameter:')
 5067   FORMAT('         Standard Error of Scale Parameter:')
 5071   FORMAT('         Summary Statistics:')
 5072   FORMAT('         Maximum Likelihood Estimates:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5072)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        IF(ALOCML.EQ.XMIN)THEN
          WRITE(ICOUT,5068)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,5065)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALOCML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Limits for the Scale ',
     1         'Parameter</B>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=3>')
 5162   FORMAT('          <HR>')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        DO5140I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWB(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AHIGHB(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5140   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Rayleigh Parameter Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8034 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Location Parameter (Data Minimum): & ',G15.7,2X,A1,A1)
 8035 FORMAT(5X,'Location Parameter (User Specified): & ',
     1       G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Estimate of Scale Parameter: & ',
     1       G15.7,2X,A1,A1)
 8027 FORMAT(5X,'Standard Error of Scale Parameter: & ',
     1       G15.7,2X,A1,A1)
 8030 FORMAT(5X,'Summary Statistics:: & ',2X,A1,A1)
 8031 FORMAT(5X,'Maximum Likelihood Estimates:: & ',2X,A1,A1)
 8032 FORMAT(5X,' & ',2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8034)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8031)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(ALOCML.EQ.XMIN)THEN
          WRITE(ICOUT,8035)ALOCML,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8025)ALOCML,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8026)SCALML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)SCALSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8093   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for Scale Parameter}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8111)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper',2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit',2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,2X,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8130I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          WRITE(ICOUT,8131)ATEMP,ALOWB(I),AHIGHB(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8130   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8191 FORMAT(A1,'end{center}')
 8193 FORMAT(A1,'end{table}')
 8199 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8191)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8199)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4101)
 4101   FORMAT(12X,'RAYLEIGH MAXIMUM LIKELIHOOD ESTIMATION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4110)
 4110   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4111)N
 4111   FORMAT('THE NUMBER OF OBSERVATIONS          = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4113)XMEAN
 4113   FORMAT('THE SAMPLE MEAN                     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4115)XSD
 4115   FORMAT('THE SAMPLE STANDARD DEVIATION       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4117)XMIN
 4117   FORMAT('THE SAMPLE MINIMUM                  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4118)XMAX
 4118   FORMAT('THE SAMPLE MAXIMUM                  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4120)
 4120   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES:')
        CALL DPWRST('XXX','WRIT')
        IF(ALOCML.EQ.XMIN)THEN
          WRITE(ICOUT,4121)ALOCML
 4121     FORMAT('LOCATION PARAMETER (USER SPECIFIED) = ',G15.7)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4123)ALOCML
 4123     FORMAT('LOCATION PARAMETER (USER SPECIFIED) = ',G15.7)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,4125)SCALML
 4125   FORMAT('ESTIMATE OF SCALE PARAMETER          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4127)SCALSE
 4127   FORMAT('STANDARD ERROR OF SCALE PARAMETER    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4222)
 4222   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)
 4223   FORMAT('   CONFIDENCE           LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)
 4225   FORMAT('   VALUE (%)            LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4226)
 4226   FORMAT('---------------------------------------------------')
        CALL DPWRST('XXX','WRIT')
        DO4229I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,4227)ATEMP,ALOWB(I),AHIGHB(I)
 4227     FORMAT('   ',F8.3,10X,3(G12.6,2X))
          CALL DPWRST('XXX','WRIT')
 4229   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4131)
 4131   FORMAT('THE LOCATION AND SCALE PARAMETERS WILL BE SAVED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4133)
 4133   FORMAT('AS THE INTERNAL PARAMETERS LOCML AND SCALEML.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLRA')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLRA--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLTS(Y,N,A,B,
     1XTEMP,TEMP1,TEMP2,TEMP3,MAXNXT,
     1THETA,AN,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR THE TWO-SIDED POWER DISTRIBUTION
C     EXAMPLE--TWO-SIDED POWER MAXIMUM LIKELIHOOD Y
C     REFERENCE --"THE STANDARD TWO-SIDED POWER DISTRIBUTION AND
C                 ITS PROPERTIES WITH APPLICATIONS IN FINANCIAL
C                 ENGINEERING", J. RENE VAN DORP AND SAMUEL KOTZ,
C                 AMERICAN STATISTICIAN, VOLUME 56,
C                 NUMBER 2, MAY, 2002.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2002/5
C     ORIGINAL VERSION--MAY       2002.
C     UPDATED         --MARCH     2004. SUPPORT FOR HTML/LATEX OUTPUT
C     UPDATED         --AUGUST    2005. REFORMAT OUTPUT FOR CONSISTENCY
C                                       WITH OTHER ML ROUTINES
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*4 IWRITE
      CHARACTER*4 IBASLC
C
      DOUBLE PRECISION DSUM
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
      DIMENSION TEMP1(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP3(*)
      DOUBLE PRECISION DPROD
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='DPML'
      ISUBN2='TS  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLTS')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLTS--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLTS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN TWO-SIDED POWER MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS NON-POSITIVE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)N
 1112   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR FROM TWO-SIDED POWER MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
      DO1145I=1,N
        IF(Y(I).LE.A .OR. Y(I).GE.B)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1141)
 1141     FORMAT('***** ERROR FROM TWO-SIDED POWER MAXIMUM ',
     1           'LIKELIHOOD--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1142)I
 1142     FORMAT('      ELEMENT ',I8,' OF THE INPUT VARIABLE')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1143)A,B
 1143     FORMAT('      IS OUTSIDE THE ALLOWABLE (',
     1           G15.7,',',G15.7,') ','INTERVAL.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1144)Y(I)
 1144     FORMAT('      IT HAS THE VALUE ',E15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
 1145 CONTINUE
C
C               **********************************
C               **  STEP 21--                   **
C               **  CARRY OUT CALCULATIONS      **
C               **  FOR TWO-SIDED POWER    MLE  **
C               **  ESTIMATE (FULL SAMPLE CASE) **
C               **********************************
C
 2100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLTS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
C
      CALL SORT(Y,N,TEMP1)
      IWRITE='OFF'
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
C
      EPS=0.000001
      IF(A.EQ.0.0 .AND. B.EQ.0.0)THEN
        IF(A.GT.XMIN)A=XMIN-EPS
        IF(B.LT.XMAX)B=XMAX+EPS
      ENDIF
C
      IR=1
      AMAX=-999999.0
      DO5100J=1,N
        DPROD=1.0D0
        DO5200I=1,N
          IF(I.LT.J)THEN
            TEMP2(I)=(TEMP1(I)-A)/(TEMP1(J)-A)
          ELSE
            TEMP2(I)=(B-TEMP1(I))/(B-TEMP1(J))
          ENDIF
          DPROD=DPROD*DBLE(TEMP2(I))
 5200   CONTINUE
        TEMP3(J)=REAL(DPROD)
        IF(TEMP3(J).GT.AMAX)THEN
          IR=J
          AMAX=TEMP3(J)
        ENDIF
 5100 CONTINUE
C
      THETA=TEMP1(IR)
      AN=-REAL(N)/LOG(TEMP3(IR))
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Two-Sided Power Parameter ',
     1         'Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=250>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5060   FORMAT('         Summary Statistics:')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Mean:')
 5063   FORMAT('         Sample Standard Deviation:')
 5064   FORMAT('         Sample Minimum:')
 5065   FORMAT('         Sample Maximum:')
 5066   FORMAT('         Maximum Likelihood Estimates:')
 5067   FORMAT('         The (fixed) Lower Limit (Data Minimum):')
 5068   FORMAT('         The (fixed) Upper Limit (Data Maximum):')
 5069   FORMAT('         The (fixed) Lower Limit (User Specified):')
 5070   FORMAT('         The (fixed) Upper Limit (User Specified):')
 5071   FORMAT('         Shape Parameter Theta:')
 5072   FORMAT('         Shape Parameter N:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        IF(A.EQ.XMIN-EPS)THEN
          WRITE(ICOUT,5067)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,5069)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)A
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        IF(A.EQ.XMIN-EPS)THEN
          WRITE(ICOUT,5068)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,5070)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)B
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)THETA
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5072)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Two-Sided Power Parameter ',
     1       'Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Summary Statistics: & ',2X,A1,A1)
 8022 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8023 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,'  & ',G15.7,2X,A1,A1)
 8028 FORMAT(5X,'Maximum Likelihood Estimates: & ',G15.7,2X,A1,A1)
 8029 FORMAT(5X,'The (fixed) Lower Limit (Data Minimum):} & ',
     1       G15.7,2X,A1,A1)
 8030 FORMAT(5X,'The (fixed) Lower Limit (User Specified):} & ',
     1       G15.7,2X,A1,A1)
 8031 FORMAT(5X,'The (fixed) Upper Limit (Data Minimum):} & ',
     1       G15.7,2X,A1,A1)
 8032 FORMAT(5X,'The (fixed) Upper Limit (User Specified):} & ',
     1       G15.7,2X,A1,A1)
 8033 FORMAT(5X,'Shape Parameter $',A1,'theta$: & ',G15.7,2X,A1,A1)
 8034 FORMAT(5X,'Shape Parameter N: & ',G15.7,2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(A.EQ.XMIN-EPS)THEN
          WRITE(ICOUT,8029)A,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8031)B,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8030)A,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8032)B,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8033)THETA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8034)AN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{center}')
 8093 FORMAT(A1,'end{table}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4101)
 4101   FORMAT(12X,'TWO-SIDED POWER PARAMETER ESTIMATION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4102)
 4102   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4103)N
 4103   FORMAT('THE NUMBER OF OBSERVATIONS               = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4105)XMEAN
 4105   FORMAT('SAMPLE MEAN                              = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4107)XSD
 4107   FORMAT('SAMPLE STANDARD DEVIATION                = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4109)XMIN
 4109   FORMAT('SAMPLE MINIMUM                           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4111)XMAX
 4111   FORMAT('SAMPLE MAXIMUM                           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4120)
 4120   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES:')
        CALL DPWRST('XXX','WRIT')
        IF(A.EQ.XMIN-EPS)THEN
          WRITE(ICOUT,4123)A
 4123     FORMAT('THE (FIXED) LOWER LIMIT (DATA MINIMUM)    = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4125)B
 4125     FORMAT('THE (FIXED) UPPER LIMIT (DATA MINIMUM)    = ',G15.7)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4127)A
 4127     FORMAT('THE (FIXED) LOWER LIMIT (USER SPECIFIED)  = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4129)B
 4129     FORMAT('THE (FIXED) UPPER LIMIT (USER SPECIFIED)  = ',G15.7)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,4131)THETA
 4131   FORMAT('ESTIMATE OF THE SHAPE PARAMETER THETA    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4133)AN
 4133   FORMAT('THE ESTIMATE OF THE SHAPE PARAMETER N    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4141)
 4141   FORMAT('THE ESTIMATES OF THE SHAPE PARAMETERS WILL BE ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4143)
 4143   FORMAT('SAVED AS THE INTERNAL PARAMETERS THETAML AND NML.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLTS')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLTS--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLUN(Y,N,
     1XTEMP,MAXNXT,
     1ALOWLI,AUPPLI,ALOCML,ASCAML,AHAT,HHAT,
     1ALOWL2,AUPPL2,ALOCMO,ASCAMO,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE METHOD OF MOMENT AND
C              MAXIMUM LIKELIHOOD ESTIMATES FOR THE LOWER AND UPPER
C              LIMITS OF THE UNIFORM DISTRIBUTION
C     EXAMPLE--UNIFORM MOMENTS Y
C     REFERENCE--EVANS, HASTINGS, AND PEACOCK.  "STATISTICAL
C                DISTRIBUTIONS", THIRD EDITION, WILEY, 2000,
C                PP. 170-174
C                JOHNSON, KOTZ, AND BALAKRISHNAN.  "CONTINUOUS
C                UNIVARIATE DISTRIBUTIONS, VOLUME II", SECOND
C                EDITION, WILEY, 1994.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003/10
C     ORIGINAL VERSION--OCTOBER   2003.
C     UPDATED         --JULY      2005. ADD LOCATION/SCALE ESTIMATES
C                                       TO OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DSUM
      DOUBLE PRECISION DTERM1
C
      EXTERNAL RANGE
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
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='DPML'
      ISUBN2='UN  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLUN')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPMLUN--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,55)N
   55 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,MIN(N,100)
      WRITE(ICOUT,57)I,Y(I)
   57 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
   66 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN DPMLUN--THE NUMBER OF OBSERVATIONS ',
     1        'FOR VARIABLE 1 IS LESS THAN 3')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)N
 1112   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
      IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM DPMLUN--VARIABLE 1 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
 1290 CONTINUE
C
C               *******************************
C               **  STEP 41--                **
C               **  CARRY OUT CALCULATIONS   **
C               **  FOR UNIFORM MLE ESTIMATE **
C               *******************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL MIDRAN(Y,N,IWRITE,XMIDR,IBUGA3,IERROR)
      CALL RANGE(Y,N,IWRITE,XRANG,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      HHAT=0.5*XRANG
      AHAT=XMIDR
      ALOWLI=AHAT - HHAT
      AUPPLI=AHAT + HHAT
      ALO2LI=XMEAN - SQRT(3.0)*XSD
      AUP2LI=XMEAN + SQRT(3.0)*XSD
      ALOCMO=ALO2LI
      ASCAMO=AUP2LI - ALO2LI
      ALOCML=ALOWLI
      ASCAML=AUPPLI - ALOWLI
C
C               *********************************
C               **   STEP 42--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR UNIFORM MLE ESTIMATE   **
C               **********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5002   FORMAT('<H2>UNIFORM DISTRIBUTION PARAMETER ESTIMATION</H2>')
 5004   FORMAT('<BR><BR>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
C5015   FORMAT('   <CAPTION ALIGN=CENTER>')
C5017   FORMAT('      <B>Method of Maximum Likelihood</B>')
C5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5015)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5017)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5019)
CCCCC   CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=350>')
 5044   FORMAT('         <B>Summary Statistics</B>:')
 5144   FORMAT('         <B>Method of Moments</B>:')
 5244   FORMAT('         <B>Maximum Likelihood</B>:')
 5045   FORMAT('         Number of Observations:')
 5061   FORMAT('         Sample Mean:')
 5062   FORMAT('         Sample Standard Deviation:')
 5063   FORMAT('         Sample Minimum:')
 5064   FORMAT('         Sample Maximum:')
 5065   FORMAT('         Estimate of Lower Limit:')
 5066   FORMAT('         Estimate of Upper Limit:')
 5067   FORMAT('         Estimate of A:')
 5068   FORMAT('         Estimate of H:')
 5069   FORMAT('         Estimate of Location:')
 5070   FORMAT('         Estimate of Scale:')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5044)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5045)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5144)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALO2LI
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AUP2LI
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALOCMO
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5070)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ASCAMO
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5244)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AHAT
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)HHAT
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALOWLI
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AUPPLI
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ALOCML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5070)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ASCAML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Uniform Distribution Parameter ',
     1       'Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8120 FORMAT(5X,'{',A1,'bf Summary Statistics: & ',2X,A1,A1)
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8126 FORMAT(5X,'{',A1,'bf Method of Moment Estimation: & ',2X,A1,A1)
 8026 FORMAT(5X,'Estimate of Lower Limit: & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,'Estimate of Upper Limit: & ',G15.7,2X,A1,A1)
 8128 FORMAT(5X,'{',A1,'bf Maximum Likelihood Estimation: & ',2X,A1,A1)
 8028 FORMAT(5X,'Estimate of A: & ',G15.7,2X,A1,A1)
 8029 FORMAT(5X,'Estimate of H: & ',G15.7,2X,A1,A1)
 8030 FORMAT(5X,'Estimate of Location: & ',G15.7,2X,A1,A1)
 8031 FORMAT(5X,'Estimate of Scale: & ',G15.7,2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
C
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8120)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8126)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)ALO2LI,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)AUP2LI,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)ALOCMO,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)ASCAMO,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8128)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)AHAT,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)HHAT,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)ALOWLI,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)AUPPLI,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)ALOCML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)ASCAML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{table}')
 8093 FORMAT(A1,'end{center}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(12X,
     1  'UNIFORM DISTRIBUTION PARAMETER ESTIMATION')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4220)
 4220   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)N
 4221   FORMAT('NUMBER OF OBSERVATIONS                   = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4222)XMEAN
 4222   FORMAT('SAMPLE MEAN                              = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)XSD
 4223   FORMAT('SAMPLE STANDARD DEVIATION                = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4224)XMIN
 4224   FORMAT('SAMPLE MINIMUM                           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)XMAX
 4225   FORMAT('SAMPLE MAXIMUM                           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4230)
 4230   FORMAT('METHOD OF MOMENT ESTIMATES:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4231)ALO2LI
 4231   FORMAT('ESTIMATE OF LOWER LIMIT                  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4232)AUP2LI
 4232   FORMAT('ESTIMATE OF UPPER LIMIT                  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4233)ALOCMO
 4233   FORMAT('ESTIMATE OF LOCATION PARAMETER           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4234)ASCAMO
 4234   FORMAT('ESTIMATE OF SCALE PARAMETER              = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4240)
 4240   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4241)AHAT
 4241   FORMAT('ESTIMATE OF A                            = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)HHAT
 4242   FORMAT('ESTIMATE OF H                            = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)ALOWLI
 4243   FORMAT('ESTIMATE OF LOWER LIMIT                  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4244)AUPPLI
 4244   FORMAT('ESTIMATE OF UPPER LIMIT                  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)ALOCML
 4245   FORMAT('ESTIMATE OF LOCATION PARAMETER           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4246)ASCAML
 4246   FORMAT('ESTIMATE OF SCALE PARAMETER              = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4251)
 4251   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES WILL BE SAVED AS ',
     1         'INTERNAL PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4252)
 4252   FORMAT('LOWLIMIT, UPPLIMIT, AHAT, HHAT, LOCML, SCALEML.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4256)
 4256   FORMAT('METHOD OF MOMENT ESTIMATES WILL BE SAVED AS ',
     1         'INTERNAL PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4257)
 4257   FORMAT('LOWLIMI2, UPPLIMI2, LOCMOM, AND SCALEMOM.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLUN')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMLUN--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMLWE(XTEMP1,MAXNXT,
     1ICAPSW,
     1MINMAX,ISEED,
     1ICASAN,IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--COMPUTE MAXIMUM LIKELIHOOD ESTIMATES FOR
C              2-PARAMETER WEIBULL DISTRIBUTION
C     EXAMPLE--WEIBULL MAXIMUM LIKELIHOOD Y
C     REFERENCE--XX
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/3
C     ORIGINAL VERSION--MARCH     1998.
C     UPDATED         --MAY       1998. ADD SUPPORT FOR OTHER
C                                       DISTRIBUTIONS:
C                                          EXPONENTIAL
C                                          NORMAL
C                                          LOG-NORMAL
C                                          INVERSE GAUSSIAN
C                                          GUMBEL (EV1)
C                                          PARETO
C                                          GENERALIZED PARETO
C                                          BINOMIAL
C                                          POISSON
C     UPDATED         --MAY       1998. FOR GENERALIZED PARETO, ADD
C                                       DEHAAN AND CME
C     UPDATED         --JUNE      1998. ADD CENSORING VARIABLE FOR
C                                       EXPONENTIAL CASE
C     UPDATED         --JUNE      1998. ADD GAMMA CASE
C     UPDATED         --JUNE      1998. ADD POWER CASE
C     UPDATED         --JUNE      1998. ADD DOUBLE EXPONENTIAL CASE
C     UPDATED         --MARCH     1999. ADD GENERALIZED EXTREME VALUE
C     UPDATED         --MARCH     1999. ADD SUPPORT FOR WEIBULL
C                                       CENSORED CASE AND ADD CI
C                                       FOR WEIBULL
C     UPDATED         --MAY       2002. ADD SUPPORT FOR TWO-SIDED
C                                       POWER
C     UPDATED         --JULY      2003. ADD SUPPORT FOR JOHNSON SB
C                                       AND JOHNSON SU MOMENT
C                                       ESTIMATORS
C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML/LATEX OUTPUT
C     UPDATED         --OCTOBER   2003. SUPPORT FOR LOGISTIC
C     UPDATED         --OCTOBER   2003. SUPPORT FOR CAUCHY
C     UPDATED         --OCTOBER   2003. SUPPORT FOR BETA
C     UPDATED         --OCTOBER   2003. SUPPORT FOR UNIFORM
C     UPDATED         --NOVEMBER  2003. GENERALIZED PARETO
C                                       NOTE: THIS ONE STILL NEEDS SOME
C                                       ALGORITHMIC WORK, SO DON'T DOCUMENT
C                                       YET.
C     UPDATED         --MARCH     2004. LOGARITHMIC SERIES
C     UPDATED         --MARCH     2004. GEOMETRIC
C     UPDATED         --MARCH     2004. FATIGE LIFE
C     UPDATED         --MARCH     2004. GEOMETRIC EXTREME EXPONENTIAL
C     UPDATED         --MARCH     2004. FOLDED NORMAL
C     UPDATED         --MARCH     2004. UPDATE CAUCHY CASE
C     UPDATED         --MARCH     2004. CONFIDENCE INTERVAL FOR
C                                       BINOMIAL
C     UPDATED         --MARCH     2004. CONFIDENCE INTERVAL FOR
C                                       LOGNORMAL
C     UPDATED         --MARCH     2004. NEGATIVE BINOMIAL
C     UPDATED         --MARCH     2004. ADD BETA-BINOMIAL/POLYA
C     UPDATED         --MARCH     2004. HYPERGEOMETRIC
C     UPDATED         --APRIL     2004. HERMITE
C     UPDATED         --APRIL     2004. YULE
C     UPDATED         --APRIL     2004. WARING
C                                       THIS ONE STILL NEEDS SOME WORK
C     UPDATED         --APRIL     2004. ADD SUPPORT FOR JOHNSON SB/SU
C                                       PERCENTILE ESTIMATORS
C     UPDATED         --JUNE      2004. IGEPDF FOR GENERALIZED PARETO
C     UPDATED         --JUNE      2004. RAYLEIGH, MAXWELL
C     UPDATED         --AUGUST    2004. ASYMETRIC LAPLACE
C     UPDATED         --AUGUST    2004. NORMAL MIXTURE
C     UPDATED         --OCTOBER   2004. CENSORED NORMAL
C     UPDATED         --OCTOBER   2004. ESTIMATE CONFIDENCE INTERVALS
C                                       FOR PERCENTILES FOR SELECT
C                                       DISTRIBUTIONS (NORMAL,
C                                       EXPONENTIAL)
C     UPDATED         --OCTOBER   2004. SUPPORT EXPONENTIAL MLE FOR
C                                       GROUPED DATA
C     UPDATED         --MAY       2005. FRECHET
C     UPDATED         --AUGUST    2005. INVERTED WEIBULL
C     UPDATED         --FEBRUARY  2006. L-MOMENT ESTIMATES FOR
C                                       GENERALIZED LOGISTIC
C     UPDATED         --MARCH     2006. CALL LIST TO DPMLNM
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICASAN
      CHARACTER*4 IWRITE
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 IH11
      CHARACTER*4 IH12
      CHARACTER*4 IH21
      CHARACTER*4 IH22
      CHARACTER*4 IH31
      CHARACTER*4 IH32
      CHARACTER*4 IH41
      CHARACTER*4 IH42
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IUSE1
      CHARACTER*4 IUSE2
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IHOST1
      CHARACTER*4 ISUBN0
      CHARACTER*4 LOWLTY
      CHARACTER*4 UPPLTY
C
      CHARACTER*1 IBASLC
C
      CHARACTER*60 CJUNK
      CHARACTER*30 IDIST
      CHARACTER*4  IWEIFL
C
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IERRF1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
C
      CHARACTER*80 IFILE2
      CHARACTER*12 ISTAT2
      CHARACTER*12 IFORM2
      CHARACTER*12 IACCE2
      CHARACTER*12 IPROT2
      CHARACTER*12 ICURS2
      CHARACTER*4 IERRF2
      CHARACTER*4 IENDF2
      CHARACTER*4 IREWI2
C
      LOGICAL MLGEV
C
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION CCRIT
      DOUBLE PRECISION DMEW
      DOUBLE PRECISION DTHETA
      DOUBLE PRECISION SEM
      DOUBLE PRECISION SETH
      DOUBLE PRECISION RNL
C
C---------------------------------------------------------------------
C
      DIMENSION XTEMP1(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOF2.INC'
C
      DIMENSION QP(MAXOBV)
      DIMENSION XQPHAT(MAXOBV)
      DIMENSION XQPLCL(MAXOBV)
      DIMENSION XQPUCL(MAXOBV)
      DIMENSION XQPLC2(MAXOBV)
      DIMENSION XQPUC2(MAXOBV)
      DIMENSION XQPHTZ(MAXOBV)
      DIMENSION XQPLCZ(MAXOBV)
      DIMENSION XQPUCZ(MAXOBV)
      DIMENSION XQPSE(MAXOBV)
      DIMENSION TEMP1(MAXOBV)
      DIMENSION TEMP2(MAXOBV)
      DIMENSION TEMP3(MAXOBV)
      DIMENSION TEMP4(MAXOBV)
      DIMENSION TEMP5(MAXOBV)
      DIMENSION TEMP6(MAXOBV)
      INTEGER ITEMP1(MAXOBV)
      INTEGER ITEMP2(MAXOBV)
      INTEGER ITEMP3(MAXOBV,3)
      DOUBLE PRECISION DTEMP1(MAXOBV)
      DOUBLE PRECISION DTEMP2(MAXOBV)
      DOUBLE PRECISION DTEMP3(MAXOBV)
C
      DOUBLE PRECISION PAR(3)
      DOUBLE PRECISION VARCOV(6)
C
      INCLUDE 'DPCOZ2.INC'
      INCLUDE 'DPCOZD.INC'
      INCLUDE 'DPCOZI.INC'
      EQUIVALENCE (G2RBAG(IGAR11),TEMP1(1))
      EQUIVALENCE (G2RBAG(IGAR12),TEMP2(1))
      EQUIVALENCE (G2RBAG(IGAR13),TEMP3(1))
      EQUIVALENCE (G2RBAG(IGAR14),TEMP4(1))
      EQUIVALENCE (G2RBAG(IGAR15),QP(1))
      EQUIVALENCE (G2RBAG(IGAR16),XQPHAT(1))
      EQUIVALENCE (G2RBAG(IGAR17),XQPLCL(1))
      EQUIVALENCE (G2RBAG(IGAR18),XQPUCL(1))
      EQUIVALENCE (G2RBAG(IGAR19),XQPHTZ(1))
      EQUIVALENCE (G2RBAG(IGAR20),XQPLCZ(1))
      EQUIVALENCE (G2RBAG(IGAR21),XQPUCZ(1))
      EQUIVALENCE (G2RBAG(IGAR22),XQPLC2(1))
      EQUIVALENCE (G2RBAG(IGAR23),XQPUC2(1))
      EQUIVALENCE (G2RBAG(IGAR24),XQPSE(1))
      EQUIVALENCE (G2RBAG(IGAR25),TEMP5(1))
      EQUIVALENCE (G2RBAG(IGAR26),TEMP6(1))
      EQUIVALENCE (IGARBG(IIGAR1),ITEMP1(1))
      EQUIVALENCE (IGARBG(IIGAR2),ITEMP2(1))
      EQUIVALENCE (IGARBG(IIGAR3),ITEMP3(1,1))
      EQUIVALENCE (DGARBG(IDGAR1),DTEMP1(1))
      EQUIVALENCE (DGARBG(IDGAR2),DTEMP2(1))
      EQUIVALENCE (DGARBG(IDGAR3),DTEMP3(1))
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='WE  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      N1=(-999)
      N2=(-999)
C
      NS1=(-999)
      NS2=(-999)
C
      IUSE1='-999'
      IUSE2='-999'
C
      ILOCV=(-999)
C
      VALUE1=(-999.0)
      VALUE2=(-999.0)
C
      ICOL1=(-999)
      ICOL2=(-999)
C
      MINN2=1
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
      IWEIFL='WEIB'
      IF(ICASAN.EQ.'IWML')IWEIFL='IWEI'
C
      CJUNK='WEIBULL MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'GPDE')
     1  CJUNK='GENERALIZED PARETO DEHAAN ESTIMATION'
      IF(ICASAN.EQ.'GPME')
     1  CJUNK='GENERALIZED PARETO CME ESTIMATION'
      IF(ICASAN.EQ.'NOML')
     1  CJUNK='NORMAL MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'LGML')
     1  CJUNK='LOG-NORMAL MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'EXML')
     1  CJUNK='EXPONENTIAL MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'EXMG')
     1  CJUNK='EXPONENTIAL MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'PAML')
     1  CJUNK='PARETO MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'BIML')
     1  CJUNK='BINOMIAL MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'POML')
     1  CJUNK='POISSON MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'IGML')
     1  CJUNK='INVERSE GAUSSIAN MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'DEML')
     1  CJUNK='DOUBLE EXPONENTIAL MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'PWML')
     1  CJUNK='POWER MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'GUML')
     1  CJUNK='GUMBEL MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'FRML')
     1  CJUNK='FRECHET MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'GEML')
     1  CJUNK='GENERALIZED EXTREME VALUE MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'TSML')
     1  CJUNK='TWO-SIDED POWER'
      IF(ICASAN.EQ.'JOSB')
     1  CJUNK='JOHNSON SB METHOD OF MOMENT ESTIMATION'
      IF(ICASAN.EQ.'JOSU')
     1  CJUNK='JOHNSON SU METHOD OF MOMENT ESTIMATION'
      IF(ICASAN.EQ.'LOML')
     1  CJUNK='LOGISTIC MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'CAML')
     1  CJUNK='CAUCHY MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'UNIF')
     1  CJUNK='UNIFORM MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'BETA')
     1  CJUNK='BETA MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'GPML')
     1  CJUNK='GENERALIZED PARETO MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'DLML')
     1  CJUNK='LOGARITHMIC SERIES MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'NBML')
     1  CJUNK='NEGATIVE BINOMIAL MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'GMML')
     1  CJUNK='GEOMETRIC MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'FLML')
     1  CJUNK='FATIGUE LIFE MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'GXML')
     1  CJUNK=
     1  'GEOMETRIC EXTREME EXPONENTIAL MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'FNML')
     1  CJUNK=
     1  'FOLDED NORMAL MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'BBML')
     1  CJUNK=
     1  'BETA-BINOMIAL MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'PZML')
     1  CJUNK=
     1  'POLYA MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'HYML')
     1  CJUNK=
     1  'HYPERGEOMETRIC MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'HEML')
     1  CJUNK=
     1  'HERMITE MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'YUML')
     1  CJUNK=
     1  'YULE MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'WAML')
     1  CJUNK=
     1  'WARING MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'JOHN')
     1  CJUNK='JOHNSON SU/SB PERCENTILE ESTIMATION'
      IF(ICASAN.EQ.'RAYL')
     1  CJUNK='RAYLEIGH MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'MAXW')
     1  CJUNK='MAXWELL MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'ADML')
     1  CJUNK='ASYMMETRIC LAPLACE MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'NMML')
     1  CJUNK='NORMAL MIXTURE MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'IWML')
     1  CJUNK='INVERSE WEIBULL MAXIMUM LIKELIHOOD ESTIMATION'
      IF(ICASAN.EQ.'GLML')
     1  CJUNK='GENERALIZED LOGISTIC L-MOMENT ESTIMATION'
C
C               *************************************************
C               **  TREAT THE WEIBULL MAXIMUM LIKELIHOOD CASE  **
C               *************************************************
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MLWE')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPMLWE--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA2,IBUGA3,IBUGQ
   52   FORMAT('IBUGA2,IBUGA3,IBUGQ = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,55)ICASAN,MAXNXT
   55   FORMAT('ICASAN,MAXNXT = ',A4,2X,I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,56)ICENTY
   56   FORMAT('ICENTY = ',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MLWE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************
C               **  STEP 11--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               **  (THIS SHULD BE A VARIABLE.)       **
C               **  FOR HYPERGEOMETRIC, IT MAY BE A   **
C               **  PARAMETER.                        **
C               ****************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MLWE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IHWUSE='V'
      MESSAG='NO'
      IF(ICASAN.EQ.'HYML')MESSAG='NO'
      CALL CHECKN(IH11,IH12,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      IF(IERROR.EQ.'YES' .AND. ICASAN.EQ.'HYML')THEN
        N1=-1
        NUMV=1
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IH11,IH12,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'NO')THEN
           IUSE1=IUSE(ILOCV)
           NUMDEF=VALUE(ILOCV)+0.5
        ENDIF
      ENDIF
C
      IF(IERROR.EQ.'YES')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1141)
 1141    FORMAT('***** ERROR IN MAXIMUM LIKELIHOOD ESTIMATION--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1142)CJUNK
 1142    FORMAT('      FOR THE ',A60)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1145)
 1145    FORMAT('      THE ARGUMENT MUST BE A VARIABLE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1146)
 1146    FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1147)
 1147    FORMAT('      ARGUMENT 1 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1148)
 1148    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)THEN
           WRITE(ICOUT,1150)(IANS(I),I=1,MIN(IWIDTH,80))
 1150      FORMAT(80A1)
           CALL DPWRST('XXX','BUG ')
         ENDIF
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE1=IUSE(ILOCV)
      ICOL1=IVALUE(ILOCV)
      N1=IN(ILOCV)
      NUMV=1
 1190 CONTINUE
C
C               *******************************************************
C               **  STEP 12--                                        **
C               **  IF ARGUMENT 1 IS A VARIABLE,                     **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N1) **
C               **  FOR ARGUMENT 1 IS 2 OR MORE.                     **
C               *******************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MLWE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE1.EQ.'V'.AND.N1.LT.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1211)
 1211   FORMAT('***** ERROR IN MAXIMUM LIKELIHOOD ESTIMATION--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1212)
 1212   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1213)CJUNK
 1213   FORMAT('      ',A60,' WAS TO HAVE BEEN')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1215)MINN2
 1215   FORMAT('      PERFORMED MUST BE ',I8,' OR LARGER;  SUCH WAS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1217)IH11,IH12
 1217   FORMAT('      NOT THE CASE FOR VARIABLE ',A4,A4,' WHICH HAD')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1218)N1
 1218   FORMAT('      NUMBER OF OBSERVATIONS = ',I8,';')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1219)
 1219   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,1220)(IANS(I),I=1,MIN(80,IWIDTH))
 1220     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ********************************************
C               **  STEP 13--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 2      **
C               **  (THIS WILL BE THE TAG      VARIABLE)  **
C               ********************************************
C
      ISTEPN='13'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MLWE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV=2
      IF(NUMARG.LT.2)THEN
        NUMV=1
        ICOL2=-1
        N2=-1
        GOTO1399
      ENDIF
      IH21=IHARG(2)
      IH22=IHARG2(2)
      IHWUSE='V'
      MESSAG='NO'
      CALL CHECKN(IH21,IH22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
C  NOTE: BETA-BINOMIAL/POLYA CAN HAVE EITHER VARIABLE OR PARAMETER
C  FOR SECOND ARGUMENT.
C
C  NOTE: HYPERGEOMETRIC CAN HAVE EITHER VARIABLE OR PARAMETER
C  FOR SECOND ARGUMENT.
C
      NTRIAL=0
      NSAMP=0
      IF(IERROR.EQ.'YES')THEN
        NUMV=1
        ICOL2=-1
        N2=-1
        IF(ICASAN.EQ.'BBML' .OR. ICASAN.EQ.'PZML' .OR.
     1     ICASAN.EQ.'HYML')THEN
          IH21=IHARG(2)
          IH22=IHARG2(2)
          IHWUSE='P'
          MESSAG='NO'
          CALL CHECKN(IH21,IH22,IHWUSE,
     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,
     1                NUMNAM,MAXNAM,
     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'NO')THEN
            IF(ICASAN.EQ.'BBML' .OR. ICASAN.EQ.'PZML')THEN
              NTRIAL=VALUE(ILOCV)+0.5
            ELSEIF(ICASAN.EQ.'HYML')THEN
              NSAMP=VALUE(ILOCV)+0.5
            ENDIF
          ENDIF
        ENDIF
      ELSE
        NUMV=2
        ICOL2=IVALUE(ILOCV)
        N2=IN(ILOCV)
      ENDIF
 1399 CONTINUE
C
C               ******************************************************
C               **  STEP 14--                                       **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS     **
C               **  FOR THE TAG VARIABLE (NRIGHT) IS THE SAME AS    **
C               **  THE NUMBER OF OBSERVATIONS FOR THE RESPONSE     **
C               ** VARIABLE.                                        **
C               ******************************************************
C
      ISTEPN='13'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MLWE')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,1307)
 1307   FORMAT('NUMV = ',I4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(NUMV.LT.2.OR.N1.EQ.N2.OR.N2.LT.0)GOTO1390
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1311)
 1311   FORMAT('***** ERROR IN MAXIMUM LIKELIHOOD ESTIMATION--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1312)CJUNK
 1312   FORMAT('      IF TWO VARIABLES ARE SPECIFED FOR THE ',A40)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1313)
 1313   FORMAT('      THEY MUST HAVE THE SAME NUMBER OF ',
     1         'OBSERVATIONS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1314)
 1314   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1315)IH11,IH12,N1
 1315   FORMAT('      ',A4,A4,' HAS ',I8,' OBSERVATIONS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1316)IH21,IH22,N2
 1316   FORMAT('      ',A4,A4,' HAS ',I8,' OBSERVATIONS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1317)
 1317   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,1318)(IANS(I),I=1,MIN(IWIDTH,80))
 1318     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
 1390 CONTINUE
C
C               ************************************************
C               **  STEP 14B--                                **
C               **  CHECK THE VALIDITY OF ARGUMENT 3          **
C               **  (CURRENTLY, ONLY USED BY HYPERGEOMETRIC)  **
C               **  OCTOBER 2004: USE FOR GROUPED DATA WHEN   **
C               **  GROUPS CONSIST OF LOWER AND UPPER         **
C               **  BOUNDARIES (USEFUL FOR UNEQUAL BIN SIZES) **
C               ************************************************
C
      ISTEPN='13'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MLWE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LT.3)THEN
        ICOL3=-1
        N3=-1
        GOTO1499
      ENDIF
      IH31=IHARG(3)
      IH32=IHARG2(3)
      IHWUSE='V'
      MESSAG='NO'
      CALL CHECKN(IH31,IH32,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      NPOP=0
      NK=0
      IF(IERROR.EQ.'YES')THEN
        ICOL3=-1
        N3=-1
        IF(ICASAN.EQ.'HYML')THEN
          IH31=IHARG(3)
          IH32=IHARG2(3)
          IHWUSE='P'
          MESSAG='NO'
          CALL CHECKN(IH31,IH32,IHWUSE,
     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,
     1                NUMNAM,MAXNAM,
     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
          IF(IERROR.EQ.'NO')THEN
            IF(IHYPTY.EQ.'ACCE')THEN
              NPOP=VALUE(ILOCV)+0.5
            ELSE
              NK=VALUE(ILOCV)+0.5
            ENDIF
          ENDIF
        ENDIF
      ELSE
        NUMV=3
        ICOL3=IVALUE(ILOCV)
        N3=IN(ILOCV)
      ENDIF
 1499 CONTINUE
C
C               ******************************************************
C               **  STEP 14--                                       **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS     **
C               **  FOR THE TAG VARIABLE (NRIGHT) IS THE SAME AS    **
C               **  THE NUMBER OF OBSERVATIONS FOR THE RESPONSE     **
C               ** VARIABLE.                                        **
C               ******************************************************
C
      ISTEPN='14'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MLWE')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,1407)
 1407   FORMAT('NUMV = ',I4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(NUMV.LT.3.OR.N1.EQ.N3.OR.N3.LT.0)GOTO1490
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1411)
 1411   FORMAT('***** ERROR IN MAXIMUM LIKELIHOOD ESTIMATION--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1412)CJUNK
 1412   FORMAT('      IF THREE VARIABLES ARE SPECIFED FOR THE ',A40)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1413)
 1413   FORMAT('      THEY MUST HAVE THE SAME NUMBER OF ',
     1         'OBSERVATIONS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1414)
 1414   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1415)IH11,IH12,N1
 1415   FORMAT('      ',A4,A4,' HAS ',I8,' OBSERVATIONS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1416)IH21,IH22,N2
 1416   FORMAT('      ',A4,A4,' HAS ',I8,' OBSERVATIONS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1417)
 1417   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,1418)(IANS(I),I=1,MIN(IWIDTH,80))
 1418     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
 1490 CONTINUE
C
C               ******************************************************
C               **  STEP 15--                                       **
C               **  CHECK TO SEE IF A "PERCENTILES" VARIABLE HAS    **
C               **  BEEN SPECIFIED (VIA THE SET MAXIMIM LIKELIHOOD  **
C               **  PERCENTILES COMMAND).  IF SO, EXTRACT THE NAME. **
C               ******************************************************
C
      ISTEPN='15'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MLWE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IQUAVR.EQ.'NONE')THEN
        NPERC=0
      ELSEIF(IQUAVR.EQ.'DEFAULT')THEN
        QP(1)=0.5
        QP(2)=1.0
        QP(3)=5.0
        QP(4)=10.0
        QP(5)=20.0
        QP(6)=30.0
        QP(7)=40.0
        QP(8)=50.0
        QP(9)=60.0
        QP(10)=70.0
        QP(11)=80.0
        QP(12)=90.0
        QP(13)=95.0
        QP(14)=97.5
        QP(15)=99.0
        QP(16)=99.5
        NPERC=16
      ELSE
        IH41=IQUAVR(1:4)
        IH42=IQUAVR(5:8)
        IHWUSE='V'
        MESSAG='NO'
        CALL CHECKN(IH41,IH42,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
        IF(IERROR.EQ.'YES')THEN
          NPERC=0
        ELSE
          ICOLQP=IVALUE(ILOCV)
          NPERC=IN(ILOCV)
          ICNT=0
          DO4180I=1,NPERC
            IJ=MAXN*(ICOLQP-1)+I
            ICNT=ICNT+1
            IF(ICOLQP.LE.MAXCOL)QP(ICNT)=V(IJ)
            IF(ICOLQP.EQ.MAXCP1)QP(ICNT)=PRED(I)
            IF(ICOLQP.EQ.MAXCP2)QP(ICNT)=RES(I)
            IF(ICOLQP.EQ.MAXCP3)QP(ICNT)=YPLOT(I)
            IF(ICOLQP.EQ.MAXCP4)QP(ICNT)=XPLOT(I)
            IF(ICOLQP.EQ.MAXCP5)QP(ICNT)=X2PLOT(I)
            IF(ICOLQP.EQ.MAXCP6)QP(ICNT)=TAGPLO(I)
            IF(QP(ICNT).LE.0.0 .OR. QP(ICNT).GE.100.0)THEN
              ICNT=ICNT-1
            ENDIF
 4180     CONTINUE
          NPERC=ICNT
C
        ENDIF
      ENDIF
C
C
C               *****************************************
C               **  STEP 40--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='40'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MLWE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO4090
      DO4000J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO4010
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO4010
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO4020
 4000 CONTINUE
      GOTO4090
 4010 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO4090
 4020 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO4090
 4090 CONTINUE
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MLWE')THEN
        WRITE(ICOUT,4091)NUMARG,ILOCQ
 4091   FORMAT('NUMARG,ILOCQ = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***********************************************
C               **  STEP 41--                                **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)       **
C               **  WHICH WILL HOLD THE DATA  FROM SAMPLE 1. **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE1.NE.'V')GOTO4190
C
      ISTEPN='41'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MLWE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4110
      IF(ICASEQ.EQ.'SUBS')GOTO4120
      IF(ICASEQ.EQ.'FOR')GOTO4130
C
 4110 CONTINUE
      DO4115I=1,N1
      ISUB(I)=1
 4115 CONTINUE
      NQ=N1
      GOTO4150
C
 4120 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4150
C
 4130 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4150
C
 4150 CONTINUE
      IF(NQ.LT.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4151)
 4151   FORMAT('***** ERROR IN MAXIMUM LIKELIHOOD ESTIMATION--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4152)
 4152   FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1         'EXTRACTED,')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4153)IH11,IH12
 4153   FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1         'FROM VARIABLE ',A4,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4154)CJUNK
 4154   FORMAT('      FOR WHICH THE ',A60)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4156)MINN2
 4156   FORMAT('      IS TO BE PERFORMED MUST BE ',I8,' OR LARGER;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4157)NQ
 4157   FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4158)
 4158   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,4159)(IANS(I),I=1,MIN(80,IWIDTH))
 4159     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
      J=0
      IMAX=MAX(N1,N2,N3)
      IF(NQ.LT.IMAX)IMAX=NQ
      IF(IMAX.LT.1)GOTO4190
      DO4170I=1,IMAX
        IF(ISUB(I).EQ.0)GOTO4170
        J=J+1
C
        IF(ICASAN.EQ.'HYML' .AND. N1.LT.0)THEN
          Y(J)=REAL(NUMDEF)
        ELSE
          IJ=MAXN*(ICOL1-1)+I
          IF(ICOL1.LE.MAXCOL)Y(J)=V(IJ)
          IF(ICOL1.EQ.MAXCP1)Y(J)=PRED(I)
          IF(ICOL1.EQ.MAXCP2)Y(J)=RES(I)
          IF(ICOL1.EQ.MAXCP3)Y(J)=YPLOT(I)
          IF(ICOL1.EQ.MAXCP4)Y(J)=XPLOT(I)
          IF(ICOL1.EQ.MAXCP5)Y(J)=X2PLOT(I)
          IF(ICOL1.EQ.MAXCP6)Y(J)=TAGPLO(I)
        ENDIF
C
        IF(ICASAN.EQ.'HYML' .AND. N2.LT.0)THEN
          ITEMP2(J)=NSAMP
        ELSE
          IF(NUMV.LE.1)GOTO4170 
C
          IF(ICASAN.EQ.'BBML' .OR. ICASAN.EQ.'PZML' .OR.
     1       ICASAN.EQ.'HYML')THEN
            IJ=MAXN*(ICOL2-1)+I
            IF(ICOL2.LE.MAXCOL)ITEMP2(J)=INT(V(IJ)+0.5)
            IF(ICOL2.EQ.MAXCP1)ITEMP2(J)=INT(PRED(I)+0.5)
            IF(ICOL2.EQ.MAXCP2)ITEMP2(J)=INT(RES(I)+0.5)
            IF(ICOL2.EQ.MAXCP3)ITEMP2(J)=INT(YPLOT(I)+0.5)
            IF(ICOL2.EQ.MAXCP4)ITEMP2(J)=INT(XPLOT(I)+0.5)
            IF(ICOL2.EQ.MAXCP5)ITEMP2(J)=INT(X2PLOT(I)+0.5)
            IF(ICOL2.EQ.MAXCP6)ITEMP2(J)=INT(TAGPLO(I)+0.5)
          ELSE
            IJ=MAXN*(ICOL2-1)+I
            IF(ICOL2.LE.MAXCOL)TEMP4(J)=V(IJ)
            IF(ICOL2.EQ.MAXCP1)TEMP4(J)=PRED(I)
            IF(ICOL2.EQ.MAXCP2)TEMP4(J)=RES(I)
            IF(ICOL2.EQ.MAXCP3)TEMP4(J)=YPLOT(I)
            IF(ICOL2.EQ.MAXCP4)TEMP4(J)=XPLOT(I)
            IF(ICOL2.EQ.MAXCP5)TEMP4(J)=X2PLOT(I)
            IF(ICOL2.EQ.MAXCP6)TEMP4(J)=TAGPLO(I)
          ENDIF
        ENDIF
C
        IF(ICASAN.EQ.'HYML' .AND. N3.LT.0)THEN
          IF(IHYPTY.EQ.'ACCE')THEN
            ITEMP1(J)=NPOP
          ELSE
            ITEMP1(J)=NK
          ENDIF
        ELSE
          IF(NUMV.LE.2)GOTO4170 
C
          IF(ICASAN.EQ.'HYML')THEN
            IJ=MAXN*(ICOL2-1)+I
            IF(ICOL2.LE.MAXCOL)ITEMP1(J)=INT(V(IJ)+0.5)
            IF(ICOL2.EQ.MAXCP1)ITEMP1(J)=INT(PRED(I)+0.5)
            IF(ICOL2.EQ.MAXCP2)ITEMP1(J)=INT(RES(I)+0.5)
            IF(ICOL2.EQ.MAXCP3)ITEMP1(J)=INT(YPLOT(I)+0.5)
            IF(ICOL2.EQ.MAXCP4)ITEMP1(J)=INT(XPLOT(I)+0.5)
            IF(ICOL2.EQ.MAXCP5)ITEMP1(J)=INT(X2PLOT(I)+0.5)
            IF(ICOL2.EQ.MAXCP6)ITEMP1(J)=INT(TAGPLO(I)+0.5)
          ELSE
            IJ=MAXN*(ICOL2-1)+I
            IF(ICOL2.LE.MAXCOL)TEMP5(J)=V(IJ)
            IF(ICOL2.EQ.MAXCP1)TEMP5(J)=PRED(I)
            IF(ICOL2.EQ.MAXCP2)TEMP5(J)=RES(I)
            IF(ICOL2.EQ.MAXCP3)TEMP5(J)=YPLOT(I)
            IF(ICOL2.EQ.MAXCP4)TEMP5(J)=XPLOT(I)
            IF(ICOL2.EQ.MAXCP5)TEMP5(J)=X2PLOT(I)
            IF(ICOL2.EQ.MAXCP6)TEMP5(J)=TAGPLO(I)
          ENDIF
        ENDIF
C
 4170 CONTINUE
      NS1=J
C
 4190 CONTINUE
      IF(ICASAN.EQ.'HYML' .AND. IMAX.LT.0)THEN
        Y(1)=REAL(NUMDEF)
        ITEMP2(1)=NSAMP
        IF(IHYPTY.EQ.'ACCE')THEN
          ITEMP1(1)=NPOP
        ELSE
          ITEMP1(1)=NK
        ENDIF
        NS1=1
      ENDIF
C
C               ***********************************
C               **  STEP 52--                    **
C               **  DO THE MLE ESTIMATION        **
C               ***********************************
C
      ISTEPN='52'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO5290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5211)
 5211 FORMAT('***** FROM DPMLWE, AS WE ARE ABOUT TO CALL DPMLW1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5212)N1,N2,NS1,NS2,MAXN
 5212 FORMAT('N1,N2,NS1,NS2,MAXN = ',5I8)
      CALL DPWRST('XXX','BUG ')
      DO5215I=1,NS1
      WRITE(ICOUT,5216)I,Y(I)
 5216 FORMAT('I,Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5215 CONTINUE
      WRITE(ICOUT,5231)IBUGA3
 5231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 5290 CONTINUE
C
C  MARCH 1999.  USE ROUTINE THAT GENERATES CONFIDENCE INTERVAL
C               AND ALSO GENERATES CONFIDENCE INTERVALS FOR CENSORED
C               DATA.
C  AUGUST 2005. INVERTED WEIBULL DISTRIBUTION CAN BE ESTIMATED
C               WITH THE SAME ROUTINES AS THE REGULAR WEIBULL.
C
      IF(ICASAN.EQ.'WEML' .OR. ICASAN.EQ.'IWML')THEN
CCCCC   IF(ICENTY.EQ.'NONE')THEN
CCCCC     CALL DPMLW2(Y,NS1,
CCCCC1              XTEMP1,MAXNXT,
CCCCC1              GAMMA,ALPHA,
CCCCC1              ISUBRO,IBUGA3,IERROR)
CCCCC   ELSEIF(ICENTY.EQ.'1   '.OR.ICENTY.EQ.'2   ')THEN
CCCCC     IHP='TEND'
CCCCC     IHP2='    '
CCCCC     IHWUSE='P'
CCCCC     MESSAG='NO'
CCCCC     CALL CHECKN(IHP,IHP2,IHWUSE,
CCCCC1    IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
CCCCC1    ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
CCCCC     TEND=0.0
CCCCC     IF(IERROR.EQ.'NO')TEND=VALUE(ILOCP)
C
CCCCC     CALL DPMLWC(Y,TEMP4,NS1,
CCCCC1              XTEMP1,MAXNXT,
CCCCC1              GAMMA,ALPHA,NUMV,ICENTY,TEND,
CCCCC1              ISUBRO,IBUGA3,IERROR)
CCCCC   ENDIF
C
        IOUNI1=IST1NU
        IFILE1=IST1NA
        ISTAT1=IST1ST
        IFORM1=IST1FO
        IACCE1=IST1AC
        IPROT1=IST1PR
        ICURS1=IST1CS
        ISUBN0='MLWE'
        IERRF1='NO'
C
        IREWI1='ON'
        CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
        IOUNI2=IST2NU
        IFILE2=IST2NA
        ISTAT2=IST2ST
        IFORM2=IST2FO
        IACCE2=IST2AC
        IPROT2=IST2PR
        ICURS2=IST2CS
        ISUBN0='MLWE'
        IERRF2='NO'
C
        IREWI2='ON'
        CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,
     1            ICURS2,
     1            IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
        IF(IERRF2.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        ALPHA=0.05
        IF(IERROR.EQ.'NO')ALPHA=VALUE(ILOCP)
        IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)THEN
          ALPHA=0.05
        ELSEIF(ALPHA.GT.0.50)THEN
          ALPHA=1.0-ALPHA
        ENDIF
C
        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MLWE')THEN
          WRITE(ICOUT,5331)ICENTY,IWBCAS,NUMV
 5331     FORMAT('ICENTY,IWBCAS,NUMV = ',A4,I5,I5)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IF(NUMV.EQ.1)THEN
          CALL DPMLW1(Y,TEMP4,NS1,
     1                XTEMP1,DTEMP1,MAXNXT,
     1                SCALE,SCALSE,GAMMA,GAMMSE,GAMMBC,GABCSE,
     1                COVSE,COBCSE,
     1                NUMV,ICENTY,TEND,
     1                ICAPSW,ICAPTY,IWEIBC,IWEIFL,
     1                QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
     1                IOUNI1,IOUNI2,ALPHA,
     1                ISUBRO,IBUGA3,IERROR)
        ELSEIF(NUMV.EQ.2 .AND. ICENTY.NE.'2')THEN
          CALL DPMLW2(Y,TEMP4,NS1,
     1                XTEMP1,DTEMP1,MAXNXT,
     1                SCALE,SCALSE,GAMMA,GAMMSE,GAMMBC,GABCSE,
     1                COVSE,COBCSE,
     1                NUMV,ICENTY,TEND,
     1                ICAPSW,ICAPTY,IWEIBC,IWEIFL,
     1                QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
     1                IOUNI1,IOUNI2,ALPHA,
     1                ISUBRO,IBUGA3,IERROR)
        ELSE
          IF(NUMV.EQ.1)THEN
            IWBCAS=3
          ELSEIF(NUMV.EQ.2)THEN
            IWBCAS=2
            IF(ICENTY.EQ.'3')IWBCAS=1
          ELSE
            IWBCAS=3
          ENDIF 
          DO810I=1,NS1
            IF(Y(I).LT.0.0)THEN
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,813)
              CALL DPWRST('XXX','BUG ')
              IERROR='YES'
              GOTO9000
            ENDIF
            DTEMP1(I)=DBLE(Y(I))
            IF(IWBCAS.EQ.3)THEN
              ITEMP1(I)=1
            ELSE
              ITEMP1(I)=INT(TEMP4(I)+0.5)
            ENDIF
            IF(ITEMP1(I).LE.0)ITEMP1(I)=0
            IF(ITEMP1(I).GE.1)ITEMP1(I)=1
  810     CONTINUE
          IERROR='NO'
  813     FORMAT('***** ERROR FOR WEIBULL MLE.  NEGATIVE NUMBER ',
     1           'ENCOUNTERED.')
          CALL WEICEN(DTEMP1,ITEMP1,DTEMP2,DTEMP3,IWBCAS,NS1,
     1                GAMMA,SCALE,
     1                ICAPSW,ICAPTY,
     1                IERROR)
        ENDIF
        IF(IERROR.EQ.'YES')GOTO9000
        IENDF1='OFF'
        IREWI1='ON'
        CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
        IENDF2='OFF'
        IREWI2='ON'
        CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,
     1              ICURS2,
     1              IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
        IF(IERRF2.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='GAMM'
        IH2='AML '
        VALUE0=GAMMA
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='GAMM'
        IH2='ASE '
        VALUE0=GAMMSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='ALPH'
        IH2='AML '
        VALUE0=SCALE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='ALPH'
        IH2='ASE '
        VALUE0=SCALSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IF(NUMV.LE.1)THEN
          IH='GAMM'
          IH2='ABC '
          VALUE0=GAMMBC
          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1    IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1    IANS,IWIDTH,IBUGA3,IERROR)
C
          IH='GAMM'
          IH2='BCSE'
          VALUE0=GABCSE
          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1    IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1    IANS,IWIDTH,IBUGA3,IERROR)
C
          IH='COVS'
          IH2='E   '
          VALUE0=COVSE
          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1    IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1    IANS,IWIDTH,IBUGA3,IERROR)
C
          IH='COVB'
          IH2='CSE '
          VALUE0=COBCSE
          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1    IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1    IANS,IWIDTH,IBUGA3,IERROR)
C
        ENDIF
      ELSEIF(ICASAN.EQ.'FRML')THEN
C
        IOUNI1=IST1NU
        IFILE1=IST1NA
        ISTAT1=IST1ST
        IFORM1=IST1FO
        IACCE1=IST1AC
        IPROT1=IST1PR
        ICURS1=IST1CS
        ISUBN0='MLWE'
        IERRF1='NO'
C
        IREWI1='ON'
        CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
        IOUNI2=IST2NU
        IFILE2=IST2NA
        ISTAT2=IST2ST
        IFORM2=IST2FO
        IACCE2=IST2AC
        IPROT2=IST2PR
        ICURS2=IST2CS
        ISUBN0='MLWE'
        IERRF2='NO'
C
        IREWI2='ON'
        CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,
     1            ICURS2,
     1            IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
        IF(IERRF2.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        ALPHA=0.05
        IF(IERROR.EQ.'NO')ALPHA=VALUE(ILOCP)
        IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)THEN
          ALPHA=0.05
        ELSEIF(ALPHA.GT.0.50)THEN
          ALPHA=1.0-ALPHA
        ENDIF
C
        IF(NUMV.EQ.1)THEN
          CALL DPMLFR(Y,TEMP4,NS1,
     1                XTEMP1,DTEMP1,MAXNXT,
     1                SCALE,SCALSE,GAMMA,GAMMSE,GAMMBC,GABCSE,
     1                COVSE,COBCSE,
     1                NUMV,ICENTY,TEND,
     1                ICAPSW,ICAPTY,IFREBC,
     1                QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
     1                IOUNI1,IOUNI2,ALPHA,
     1                ISUBRO,IBUGA3,IERROR)
        ELSEIF(NUMV.EQ.2 .AND. ICENTY.NE.'2')THEN
C
C         CENSORED CASE NOT CURRENTLY SUPPORTED.
C
        ENDIF
        IF(IERROR.EQ.'YES')GOTO9000
        IENDF1='OFF'
        IREWI1='ON'
        CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
        IENDF2='OFF'
        IREWI2='ON'
        CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,
     1              ICURS2,
     1              IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
        IF(IERRF2.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='GAMM'
        IH2='AML '
        VALUE0=GAMMA
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='GAMM'
        IH2='ASE '
        VALUE0=GAMMSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='ALPH'
        IH2='AML '
        VALUE0=SCALE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='ALPH'
        IH2='ASE '
        VALUE0=SCALSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IF(NUMV.LE.1)THEN
          IH='GAMM'
          IH2='ABC '
          VALUE0=GAMMBC
          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1    IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1    IANS,IWIDTH,IBUGA3,IERROR)
C
          IH='GAMM'
          IH2='BCSE'
          VALUE0=GABCSE
          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1    IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1    IANS,IWIDTH,IBUGA3,IERROR)
C
          IH='COVS'
          IH2='E   '
          VALUE0=COVSE
          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1    IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1    IANS,IWIDTH,IBUGA3,IERROR)
C
          IH='COVB'
          IH2='CSE '
          VALUE0=COBCSE
          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1    IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1    IANS,IWIDTH,IBUGA3,IERROR)
C
        ENDIF
      ELSEIF(ICASAN.EQ.'NOML')THEN
C
        IOUNI1=IST1NU
        IFILE1=IST1NA
        ISTAT1=IST1ST
        IFORM1=IST1FO
        IACCE1=IST1AC
        IPROT1=IST1PR
        ICURS1=IST1CS
        ISUBN0='MLWE'
        IERRF1='NO'
C
        IREWI1='ON'
        CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
        IF(NUMV.GT.1)THEN
          IOUNI2=IST2NU
          IFILE2=IST2NA
          ISTAT2=IST2ST
          IFORM2=IST2FO
          IACCE2=IST2AC
          IPROT2=IST2PR
          ICURS2=IST2CS
          ISUBN0='MLWE'
          IERRF2='NO'
C
          IREWI2='ON'
          CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,
     1              ICURS2,
     1              IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
          IF(IERRF2.EQ.'YES')GOTO9000
C
        ENDIF
C
        IHP='ALPH'
        IHP2='A   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        ALPHA=0.05
        IF(IERROR.EQ.'NO')ALPHA=VALUE(ILOCP)
        IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)THEN
          ALPHA=0.05
        ELSEIF(ALPHA.GT.0.50)THEN
          ALPHA=1.0-ALPHA
        ENDIF
C
        CALL DPMLNO(Y,TEMP4,NS1,
     1              XTEMP1,DTEMP1,MAXNXT,
     1              QP,XQPHAT,XQPLCL,XQPUCL,NPERC,
     1              XMEAN,XSD,
     1              ICAPSW,ICAPTY,NUMV,
     1              IOUNI1,IOUNI2,ALPHA,
     1              ISUBRO,IBUGA3,IERROR)
C
        IENDF1='OFF'
        IREWI1='ON'
        CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
        IF(NUMV.GT.1)THEN
          IENDF2='OFF'
          IREWI2='ON'
          CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,
     1              ICURS2,
     1              IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
          IF(IERRF2.EQ.'YES')GOTO9000
        ENDIF
C
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='XMEA'
        IH2='N   '
        VALUE0=XMEAN
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='XSD '
        IH2='    '
        VALUE0=XSD
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'NMML')THEN
C
        IHP='NCOM'
        IHP2='P   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        NCOMP=2
        IF(IERROR.EQ.'NO')NCOMP=INT(VALUE(ILOCP)+0.5)
C
        IF(NCOMP.LT.2)NCOMP=2
        CALL DPMLNM(Y,TEMP4,NS1,NUMV,TEMP1,TEMP2,N2,
     1              TEMP3,XTEMP1,TEMP4,ITEMP1,MAXNXT,
     1              CLLIMI,CLWIDT,NCOMP,
     1              TEMP5,IHSTCW,MAXOBV,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
      ELSEIF(ICASAN.EQ.'LGML')THEN
C
        IOUNI1=IST1NU
        IFILE1=IST1NA
        ISTAT1=IST1ST
        IFORM1=IST1FO
        IACCE1=IST1AC
        IPROT1=IST1PR
        ICURS1=IST1CS
        ISUBN0='MLWE'
        IERRF1='NO'
C
        IREWI1='ON'
        CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        ALPHA=0.05
        IF(IERROR.EQ.'NO')ALPHA=VALUE(ILOCP)
        IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)THEN
          ALPHA=0.05
        ELSEIF(ALPHA.GT.0.50)THEN
          ALPHA=1.0-ALPHA
        ENDIF
C
        IF(NUMV.EQ.1)THEN
          CALL DPMLL1(Y,TEMP4,NS1,
     1                XTEMP1,DTEMP1,MAXNXT,
     1                SIGMA,SIGMSE,SCALE,SCALSE,UHAT,UHATSE,
     1                NUMV,ICENTY,TEND,
     1                ICAPSW,ICAPTY,
     1                QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
     1                IOUNI1,IOUNI2,ALPHA,
     1                ISUBRO,IBUGA3,IERROR)
          COVSE=0.0
          IF(IERROR.EQ.'YES')GOTO9000
        ELSEIF(NUMV.EQ.2)THEN
          CALL DPMLL2(Y,TEMP4,NS1,
     1                XTEMP1,DTEMP1,MAXNXT,
     1                SIGMA,SIGMSE,SCALE,SCALSE,UHAT,UHATSE,COVSE,
     1                NUMV,ICENTY,TEND,
     1                ICAPSW,ICAPTY,
     1                QP,XQPHAT,XQPLCL,XQPUCL,XQPLC2,XQPUC2,XQPSE,NPERC,
     1                IOUNI1,IOUNI2,ALPHA,
     1                ISUBRO,IBUGA3,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
        ENDIF
C
        IENDF1='OFF'
        IREWI1='ON'
        CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='SIGM'
        IH2='AML '
        VALUE0=SIGMA
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SIGM'
        IH2='ASE '
        VALUE0=SIGMSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EML '
        VALUE0=SCALE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='ESE '
        VALUE0=SCALSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='UHAT'
        IH2='ML  '
        VALUE0=UHAT
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='UHAT'
        IH2='SE  '
        VALUE0=UHATSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='COVS'
        IH2='E   '
        VALUE0=COVSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
CCCCC   CALL DPMLLN(Y,NS1,
CCCCC1              XTEMP1,MAXNXT,
CCCCC1              XSD,XSCALE,
CCCCC1              ICAPSW,ICAPTY,
CCCCC1              ISUBRO,IBUGA3,IERROR)
CCCCC   IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
CCCCC   ISTEPN='61'
CCCCC   IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC   ISUBN0='DPML'
C
CCCCC   IH='XSCA'
CCCCC   IH2='LE  '
CCCCC   VALUE0=XSCALE
CCCCC   CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
CCCCC1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
CCCCC1  IANS,IWIDTH,IBUGA3,IERROR)
C
CCCCC   IH='XSD '
CCCCC   IH2='    '
CCCCC   VALUE0=XSD
CCCCC   CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
CCCCC1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
CCCCC1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'EXML' .OR. ICASAN.EQ.'EXMG')THEN
C
        IOUNI1=IST1NU
        IFILE1=IST1NA
        ISTAT1=IST1ST
        IFORM1=IST1FO
        IACCE1=IST1AC
        IPROT1=IST1PR
        ICURS1=IST1CS
        ISUBN0='MLWE'
        IERRF1='NO'
C
        IREWI1='ON'
        CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
        IOUNI2=IST2NU
        IFILE2=IST2NA
        ISTAT2=IST2ST
        IFORM2=IST2FO
        IACCE2=IST2AC
        IPROT2=IST2PR
        ICURS2=IST2CS
        ISUBN0='MLWE'
        IERRF2='NO'
C
        IREWI2='ON'
        CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,
     1            ICURS2,
     1            IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
        IF(IERRF2.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        ALPHA=0.05
        IF(IERROR.EQ.'NO')ALPHA=VALUE(ILOCP)
        IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)THEN
          ALPHA=0.05
        ELSEIF(ALPHA.GT.0.50)THEN
          ALPHA=1.0-ALPHA
        ENDIF
C
        IHP='TEND'
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        TEND=0.0
        IF(IERROR.EQ.'NO')TEND=VALUE(ILOCP)
C
CCCCC   FULL SAMPLE CASE
C
        IF(NUMV.LE.1 .AND. ICASAN.EQ.'EXML')THEN
          CALL DPMLE1(Y,TEMP4,NS1,
     1                XTEMP1,MAXNXT,
     1                U,B1,B2,NUMV,ICENTY,TEND,
     1                ICAPSW,ICAPTY,IEXPBC,
     1                QP,XQPHAT,XQPLCL,XQPUCL,NPERC,
     1                XQPHTZ,XQPLCZ,XQPUCZ,
     1                IOUNI1,IOUNI2,ALPHA,
     1                ISUBRO,IBUGA3,IERROR)
C
CCCCC   TIME CENSORED CASE
C
        ELSEIF(NUMV.EQ.2 .AND. ICENTY.EQ.'1'.AND.ICASAN.EQ.'EXML')THEN
          CALL DPMLE2(Y,TEMP4,NS1,
     1                XTEMP1,MAXNXT,
     1                U,B1,B2,NUMV,ICENTY,TEND,
     1                ICAPSW,ICAPTY,
     1                QP,XQPHAT,XQPLCL,XQPUCL,NPERC,
     1                XQPHTZ,XQPLCZ,XQPUCZ,
     1                IOUNI1,IOUNI2,ALPHA,
     1                ISUBRO,IBUGA3,IERROR)
C
CCCCC   NUMBER OF FAILURES CENSORED CASE
C
        ELSEIF(NUMV.EQ.2 .AND. ICENTY.EQ.'2'.AND.ICASAN.EQ.'EXML')THEN
          CALL DPMLE3(Y,TEMP4,NS1,
     1                XTEMP1,MAXNXT,
     1                U,B1,B2,NUMV,ICENTY,TEND,
     1                ICAPSW,ICAPTY,
     1                QP,XQPHAT,XQPLCL,XQPUCL,NPERC,
     1                XQPHTZ,XQPLCZ,XQPUCZ,
     1                IOUNI1,IOUNI2,ALPHA,
     1                ISUBRO,IBUGA3,IERROR)
C
CCCCC   GROUPED DATA CASE
C
        ELSEIF(NUMV.GE.2 .AND. ICASAN.EQ.'EXMG')THEN
          NPERC=0
          CALL DPMLE4(Y,TEMP4,TEMP5,NS1,
     1                XTEMP1,MAXNXT,
     1                U,B1,B2,NUMV,ICENTY,TEND,
     1                ICAPSW,ICAPTY,
     1                QP,XQPHAT,XQPLCL,XQPUCL,NPERC,
     1                XQPHTZ,XQPLCZ,XQPUCZ,
     1                IOUNI1,IOUNI2,ALPHA,
     1                ISUBRO,IBUGA3,IERROR)
CCCCC   ELSE
CCCCC     CALL DPMLEX(Y,TEMP4,NS1,
CCCCC1                XTEMP1,MAXNXT,
CCCCC1                U,B1,B2,NUMV,ICENTY,TEND,
CCCCC1                ICAPSW,ICAPTY,
CCCCC1                QP,XQPHAT,XQPLCL,XQPUCL,NPERC,
CCCCC1                IOUNI1,IOUNI2,ALPHA,
CCCCC1                ISUBRO,IBUGA3,IERROR)
        ENDIF
C
        IENDF1='OFF'
        IREWI1='ON'
        CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
        IENDF2='OFF'
        IREWI2='ON'
        CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,
     1              ICURS2,
     1              IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
        IF(IERRF2.EQ.'YES')GOTO9000
C
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='B1  '
        IH2='    '
        VALUE0=B1
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='B2  '
        IH2='    '
        VALUE0=B2
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='U1  '
        IH2='    '
        VALUE0=U
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='U2  '
        IH2='    '
        VALUE0=U
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'DEML')THEN
C
        CALL DPMLDE(Y,NS1,
     1              XTEMP1,MAXNXT,
     1              ALOC,SCALE,ALOCSE,SCALESE,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='SCAL'
        IH2='EML '
        VALUE0=SCALE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='LOCM'
        IH2='L   '
        VALUE0=ALOC
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='LOCS'
        IH2='E   '
        VALUE0=ALOCSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='ESE '
        VALUE0=SCALSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'ADML')THEN
C
        CALL DPMLAD(Y,NS1,
     1              XTEMP1,MAXNXT,DTEMP1,DTEMP2,DTEMP3,ITEMP1,
     1              AKML,ALOCML,SCALEML,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
C
C  UPDATE PARAMETERS EVEN IF ERROR.  ML DOES NOT EXIST FOR
C  SOME DATA SETS, DPMLAD WILL SET SHAPE PARAMETER TO -999
C  IF THIS DETECTED.  SETTING PARAMETER WILL ALLOW USER
C  EXPLICITLY CHECK (USEFUL FOR AUTOMATING IN BATCH JOBS).
C
CCCCC   IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='SCAL'
        IH2='EML '
        VALUE0=SCALEML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='LOCM'
        IH2='L   '
        VALUE0=ALOCML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='KML '
        IH2='    '
        VALUE0=AKML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'IGML')THEN
C
        CALL DPMLIG(Y,NS1,
     1              XTEMP1,MAXNXT,
     1              GAMMA,XSCALE,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='GAMM'
        IH2='AML '
        VALUE0=GAMMA
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='MUML'
        IH2='    '
        VALUE0=XSCALE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'GUML')THEN
C
CCCCC   CALL DPMLGU(Y,NS1,
CCCCC1              XTEMP1,MAXNXT,
CCCCC1              ALOC,SCALE,ALOC2,SCALE2,
CCCCC1              MINMAX,
CCCCC1              ICAPSW,ICAPTY,
CCCCC1              ISUBRO,IBUGA3,IERROR)
C
        IOUNI1=IST1NU
        IFILE1=IST1NA
        ISTAT1=IST1ST
        IFORM1=IST1FO
        IACCE1=IST1AC
        IPROT1=IST1PR
        ICURS1=IST1CS
        ISUBN0='MLGA'
        IERRF1='NO'
C
        IREWI1='ON'
        CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
        IOUNI2=IST2NU
        IFILE2=IST2NA
        ISTAT2=IST2ST
        IFORM2=IST2FO
        IACCE2=IST2AC
        IPROT2=IST2PR
        ICURS2=IST2CS
        ISUBN0='MLWE'
        IERRF2='NO'
C
        IREWI2='ON'
        CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,
     1            ICURS2,
     1            IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
        IF(IERRF2.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        ALPHA=0.05
        IF(IERROR.EQ.'NO')ALPHA=VALUE(ILOCP)
        IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)THEN
          ALPHA=0.05
        ELSEIF(ALPHA.GT.0.50)THEN
          ALPHA=1.0-ALPHA
        ENDIF
C
        IF(NUMV.EQ.1)THEN
          CALL DPMGU1(Y,TEMP4,NS1,
     1                XTEMP1,DTEMP1,MAXNXT,
     1                SCALML,SCA2ML,SCALSE,SCALMO,SCMOSE,
     1                UHATML,UHATSE,UHATMO,UMOMSE,COVSE,
     1                NUMV,ICENTY,TEND,
     1                ICAPSW,ICAPTY,IGUMBC,MINMAX,
     1                QP,XQPHAT,XQPSE,XQPLCL,XQPUCL,NPERC,
     1                XQPHTZ,XQPLCZ,XQPUCZ,
     1                IOUNI1,IOUNI2,ALPHA,
     1                ISUBRO,IBUGA3,IERROR)
        ELSEIF(NUMV.EQ.2)THEN
CCCCC     CALL DPMGU2(Y,TEMP4,N,
CCCCC1                XTEMP1,DTEMP1,MAXNXT,
CCCCC1                SCALML,SCA2ML,SCALSE,SCALMO,UHAT,UHATSE,UHATMO,
CCCCC1                NUMV,ICENTY,TEND,
CCCCC1                ICAPSW,ICAPTY,IGUMBC,MINMAX,
CCCCC1                QP,XQPHAT,XQPLCL,XQPUCL,NPERC,
CCCCC1                XQPHTZ,XQPLCZ,XQPUCZ,
CCCCC1                IOUNI1,IOUNI2,ALPHAP,
CCCCC1                ISUBRO,IBUGA3,IERROR)
        ENDIF
        IF(IERROR.EQ.'YES')GOTO9000
        IENDF1='OFF'
        IREWI1='ON'
        CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
        IENDF2='OFF'
        IREWI2='ON'
        CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,
     1              ICURS2,
     1              IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
        IF(IERRF2.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='SCAL'
        IH2='EML '
        VALUE0=SCALML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='ESE '
        VALUE0=SCALSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='MLBC'
        VALUE0=SCA2ML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EMOM'
        VALUE0=SCALMO
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EMOM'
        VALUE0=SCALMO
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAM'
        IH2='OMSE'
        VALUE0=SCMOSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='COVS'
        IH2='E   '
        VALUE0=COVSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='UHAT'
        IH2='ML  '
        VALUE0=UHATML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='UHAT'
        IH2='SE  '
        VALUE0=UHATSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='UHAT'
        IH2='MOM '
        VALUE0=UHATMO
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='UMOM'
        IH2='SE  '
        VALUE0=UMOMSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='COVS'
        IH2='E   '
        VALUE0=COVSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'LOML')THEN
C
        CALL DPMLLO(Y,NS1,
     1              XTEMP1,MAXNXT,
     1              ALOC,SCALE,
     1              ICAPSW,ICAPTY,DTEMP1,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='LOCM'
        IH2='L   '
        VALUE0=ALOC
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EML '
        VALUE0=SCALE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'CAML')THEN
C
        CALL DPMLCA(Y,NS1,
     1              XTEMP1,TEMP1,MAXNXT,
     1              ALOC,SCALE,ALOCOS,ASCLOS,ALOWOS,SCAWOS,
     1              ICAPSW,ICAPTY,DTEMP1,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='LOCM'
        IH2='L   '
        VALUE0=ALOC
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EML '
        VALUE0=SCALE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='LOCO'
        IH2='S   '
        VALUE0=ALOCOS
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EOS '
        VALUE0=ASCLOS
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='LOCW'
        IH2='OS  '
        VALUE0=ALOWOS
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EWOS'
        VALUE0=SCAWOS
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'BBML' .OR. ICASAN.EQ.'PZML')THEN
C
        IWRITE='OFF'
        CALL MEAN(Y,NS1,IWRITE,XMEAN,IBUGA3,IERROR)
        CALL SD(Y,NS1,IWRITE,XSD,IBUGA3,IERROR)
        CALL MINIM(Y,NS1,IWRITE,XMIN,IBUGA3,IERROR)
        CALL MAXIM(Y,NS1,IWRITE,XMAX,IBUGA3,IERROR)
C
        DO4410J=1,NS1
          ITEMP1(J)=DBLE(Y(J))
          DTEMP1(J)=0.0D0
          DTEMP2(J)=0.0D0
 4410   CONTINUE
C
        IF(NTRIAL.GT.0)THEN
          DO4420J=1,NS1
            ITEMP2(J)=NTRIAL
 4420     CONTINUE
        ENDIF
C
        DO4430I=1,N
          IF(ITEMP1(I).GT.ITEMP2(I))THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            IF(ICASAN.EQ.'BBML')THEN
              WRITE(ICOUT,4421)
 4421         FORMAT(
     1'***** ERROR: FOR BETA-BINOMIAL MAXIMUM LIKEHOOD ESTIMATION,')
            ELSE
              WRITE(ICOUT,4422)
 4422         FORMAT(
     1'***** ERROR: FOR POLYA MAXIMUM LIKEHOOD ESTIMATION,')
            ENDIF
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4423)I,ITEMP1(I)
 4423       FORMAT(
     1'      FOR ROW ',I8,', THE NUMBER OF SUCCESSES (',I8,') IS')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4425)ITEMP2(I)
 4425       FORMAT(
     1'      GREATER THAN THE NUMBER OF TRIALS (',I8,')')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ELSEIF(ITEMP1(I).LT.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            IF(ICASAN.EQ.'BBML')THEN
              WRITE(ICOUT,4431)
 4431         FORMAT(
     1'***** ERROR: FOR BETA-BINOMIAL MAXIMUM LIKEHOOD ESTIMATION,')
            ELSE
              WRITE(ICOUT,4432)
 4432         FORMAT(
     1'***** ERROR: FOR POLYA MAXIMUM LIKEHOOD ESTIMATION,')
            ENDIF
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4433)I,ITEMP1(I)
 4433       FORMAT(
     1'      FOR ROW ',I8,', THE NUMBER OF SUCCESSES IS NEGATIVE.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ITEMP2(I).LE.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            IF(ICASAN.EQ.'BBML')THEN
              WRITE(ICOUT,4436)
 4436         FORMAT(
     1'***** ERROR: FOR BETA-BINOMIAL MAXIMUM LIKEHOOD ESTIMATION,')
            ELSE
              WRITE(ICOUT,4437)
 4437         FORMAT(
     1'***** ERROR: FOR POLYA MAXIMUM LIKEHOOD ESTIMATION,')
            ENDIF
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4438)I,ITEMP1(I)
 4438       FORMAT(
     1'      FOR ROW ',I8,', THE NUMBER OF TRIALS IS NON-POSITIVE.')
            CALL DPWRST('XXX','BUG ')
          ENDIF
 4430   CONTINUE
C
        MRL=MAXOBV
        ITER=1000
        CCRIT=1.0D-4
        DMEW=0.0D0
        DTHETA=0.0D0
        SEM=0.0D0
        SETH=0.0D0
        RNL=0.0D0
        IFAULT=0
C
        CALL BBNML(NS1,ITEMP1,ITEMP2,DTEMP1,DTEMP2,ITEMP3,MRL,
     1            ITER,CCRIT,DMEW,DTHETA,SEM,SETH,RNL,IFAULT)
        IF(ICASAN.EQ.'PZML')THEN
          ALPHA=DMEW/DTHETA
          BETA=(1.0D0 - DMEW)/DTHETA
        ELSE
          BETA=DMEW/DTHETA
          ALPHA=(1.0D0 - DMEW)/DTHETA
        ENDIF
C
        IF(IFAULT.EQ.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IF(ICASAN.EQ.'BBML')THEN
            WRITE(ICOUT,1111)
 1111       FORMAT(
     1'***** ERROR: BETA-BINOMIAL MAXIMUM LIKEHOOD ESTIMATION--')
          ELSE
            WRITE(ICOUT,1112)
 1112       FORMAT(
     1'***** ERROR: POLYA MAXIMUM LIKEHOOD ESTIMATION--')
          ENDIF
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1113)
 1113     FORMAT(
     1'      THE NUMBER OF OBSERVATIONS IS <= 1.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IFAULT.EQ.2)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1111)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1123)
 1123     FORMAT(
     1'      THE NUMBER OF SUCCESSES IS ZERO FOR ALL OBSERVATIONS.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IFAULT.EQ.3)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1111)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1133)
 1133     FORMAT(
     1'      THE NUMBER OF SUCCESSES IS EQUAL TO THE NUMBER OF ')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1135)
 1135     FORMAT(
     1'      TRIALS FOR ALL OBSERVATIONS.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IFAULT.EQ.4)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1111)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1143)MAXOBV
 1143     FORMAT(
     1'      THE NUMBER OF SUCCESSES IS GREATER THAN ',I8)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IFAULT.EQ.5)THEN
          IERROR='YES'
          GOTO9000
        ELSEIF(IFAULT.EQ.6)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1111)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1163)MAXOBV
 1163     FORMAT(
     1'      NUMERICAL DIFFICULTIES ENCOUNTERED.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IFAULT.EQ.7)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1111)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1173)ITER
 1173     FORMAT(
     1'      MAXIMUM NUMBER OF ITERATIONS, ',I8,', EXCEEDED.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IFAULT.EQ.8)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1111)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1183)
 1183     FORMAT(
     1'      NUMERICAL DIFFICULTIES ENCOUTERED.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
C
        IF(IPRINT.EQ.'ON')THEN
        IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5601     FORMAT('</PRE>')
 5611     FORMAT('<UL>')
 5613     FORMAT('<TABLE NOBORDER>')
 5615     FORMAT('   <CAPTION ALIGN=CENTER>')
 5617     FORMAT('      <B>Beta-Binomial Maximum Likelihood ',
     1           'Estimation</B>')
 5618     FORMAT('      <B>Polya Maximum Likelihood ',
     1           'Estimation</B>')
 5619     FORMAT('   </CAPTION>')
          WRITE(ICOUT,5601)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          WRITE(ICOUT,5611)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5613)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5615)
          CALL DPWRST('XXX','WRIT')
          IF(ICASAN.EQ.'BBML')THEN
            WRITE(ICOUT,5617)
          ELSE
            WRITE(ICOUT,5618)
          ENDIF
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5619)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5641     FORMAT('   <TR>')
 5643     FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=250>')
 5647     FORMAT('      </TD>')
 5649     FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5651     FORMAT('         ',G15.7)
 5653     FORMAT('         ',I8)
 5655     FORMAT('         &nbsp;')
 5659     FORMAT('   </TR>')
 5660     FORMAT('         Summary Statistics:')
 5661     FORMAT('         Number of Observations:')
 5662     FORMAT('         Sample Mean:')
 5663     FORMAT('         Sample Standard Deviation:')
 5668     FORMAT('         Sample Minimum:')
 5669     FORMAT('         Sample Maximum:')
 5670     FORMAT('         Maximum Likelihood Estimates:')
 5664     FORMAT('         Estimate of MU:')
 5665     FORMAT('         Estimate of THETA:')
 5666     FORMAT('         Estimate of ALPHA:')
 5667     FORMAT('         Estimate of BETA:')
C
          WRITE(ICOUT,5641)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5643)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5660)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5649)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5655)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5659)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5641)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5643)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5661)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5649)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5653)N
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5659)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5641)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5643)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5662)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5649)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5651)XMEAN
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5659)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5641)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5643)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5663)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5649)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5651)XSD
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5659)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5641)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5643)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5668)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5649)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5651)XMIN
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5659)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5641)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5643)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5669)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5649)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5651)XMAX
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5659)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5641)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5643)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5655)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5649)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5655)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5659)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5641)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5643)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5670)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5649)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5655)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5659)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5641)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5643)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5664)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5649)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5651)REAL(DMEW)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5659)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5641)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5643)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5665)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5649)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5651)REAL(DTHETA)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5659)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5641)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5643)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5666)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5649)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5651)ALPHA
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5659)
          CALL DPWRST('XXX','WRIT')
C  
          WRITE(ICOUT,5641)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5643)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5667)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5649)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5651)BETA
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5659)
          CALL DPWRST('XXX','WRIT')
C  
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5691     FORMAT('</TABLE>')
 5693     FORMAT('</UL>')
 5699     FORMAT('<PRE>')
          WRITE(ICOUT,5691)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5693)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5699)
          CALL DPWRST('XXX','WRIT')
C
        ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8601     FORMAT(A1,'end{verbatim}')
 8603     FORMAT(A1,'begin{table}')
 8607     FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8609     FORMAT(A1,'begin{center}')
 8611     FORMAT(5X,'{',A1,'bf Beta-Binomail Maximum Likelihood ',
     1          'Estimate}')
 8612     FORMAT(5X,'{',A1,'bf Polya Maximum Likelihood ',
     1          'Estimate}')
 8613     FORMAT(A1,'end{center}')
 8615     FORMAT(5X,'} ',A1,A1)
C
          CALL DPCONA(92,IBASLC)
C
          WRITE(ICOUT,8601)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8603)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8609)IBASLC
          CALL DPWRST('XXX','WRIT')
          IF(ICASAN.EQ.'BBML')THEN
            WRITE(ICOUT,8611)IBASLC
          ELSE
            WRITE(ICOUT,8612)IBASLC
          ENDIF
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8607)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8607)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8613)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8620     FORMAT(5X,A1,'begin{tabular} {lr}')
 8636     FORMAT(5X,'Summary Statistics: & ',2X,A1,A1)
 8621     FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8622     FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8623     FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8631     FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8632     FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8633     FORMAT(5X,' & ',2X,A1,A1)
 8634     FORMAT(5X,'Maximum Likelihood Estimates: & ',2X,A1,A1)
 8624     FORMAT(5X,'Estimate of $',A1,'mu$: & ',
     1           G15.7,2X,A1,A1)
 8625     FORMAT(5X,'Estimate of $',A1,'theta$: & ',
     1           G15.7,2X,A1,A1)
 8626     FORMAT(5X,'Estimate of $',A1,'alpha$: & ',
     1           G15.7,2X,A1,A1)
 8627     FORMAT(5X,'Estimate of $',A1,'beta$: & ',
     1           G15.7,2X,A1,A1)
 8640     FORMAT(5X,A1,'hline')
 8649     FORMAT(A1,'end{tabular}')
          WRITE(ICOUT,8609)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8620)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8636)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8621)N,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8622)XMEAN,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8623)XSD,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8631)XMIN,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8632)XMAX,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8633)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8634)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8624)IBASLC,REAL(DMEW),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8625)IBASLC,REAL(DTHETA),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8626)IBASLC,ALPHA,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8627)IBASLC,BETA,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8649)IBASLC
          CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8691     FORMAT(A1,'end{center}')
 8693     FORMAT(A1,'end{table}')
 8699     FORMAT(A1,'begin{verbatim}')
          WRITE(ICOUT,8691)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8693)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8699)IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
        ELSE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4711)
 4711     FORMAT(12X,'BETA-BINOMIAL PARAMETER ESTIMATION:')
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4721)
 4721     FORMAT('SUMMARY STATISTICS:')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4722)NS1
 4722     FORMAT('NUMBER OF OBSERVATIONS               = ',I8)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4723)XMEAN
 4723     FORMAT('SAMPLE MEAN                          = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4724)XSD   
 4724     FORMAT('SAMPLE STANDARD DEVIATION            = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4725)XMIN
 4725     FORMAT('SAMPLE MINIMUM                       = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4726)XMAX
 4726     FORMAT('SAMPLE MAXIMUM                       = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,4730)
 4730     FORMAT('MAXIMUM LIKELIHOOD ESTIMATES:')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4731)REAL(DMEW)
 4731     FORMAT('ESTIMATE OF MU                       = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4733)REAL(DTHETA)
 4733     FORMAT('ESTIMATE OF THETA                    = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4737)ALPHA
 4737     FORMAT('ESTIMATE OF ALPHA                    = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4739)BETA
 4739     FORMAT('ESTIMATE OF BETA                     = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,4749)
 4749     FORMAT('ALPHAML, BETAML, MUML, AND THETAML WILL BE SAVED ',
     1           'AS INTERNAL PARAMETERS.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
C
        ENDIF
        ENDIF
C
        ISUBN0='DPML'
C
        IH='ALPH'
        IH2='AML '
        VALUE0=ALPHA
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='BETA'
        IH2='ML  '
        VALUE0=BETA
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='MUML'
        IH2='    '
        VALUE0=REAL(DMEW)
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='THET'
        IH2='AML '
        VALUE0=REAL(THETA)
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'PAML')THEN
C
        IHP='ALPH'
        IHP2='A   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        ALPHA=0.05
        IF(IERROR.EQ.'NO')ALPHA=VALUE(ILOCP)
        IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)THEN
          ALPHA=0.05
        ELSEIF(ALPHA.GT.0.50)THEN
          ALPHA=1.0-ALPHA
        ENDIF
C
        CALL DPMLPA(Y,NS1,
     1              XTEMP1,MAXNXT,
     1              GAMMML,AML,GAMMSE,AMLSE,
     1              QP,XQPHAT,XQPLCL,XQPUCL,NPERC,ALPHA,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='GAMM'
        IH2='AML '
        VALUE0=GAMMML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='GAMM'
        IH2='ASE '
        VALUE0=GAMMSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='AML '
        IH2='    '
        VALUE0=AML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='AMLS'
        IH2='E   '
        VALUE0=AMLSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'UNIF')THEN
        CALL DPMLUN(Y,NS1,
     1              XTEMP1,MAXNXT,
     1              ALOWLI,AUPPLI,ALOCML,ASCAML,AHAT,HHAT,
     1              ALOWL2,AUPPL2,ALOCMO,ASCAMO,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='LOWL'
        IH2='IMIT'
        VALUE0=ALOWLI
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='UPPL'
        IH2='IMIT'
        VALUE0=AUPPLI
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='LOWL'
        IH2='IMI2'
        VALUE0=ALOWL2
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='UPPL'
        IH2='IMI2'
        VALUE0=AUPPL2
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='AHAT'
        IH2='    '
        VALUE0=AHAT
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='HHAT'
        IH2='    '
        VALUE0=HHAT
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='LOCM'
        IH2='L   '
        VALUE0=ALOCML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EML '
        VALUE0=ASCAML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='LOCM'
        IH2='OM  '
        VALUE0=ALOCMO
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EMOM'
        VALUE0=ASCAMO
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'BEML')THEN
C
        IHP='BETA'
        IHP2='LL  '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        AUSER=CPUMIN
        IF(IERROR.EQ.'NO')AUSER=VALUE(ILOCP)
C
        IHP='BETA'
        IHP2='UL  '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        BUSER=CPUMIN
        IF(IERROR.EQ.'NO')BUSER=VALUE(ILOCP)
C
        IOUNI1=IST1NU
        IFILE1=IST1NA
        ISTAT1=IST1ST
        IFORM1=IST1FO
        IACCE1=IST1AC
        IPROT1=IST1PR
        ICURS1=IST1CS
        ISUBN0='MLBE'
        IERRF1='NO'
C
        IREWI1='ON'
        CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
        IOUNI2=IST2NU
        IFILE2=IST2NA
        ISTAT2=IST2ST
        IFORM2=IST2FO
        IACCE2=IST2AC
        IPROT2=IST2PR
        ICURS2=IST2CS
        ISUBN0='MLWE'
        IERRF2='NO'
C
        IREWI2='ON'
        CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,
     1            ICURS2,
     1            IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
        IF(IERRF2.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        ALPHAP=0.05
        IF(IERROR.EQ.'NO')ALPHAP=VALUE(ILOCP)
        IF(ALPHAP.LE.0.0 .OR. ALPHAP.GE.1.0)THEN
          ALPHAP=0.05
        ELSEIF(ALPHAP.GT.0.50)THEN
          ALPHAP=1.0-ALPHAP
        ENDIF
C
        CALL DPMLBE(Y,NS1,
     1              XTEMP1,MAXNXT,AUSER,BUSER,
     1              A,B,ALPHA,BETA,ALPHAM,BETAM,
     1              ALPHSE,BETASE,COVSE,
     1              QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
     1              IOUNI1,IOUNI2,ALPHAP,
     1              ICAPSW,ICAPTY,DTEMP1,
     1              ISUBRO,IBUGA3,IERROR)
        IENDF1='OFF'
        IREWI1='ON'
        CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
        IENDF2='OFF'
        IREWI2='ON'
        CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,
     1              ICURS2,
     1              IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
        IF(IERRF2.EQ.'YES')GOTO9000
C
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='LOWL'
        IH2='IMIT'
        VALUE0=A
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='UPPL'
        IH2='IMIT'
        VALUE0=B
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='ALPH'
        IH2='AML '
        VALUE0=ALPHA
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='ALPH'
        IH2='ASE '
        VALUE0=ALPHSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='BETA'
        IH2='ML  '
        VALUE0=BETA
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='BETA'
        IH2='SE  '
        VALUE0=BETASE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='COVS'
        IH2='E   '
        VALUE0=COVSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='ALPH'
        IH2='AMOM'
        VALUE0=ALPHAM
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='BETA'
        IH2='MOM '
        VALUE0=BETAM
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'PWML')THEN
C
        CALL DPMLPW(Y,NS1,
     1              XTEMP1,MAXNXT,
     1              C,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='CML '
        IH2='    '
        VALUE0=C
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'GAML')THEN
C
CCCCC   CALL DPMLGA(Y,NS1,
CCCCC1              XTEMP1,MAXNXT,
CCCCC1              GAMMA,ALPHA,GAMMA2,ALPHA2,
CCCCC1              ICAPSW,ICAPTY,
CCCCC1              ISUBRO,IBUGA3,IERROR)
        IOUNI1=IST1NU
        IFILE1=IST1NA
        ISTAT1=IST1ST
        IFORM1=IST1FO
        IACCE1=IST1AC
        IPROT1=IST1PR
        ICURS1=IST1CS
        ISUBN0='MLGA'
        IERRF1='NO'
C
        IREWI1='ON'
        CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
        IOUNI2=IST2NU
        IFILE2=IST2NA
        ISTAT2=IST2ST
        IFORM2=IST2FO
        IACCE2=IST2AC
        IPROT2=IST2PR
        ICURS2=IST2CS
        ISUBN0='MLWE'
        IERRF2='NO'
C
        IREWI2='ON'
        CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,
     1            ICURS2,
     1            IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
        IF(IERRF2.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        ALPHA=0.05
        IF(IERROR.EQ.'NO')ALPHA=VALUE(ILOCP)
        IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)THEN
          ALPHA=0.05
        ELSEIF(ALPHA.GT.0.50)THEN
          ALPHA=1.0-ALPHA
        ENDIF
C
        IF(NUMV.EQ.1)THEN
          CALL DPMLG1(Y,TEMP4,NS1,
     1                XTEMP1,DTEMP1,MAXNXT,
     1                SCALMO,GAMMMO,SCALML,SCALSE,GAMMML,GAMMSE,COVSE,
     1                NUMV,ICENTY,TEND,
     1                ICAPSW,ICAPTY,
     1                QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
     1                IOUNI1,IOUNI2,ALPHA,
     1                ISUBRO,IBUGA3,IERROR)
        ELSEIF(NUMV.EQ.2)THEN
          CALL DPMLG2(Y,TEMP4,NS1,
     1                XTEMP1,DTEMP1,MAXNXT,
     1                SCALMO,GAMMMO,SCALML,SCALSE,GAMMML,GAMMSE,COVSE,
     1                NUMV,ICENTY,TEND,
     1                ICAPSW,ICAPTY,
     1                QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
     1                IOUNI1,IOUNI2,ALPHA,
     1                ISUBRO,IBUGA3,IERROR)
        ENDIF
        IF(IERROR.EQ.'YES')GOTO9000
        IENDF1='OFF'
        IREWI1='ON'
        CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
        IENDF2='OFF'
        IREWI2='ON'
        CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,
     1              ICURS2,
     1              IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
        IF(IERRF2.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='GAMM'
        IH2='AML '
        VALUE0=GAMMML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='GAMM'
        IH2='ASE '
        VALUE0=GAMMSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EML '
        VALUE0=SCALML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='ESE '
        VALUE0=SCALSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='COVS'
        IH2='E   '
        VALUE0=COVSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IF(NUMV.EQ.1)THEN
          IH='GAMM'
          IH2='AMOM'
          VALUE0=GAMMMO
          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1                IANS,IWIDTH,IBUGA3,IERROR)
C
          IH='SCAL'
          IH2='EMOM'
          VALUE0=SCALMO
          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1                IANS,IWIDTH,IBUGA3,IERROR)
        ENDIF
C
      ELSEIF(ICASAN.EQ.'TSML')THEN
C
        IHP='A   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        A=0.0
        IF(IERROR.EQ.'NO')A=VALUE(ILOCP)
C
        IHP='B   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        B=1.0
        IF(IERROR.EQ.'NO')B=VALUE(ILOCP)
C
        IF(B.LT.A)THEN
          ATEMP=B
          B=A
          A=ATEMP
        ENDIF
C
        CALL DPMLTS(Y,NS1,A,B,
     1              XTEMP1,TEMP1,TEMP2,TEMP3,MAXNXT,
     1              THETA,AN,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='THET'
        IH2='AML '
        VALUE0=THETA
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='NML '
        IH2='    '
        VALUE0=AN
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'BIML')THEN
C
        IH='N   '
        IH2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IH,IH2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          NTRIAL=1
        ELSE
          NTRIAL=VALUE(ILOCP)+0.5
          IF(NTRIAL.LT.0)NTRIAL=1
        ENDIF
C
        CALL DPMLBI(Y,NS1,NTRIAL,
     1              XTEMP1,MAXNXT,
     1              TEMP1,P,PLCL,PUCL,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='PML '
        IH2='    '
        VALUE0=P
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='PLCL'
        IH2='    '
        VALUE0=PLCL
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='PUCL'
        IH2='    '
        VALUE0=PUCL
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'GPML')THEN
C
        IOUNI1=IST1NU
        IFILE1=IST1NA
        ISTAT1=IST1ST
        IFORM1=IST1FO
        IACCE1=IST1AC
        IPROT1=IST1PR
        ICURS1=IST1CS
        ISUBN0='FIT3'
        IERRF1='NO'
C
        IREWI1='ON'
        CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
        IOUNI2=IST2NU
        IFILE2=IST2NA
        ISTAT2=IST2ST
        IFORM2=IST2FO
        IACCE2=IST2AC
        IPROT2=IST2PR
        ICURS2=IST2CS
        ISUBN0='MLWE'
        IERRF2='NO'
C
        IREWI2='ON'
        CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1              IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
        IF(IERRF2.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        ALPHA=0.05
        IF(IERROR.EQ.'NO')ALPHA=VALUE(ILOCP)
        IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)THEN
          ALPHA=0.05
        ELSEIF(ALPHA.GT.0.50)THEN
          ALPHA=1.0-ALPHA
        ENDIF
C
        IHP='THRE'
        IHP2='SHOL'
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          THRESH=0.0
        ELSE
          THRESH=VALUE(ILOCP)
        ENDIF
C
        IF(IGEPSV.EQ.'USER')THEN
          IHP='GAMM'
          IHP2='ASV '
          IHWUSE='P'
          MESSAG='NO'
          CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
          IF(IERROR.EQ.'YES')THEN
            GAMMSV=0.0
          ELSE
            GAMMSV=VALUE(ILOCP)
          ENDIF
C
          IHP='SCAL'
          IHP2='ESV '
          IHWUSE='P'
          MESSAG='NO'
          CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
          IF(IERROR.EQ.'YES')THEN
            SCALSV=1.0
          ELSE
            SCALSV=VALUE(ILOCP)
          ENDIF
          IF(SCALSV.LE.0.0)SCALSV=1.0
        ELSE
          GAMMSV=0.0
          SCALSV=1.0
        ENDIF
C
        CALL DPMLGP(Y,NS1,
     1              XTEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,
     1              MAXNXT,THRESH,
     1              QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
     1              GAMMA1,SCALE1,ALOC1,GAMMA2,SCALE2,ALOC2,
     1              ASHALM,ASCALM,ALOCLM,
     1              GAMMA3,SCALE3,ALOC3,
     1              ICAPSW,ICAPTY,DTEMP1,DTEMP2,
     1              IGEPDF,IOUNI1,IOUNI2,ISEED,ALPHA,
     1              IGEPSV,GAMMSV,SCALSV,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='GAMM'
        IH2='AML '
        VALUE0=GAMMA2
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EML '
        VALUE0=SCALE2
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='LOCM'
        IH2='L   '
        VALUE0=ALOC2
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='GAMM'
        IH2='AMOM'
        VALUE0=GAMMA1
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EMOM'
        VALUE0=SCALE1
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='LOCM'
        IH2='OM  '
        VALUE0=ALOC1
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='GAMM'
        IH2='ALMO'
        VALUE0=ASHALM
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='ELMO'
        VALUE0=ASCALM
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='LOCL'
        IH2='MOM '
        VALUE0=ALOCLM
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='GAMM'
        IH2='AEPM'
        VALUE0=GAMMA3
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EEPM'
        VALUE0=SCALE3
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='LOCE'
        IH2='PM  '
        VALUE0=ALOC3
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IENDF1='OFF'
        IREWI1='ON'
        CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
        IENDF2='OFF'
        IREWI2='ON'
        CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1              IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
        IF(IERRF2.EQ.'YES')GOTO9000
C
      ELSEIF(ICASAN.EQ.'GEML')THEN
C
        IOUNI1=IST1NU
        IFILE1=IST1NA
        ISTAT1=IST1ST
        IFORM1=IST1FO
        IACCE1=IST1AC
        IPROT1=IST1PR
        ICURS1=IST1CS
        ISUBN0='FIT3'
        IERRF1='NO'
C
        IREWI1='ON'
        CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
        IOUNI2=IST2NU
        IFILE2=IST2NA
        ISTAT2=IST2ST
        IFORM2=IST2FO
        IACCE2=IST2AC
        IPROT2=IST2PR
        ICURS2=IST2CS
        ISUBN0='MLWE'
        IERRF2='NO'
C
        IREWI2='ON'
        CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1              IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
        IF(IERRF2.EQ.'YES')GOTO9000
C
        IHP='ALPH'
        IHP2='A   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        ALPHA=0.05
        IF(IERROR.EQ.'NO')ALPHA=VALUE(ILOCP)
        IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)THEN
          ALPHA=0.05
        ELSEIF(ALPHA.GT.0.50)THEN
          ALPHA=1.0-ALPHA
        ENDIF
C
CCCCC GEV MAXIMUM LIKELIHOOD NOT WORKING AS EXPECTED.  SET
CCCCC MLGEV TO FALSE TO SUPPRESS ML ESTIMATION.
C
        MLGEV=.FALSE.
        CALL DPMLGV(Y,NS1,
     1              XTEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,MAXNXT,
     1              QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
     1              GAMMA1,SCALE1,ALOC1,GAMMA2,SCALE2,ALOC2,
     1              ASHALM,ASCALM,ALOCLM,
     1              ICAPSW,ICAPTY,DTEMP1,DTEMP2,
     1              IMINMAX,IOUNI1,IOUNI2,ISEED,ALPHA,
     1              MLGEV,ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IF(MLGEV)THEN
          IH='GAMM'
          IH2='AML '
          VALUE0=GAMMA1
          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1                IANS,IWIDTH,IBUGA3,IERROR)
C
          IH='SCAL'
          IH2='EML '
          VALUE0=SCALE1
          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1                IANS,IWIDTH,IBUGA3,IERROR)
C
          IH='LOCM'
          IH2='L   '
          VALUE0=ALOC1
          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1                IANS,IWIDTH,IBUGA3,IERROR)
        ENDIF
C
        IH='GAMM'
        IH2='ALMO'
        VALUE0=ASHALM
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='ELMO'
        VALUE0=ASCALM
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='LOCL'
        IH2='MOM '
        VALUE0=ALOCLM
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='GAMM'
        IH2='AEPM'
        VALUE0=GAMMA2
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EEPM'
        VALUE0=SCALE2
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='LOCE'
        IH2='PM  '
        VALUE0=ALOC2
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IENDF1='OFF'
        IREWI1='ON'
        CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
        IENDF2='OFF'
        IREWI2='ON'
        CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1              IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
        IF(IERRF2.EQ.'YES')GOTO9000
C
      ELSEIF(ICASAN.EQ.'FLML')THEN
C
        CALL DPMLFL(Y,NS1,
     1              XTEMP1,MAXNXT,
     1              GAMMA1,SCALE1,GAMMA2,SCALE2,
     1              ICAPSW,ICAPTY,DTEMP1,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='GAMM'
        IH2='AML '
        VALUE0=GAMMA2
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EML '
        VALUE0=SCALE2
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='GAMM'
        IH2='AMOM'
        VALUE0=GAMMA1
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EMOM'
        VALUE0=SCALE1
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'GXML')THEN
C
        CALL DPMLGX(Y,NS1,
     1              XTEMP1,MAXNXT,
     1              GAMMA1,SCALE1,
     1              ICAPSW,ICAPTY,DTEMP1,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='GAMM'
        IH2='AML '
        VALUE0=GAMMA1
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EML '
        VALUE0=SCALE1
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'FNML')THEN
C
        CALL DPMLFN(Y,NS1,
     1              XTEMP1,MAXNXT,
     1              ALOC,SCALE,
     1              ICAPSW,ICAPTY,DTEMP1,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='MUML'
        IH2='    '
        VALUE0=ALOC
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SIGM'
        IH2='AML '
        VALUE0=SCALE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
      ELSEIF(ICASAN.EQ.'POML')THEN
C
        CALL DPMLPO(Y,NS1,
     1              XTEMP1,MAXNXT,
     1              ALAMB,ALMBSE,XMIN,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='LAMB'
        IH2='DAML'
        VALUE0=ALAMB
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='LAMB'
        IH2='DASE'
        VALUE0=ALMBSE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'RAYL')THEN
C
        IHP='RAYL'
        IHP2='OC  '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        RAYMIN=CPUMIN
        IF(IERROR.EQ.'NO')RAYMIN=VALUE(ILOCP)
C
        CALL DPMLRA(Y,NS1,RAYMIN,
     1              XTEMP1,MAXNXT,
     1              ALOCML,SCALML,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='LOCM'
        IH2='L   '
        VALUE0=ALOCML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EML '
        VALUE0=SCALML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'MAXW')THEN
C
        IHP='MAXW'
        IHP2='LOC '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        AMXMIN=CPUMIN
        IF(IERROR.EQ.'NO')AMXMIN=VALUE(ILOCP)
C
        CALL DPMLMX(Y,NS1,AMXMIN,
     1              XTEMP1,MAXNXT,
     1              ALOCML,SCALEML,ALOCM2,SCALEM2,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='LOCM'
        IH2='L   '
        VALUE0=ALOCML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EML '
        VALUE0=SCALEML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='LOCM'
        IH2='2   '
        VALUE0=ALOCM2
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EM2 '
        VALUE0=SCALEM2
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'GPDE')THEN
C
        IHP='THRE'
        IHP2='SHOL'
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          THRESH=0.0
        ELSE
          THRESH=VALUE(ILOCP)
        ENDIF
        CALL DPDEGP(Y,NS1,
     1              XTEMP1,MAXNXT,
     1              GAMMA,A,ASD,THRESH,
     1              GAMMA2,ALOC,SCALE,
     1              IGEPDF,ICAPSW,ICAPTY,
     1              PPOTTO,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='GAMM'
        IH2='A   '
        VALUE0=GAMMA
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SDGA'
        IH2='MMA '
        VALUE0=ASD
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='A   '
        IH2='    '
        VALUE0=A
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
      IF(GAMMA.LE.0.0)THEN
C
        IH='LOC '
        IH2='    '
        VALUE0=ALOC
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='E   '
        VALUE0=SCALE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ENDIF
      IF(GAMMA.LT.0.0)THEN
C
        IH='GAMM'
        IH2='A2  '
        VALUE0=GAMMA2
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ENDIF
C
      ELSEIF(ICASAN.EQ.'GPCM')THEN
C
        IHP='THRE'
        IHP2='SHOL'
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          THRESH=0.0
        ELSE
          THRESH=VALUE(ILOCP)
        ENDIF
        CALL DPCMGP(Y,NS1,
     1              XTEMP1,MAXNXT,
     1              GAMMA,A,ASD,THRESH,
     1              TEMP1,TEMP2,TEMP3,ITEMP1,
     1              IGEPDF,ICAPSW,ICAPTY,
     1              PPOTTO,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='GAMM'
        IH2='A   '
        VALUE0=GAMMA
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='A   '
        IH2='    '
        VALUE0=A
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'DLML')THEN
C
        CALL DPMLDL(Y,NS1,
     1              XTEMP1,MAXNXT,
     1              THETA,ASYMVA,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='THET'
        IH2='AML '
        VALUE0=THETA
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='THET'
        IH2='AVA '
        VALUE0=ASYMVA
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'GMML')THEN
C
        CALL DPMLGM(Y,NS1,
     1              XTEMP1,MAXNXT,
     1              PML,PMLVAR,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='PML '
        IH2='    '
        VALUE0=PML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='PMLV'
        IH2='AR  '
        VALUE0=PMLVAR
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'NBML')THEN
C
        IDIST='NEGATIVE BINOMIAL'
        IH='K   '
        IH2='    '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IH,IH2,IDIST,AK,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')THEN
          AK=-1.0
        ENDIF
C
        CALL DPMLNB(Y,NS1,AK,
     1              XTEMP1,MAXNXT,
     1              PMOM,AKMOM,PML,PMLBC,PMLBCV,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='PMOM'
        IH2='    '
        VALUE0=PMOM
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='PML '
        IH2='    '
        VALUE0=PML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='KMOM'
        IH2='    '
        VALUE0=AKMOM
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='PMLB'
        IH2='C   '
        VALUE0=PMLBC
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='PMLV'
        IH2='AR  '
        VALUE0=PMLBCV
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
CCCCC   IH='KML '
CCCCC   IH2='    '
CCCCC   VALUE0=AKML
CCCCC   CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
CCCCC1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
CCCCC1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'HYML')THEN
C
        IOUNI1=IST1NU
        IFILE1=IST1NA
        ISTAT1=IST1ST
        IFORM1=IST1FO
        IACCE1=IST1AC
        IPROT1=IST1PR
        ICURS1=IST1CS
        ISUBN0='FIT3'
        IERRF1='NO'
C
        IREWI1='ON'
        CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
        IDIST='HYPERGEOMETRIC'
        CALL DPMLHY(Y,NS1,ITEMP2,ITEMP1,
     1              XTEMP1,MAXNXT,
     1              ICAPSW,ICAPTY,IHYPTY,IOUNI1,
     1              ISUBRO,IBUGA3,IERROR)
C
        IENDF1='OFF'
        IREWI1='ON'
        CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1              IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ELSEIF(ICASAN.EQ.'JOHN')THEN
C
        IDIST='JOHNSON'
        ALPHA1=0.0
        ALPHA2=0.0
        ALOC=0.0
        SCALE=0.0
C
        IHP='Z   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        Z=0.524
        IF(IERROR.EQ.'NO')Z=VALUE(ILOCP)
C
        IF(Z.LT.0.1)Z=0.1
        IF(Z.GT.1.0)Z=1.0
C
        CALL DPMLJO(Y,NS1,
     1              XTEMP1,MAXNXT,
     1              ALPHA1,ALPHA2,ALOC,SCALE,
     1              Z,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        IH='ALPH'
        IH2='A1PE'
        VALUE0=ALPHA1
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='ALPH'
        IH2='A2PE'
        VALUE0=ALPHA2
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='LOCP'
        IH2='ERC '
        VALUE0=ALOC
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='EPER'
        VALUE0=SCALE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'HEML')THEN
C
        IDIST='HERMITE'
        ALPHAM=0.0
        BETAMO=0.0
        ALPHML=0.0
        BETAML=0.0
        CALL DPMLHE(Y,NS1,
     1              TEMP1,TEMP2,TEMP3,TEMP4,ITEMP1,MAXNXT,
     1              ALPHAM,BETAMO,ALPHML,BETAML,
     1              ALPHEP,BETAEP,ALPHZF,BETAZF,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        IH='ALPH'
        IH2='AMOM'
        VALUE0=ALPHAM
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='BETA'
        IH2='MOM '
        VALUE0=BETAMO
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='ALPH'
        IH2='AML '
        VALUE0=ALPHML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='BETA'
        IH2='ML  '
        VALUE0=BETAML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='ALPH'
        IH2='AEP '
        VALUE0=ALPHEP
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='BETA'
        IH2='EP  '
        VALUE0=BETAEP
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='ALPH'
        IH2='AZF '
        VALUE0=ALPHZF
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='BETA'
        IH2='ZF  '
        VALUE0=BETAZF
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'YUML')THEN
C
        IDIST='YULE'
        PMOM=0.0
        PML=0.0
        CALL DPMLYU(Y,NS1,
     1              TEMP1,TEMP2,TEMP3,MAXNXT,
     1              PMOM,PFREQ,PML,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        IH='PMOM'
        IH2='    '
        VALUE0=PMOM
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='PFRE'
        IH2='Q   '
        VALUE0=PFREQ
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='PML '
        IH2='    '
        VALUE0=PML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'WAML')THEN
C
        IDIST='WARING'
        AMOM=0.0
        AML=0.0
        CMOM=0.0
        CML=0.0
        CALL DPMLWA(Y,NS1,
     1              DTEMP1,TEMP1,TEMP2,TEMP3,MAXNXT,
     1              AMOM,AFREQ,AML,CMOM,CFREQ,CML,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        IH='AMOM'
        IH2='    '
        VALUE0=AMOM
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='AFRE'
        IH2='Q   '
        VALUE0=AFREQ
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='AML '
        IH2='    '
        VALUE0=AML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='CMOM'
        IH2='    '
        VALUE0=CMOM
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='CFRE'
        IH2='Q   '
        VALUE0=CFREQ
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='CML '
        IH2='    '
        VALUE0=CML
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'JOSB')THEN
C
C  JULY 2003: JOHNSON SU/SB MOMENT ESTIMATES
        IWRITE='OFF'
        CALL MEAN(Y,NS1,IWRITE,YMEAN,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        CALL SD(Y,NS1,IWRITE,YSD,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        CALL STMOM3(Y,NS1,IWRITE,YSKEW,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        CALL STMOM4(Y,NS1,IWRITE,YKURT,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ITYPE=3
        CALL JNSN(YMEAN,YSD,YSKEW,YKURT,ITYPE,ALPHA1,ALPHA2,
     1            SCALE,ALOC,IFAULT)
        IF(IFAULT.EQ.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4201)
 4201     FORMAT('***** FATAL ERROR FOR JOHNSON SB METHOD OF ',
     1           'MOMENTS.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4203)
 4203     FORMAT('      COMPUTED STANDARD DEVIATION LESS THAN ZERO.')
          CALL DPWRST('XXX','WRIT')
          GOTO9000
        ELSEIF(IFAULT.EQ.2)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4205)
 4205     FORMAT('***** FATAL ERROR FOR JOHNSON SB METHOD OF ',
     1           'MOMENTS.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4206)
 4206     FORMAT('      KURTOSIS < SKEWNESS**2 + 1')
          CALL DPWRST('XXX','WRIT')
          GOTO9000
        ELSEIF(IFAULT.EQ.3)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4207)
 4207     FORMAT('***** FATAL ERROR FOR JOHNSON SB METHOD OF ',
     1           'MOMENTS.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4208)
 4208     FORMAT('      SB FITTING FAILED TO CONVERGE.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4209)
 4209     FORMAT('      AN SL OR ST FIT MADE INSTEAD.')
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IPRINT.EQ.'ON')THEN
        IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5101     FORMAT('</PRE>')
 5111     FORMAT('<UL>')
 5113     FORMAT('<TABLE NOBORDER>')
 5115     FORMAT('   <CAPTION ALIGN=CENTER>')
 5117     FORMAT('      <B>Johnson SB Method of Moments ',
     1           'Estimation</B>')
 5119     FORMAT('   </CAPTION>')
          WRITE(ICOUT,5101)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          WRITE(ICOUT,5111)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5113)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5115)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5117)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5119)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141     FORMAT('   <TR>')
 5143     FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=250>')
 5147     FORMAT('      </TD>')
 5149     FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5151     FORMAT('         ',G15.7)
 5153     FORMAT('         ',I8)
 5155     FORMAT('         &nbsp;')
 5159     FORMAT('   </TR>')
 5161     FORMAT('         Number of Observations:')
 5162     FORMAT('         Sample Mean:')
 5163     FORMAT('         Sample Standard Deviation:')
 5164     FORMAT('         Sample Skewness:')
 5165     FORMAT('         Sample Kurtosis:')
 5166     FORMAT('         <B>Method of Moments Estimates:</B>')
 5167     FORMAT('         Shape Parameter ALPHA1:')
 5168     FORMAT('         Shape Parameter ALPHA2:')
 5169     FORMAT('         Location Parameter:')
 5170     FORMAT('         Scale Parameter:')
C
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5161)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5153)N
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5162)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)YMEAN
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5163)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)YSD
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5164)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)YSKEW
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5165)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)YKURT
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5166)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5155)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5167)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALPHA1
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
C  
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5168)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALPHA2
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
C  
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5169)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
C  
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5170)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)SCALE
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
C  
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191     FORMAT('</TABLE>')
 5193     FORMAT('</UL>')
 5199     FORMAT('<PRE>')
          WRITE(ICOUT,5191)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5193)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5199)
          CALL DPWRST('XXX','WRIT')
C
        ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8101     FORMAT(A1,'end{verbatim}')
 8103     FORMAT(A1,'begin{table}')
 8107     FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109     FORMAT(A1,'begin{center}')
 8111     FORMAT(5X,'{',A1,'bf Johnson SB Method of Moments Estimate}')
 8113     FORMAT(A1,'end{center}')
 8115     FORMAT(5X,'} ',A1,A1)
C
          CALL DPCONA(92,IBASLC)
C
          WRITE(ICOUT,8101)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8103)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8109)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8111)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8113)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120     FORMAT(5X,A1,'begin{tabular} {lr}')
 8121     FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8122     FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8123     FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8124     FORMAT(5X,'Sample Skewness: & ',G15.7,2X,A1,A1)
 8125     FORMAT(5X,'Sample Kurtosis: & ',G15.7,2X,A1,A1)
 8126     FORMAT(5X,'{',A1,'bf Method of Moments Estimates:} & ',
     1           2X,A1,A1)
 8127     FORMAT(5X,'Shape Parameter $',A1,'alpha_1$: & ',
     1           G15.7,2X,A1,A1)
 8128     FORMAT(5X,'Shape Parameter $',A1,'alpha_2$: & ',
     1           G15.7,2X,A1,A1)
 8129     FORMAT(5X,'Location Parameter: & ',G15.7,2X,A1,A1)
 8130     FORMAT(5X,'Scale Parameter: & ',G15.7,2X,A1,A1)
 8140     FORMAT(5X,A1,'hline')
 8149     FORMAT(A1,'end{tabular}')
          WRITE(ICOUT,8109)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8120)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8121)N,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8122)YMEAN,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8123)YSD,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8124)YSKEW,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8125)YKURT,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8126)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8127)IBASLC,ALPHA1,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8128)IBASLC,ALPHA2,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8129)ALOC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8130)SCALE,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8149)IBASLC
          CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8191     FORMAT(A1,'end{center}')
 8193     FORMAT(A1,'end{table}')
 8199     FORMAT(A1,'begin{verbatim}')
          WRITE(ICOUT,8191)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8193)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8199)IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
        ELSE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4211)
 4211     FORMAT('JOHNSON SB METHOD OF MOMENTS ESTIMATE:')
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4222)N
 4222     FORMAT(6X,'NUMBER OF OBSERVATIONS = ',I8)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4223)YMEAN
 4223     FORMAT(6X,'MEAN                   = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4224)YSD   
 4224     FORMAT(6X,'STANDARD DEVIATION     = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4225)YSKEW   
 4225     FORMAT(6X,'SKEWNESS               = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4226)YKURT   
 4226     FORMAT(6X,'KURTOSIS               = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4241)ALPHA1
 4241     FORMAT(6X,'SHAPE PARAMETER ALPHA1 = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4241)ALPHA2
 4243     FORMAT(6X,'SHAPE PARAMETER ALPHA2 = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4245)ALOC
 4245     FORMAT(6X,'LOCATION PARAMETER     = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4247)SCALE
 4247     FORMAT(6X,'SCALE PARAMETER        = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,4249)
 4249     FORMAT('ALPHA1, ALPHA2, LOC, AND SCALE WILL BE SAVED AS ',
     1           'INTERNAL PARAMETERS.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
C
        ENDIF
        ENDIF
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='ALPH'
        IH2='A1  '
        VALUE0=ALPHA1
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='ALPH'
        IH2='A2  '
        VALUE0=ALPHA1
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='E   '
        VALUE0=SCALE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='LOC '
        IH2='    '
        VALUE0=ALOC
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'JOSU')THEN
C
C  JULY 2003: JOHNSON SU/SB MOMENT ESTIMATES
        IWRITE='OFF'
        CALL MEAN(Y,NS1,IWRITE,YMEAN,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        CALL SD(Y,NS1,IWRITE,YSD,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        CALL STMOM3(Y,NS1,IWRITE,YSKEW,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        CALL STMOM4(Y,NS1,IWRITE,YKURT,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ITYPE=2
        CALL JNSN(YMEAN,YSD,YSKEW,YKURT,ITYPE,ALPHA1,ALPHA2,
     1            SCALE,ALOC,IFAULT)
C
        IF(IFAULT.EQ.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4301)
 4301     FORMAT('***** FATAL ERROR FOR JOHNSON SU METHOD OF ',
     1           'MOMENTS.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4303)
 4303     FORMAT('      COMPUTED STANDARD DEVIATION LESS THAN ZERO.')
          CALL DPWRST('XXX','WRIT')
          GOTO9000
        ELSEIF(IFAULT.EQ.2)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4305)
 4305     FORMAT('***** FATAL ERROR FOR JOHNSON SU METHOD OF ',
     1           'MOMENTS.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4306)
 4306     FORMAT('      KURTOSIS < SKEWNESS**2 + 1')
          CALL DPWRST('XXX','WRIT')
          GOTO9000
        ELSEIF(IFAULT.EQ.3)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4307)
 4307     FORMAT('***** FATAL ERROR FOR JOHNSON SU METHOD OF ',
     1           'MOMENTS.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4308)
 4308     FORMAT('      SB FITTING FAILED TO CONVERGE.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4309)
 4309     FORMAT('      AN SL OR ST FIT MADE INSTEAD.')
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IPRINT.EQ.'ON')THEN
        IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5001     FORMAT('</PRE>')
 5011     FORMAT('<UL>')
 5013     FORMAT('<TABLE NOBORDER>')
 5015     FORMAT('   <CAPTION ALIGN=CENTER>')
 5017     FORMAT('      <B>Johnson SU Method of Moments ',
     1           'Estimation</B>')
 5019     FORMAT('   </CAPTION>')
          WRITE(ICOUT,5001)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          WRITE(ICOUT,5011)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5013)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5015)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5017)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5019)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041     FORMAT('   <TR>')
 5043     FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=250>')
 5047     FORMAT('      </TD>')
 5049     FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051     FORMAT('         ',G15.7)
 5053     FORMAT('         ',I8)
 5055     FORMAT('         &nbsp;')
 5059     FORMAT('   </TR>')
 5061     FORMAT('         Number of Observations:')
 5062     FORMAT('         Sample Mean:')
 5063     FORMAT('         Sample Standard Deviation:')
 5064     FORMAT('         Sample Skewness:')
 5065     FORMAT('         Sample Kurtosis:')
 5066     FORMAT('         <B>Method of Moments Estimates:</B>')
 5067     FORMAT('         Shape Parameter ALPHA1:')
 5068     FORMAT('         Shape Parameter ALPHA2:')
 5069     FORMAT('         Location Parameter:')
 5070     FORMAT('         Scale Parameter:')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5061)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5053)N
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5062)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)YMEAN
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5063)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)YSD
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5064)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)YSKEW
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5065)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)YKURT
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5066)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5055)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5067)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)ALPHA1
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C  
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5068)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)ALPHA2
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C  
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5069)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)ALOC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C  
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5070)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)SCALE
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C  
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091     FORMAT('</TABLE>')
 5093     FORMAT('</UL>')
 5099     FORMAT('<PRE>')
          WRITE(ICOUT,5091)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5093)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5099)
          CALL DPWRST('XXX','WRIT')
C
        ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001     FORMAT(A1,'end{verbatim}')
 8003     FORMAT(A1,'begin{table}')
 8007     FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009     FORMAT(A1,'begin{center}')
 8011     FORMAT(5X,'{',A1,'bf Johnson SU Method of Moments Estimate}')
 8013     FORMAT(A1,'end{center}')
 8015     FORMAT(5X,'} ',A1,A1)
C
          CALL DPCONA(92,IBASLC)
C
          WRITE(ICOUT,8001)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8003)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8009)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8011)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8013)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020     FORMAT(5X,A1,'begin{tabular} {lr}')
 8021     FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022     FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8023     FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8024     FORMAT(5X,'Sample Skewness: & ',G15.7,2X,A1,A1)
 8025     FORMAT(5X,'Sample Kurtosis: & ',G15.7,2X,A1,A1)
 8026     FORMAT(5X,'{',A1,'bf Method of Moments Estimates:} & ',
     1           2X,A1,A1)
 8027     FORMAT(5X,'Shape Parameter $',A1,'alpha_1$: & ',
     1           G15.7,2X,A1,A1)
 8028     FORMAT(5X,'Shape Parameter $',A1,'alpha_2$: & ',
     1           G15.7,2X,A1,A1)
 8029     FORMAT(5X,'Location Parameter: & ',G15.7,2X,A1,A1)
 8030     FORMAT(5X,'Scale Parameter: & ',G15.7,2X,A1,A1)
 8040     FORMAT(5X,A1,'hline')
 8049     FORMAT(A1,'end{tabular}')
          WRITE(ICOUT,8009)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8020)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8021)N,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8022)YMEAN,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8023)YSD,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8024)YSKEW,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8025)YKURT,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8026)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8027)IBASLC,ALPHA1,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8028)IBASLC,ALPHA2,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8029)ALOC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8030)SCALE,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8049)IBASLC
          CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091     FORMAT(A1,'end{center}')
 8093     FORMAT(A1,'end{table}')
 8099     FORMAT(A1,'begin{verbatim}')
          WRITE(ICOUT,8091)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8093)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8099)IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
        ELSE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4311)
 4311     FORMAT('JOHNSON SU METHOD OF MOMENTS ESTIMATE:')
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4322)N
 4322     FORMAT(6X,'NUMBER OF OBSERVATIONS = ',I8)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4323)YMEAN
 4323     FORMAT(6X,'MEAN                   = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4324)YSD   
 4324     FORMAT(6X,'STANDARD DEVIATION     = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4325)YSKEW   
 4325     FORMAT(6X,'SKEWNESS               = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4326)YKURT   
 4326     FORMAT(6X,'KURTOSIS               = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4341)ALPHA1
 4341     FORMAT(6X,'SHAPE PARAMETER ALPHA1 = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4341)ALPHA2
 4343     FORMAT(6X,'SHAPE PARAMETER ALPHA2 = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4345)ALOC
 4345     FORMAT(6X,'LOCATION PARAMETER     = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4347)SCALE
 4347     FORMAT(6X,'SCALE PARAMETER        = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,4349)
 4349     FORMAT('ALPHA1, ALPHA2, LOC, AND SCALE WILL BE SAVED AS ',
     1         'INTERNAL PARAMETERS.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
C
        ENDIF
        ENDIF
C
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='ALPH'
        IH2='A1  '
        VALUE0=ALPHA1
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='ALPH'
        IH2='A2  '
        VALUE0=ALPHA1
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='E   '
        VALUE0=SCALE
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='LOC '
        IH2='    '
        VALUE0=ALOC
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASAN.EQ.'GLML')THEN
C
        CALL DPMLGL(Y,NS1,
     1              XTEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,
     1              MAXNXT,
     1              ASHALM,ASCALM,ALOCLM,
     1              ICAPSW,ICAPTY,DTEMP1,DTEMP2,
     1              ALPHA,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='DPML'
C
        IH='GAMM'
        IH2='ALMO'
        VALUE0=ASHALM
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SCAL'
        IH2='ELMO'
        VALUE0=ASCALM
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='LOCL'
        IH2='MOM '
        VALUE0=ALOCLM
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'MLWE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMLWE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGQ
 9013 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NLEFT,NS
 9014 FORMAT('NLEFT,NS = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMLW1(Y,TAG,N,
     1XTEMP,DTEMP,MAXNXT,
     1SCALE,SCALSE,GAMMA,GAMMSE,GAMMBC,GABCSE,COVSE,COBCSE,
     1NUMV,ICENTY,TEND,
     1ICAPSW,ICAPTY,IWEIBC,IWEIFL,
     1QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
     1IOUNI1,IOUNI2,ALPHAP,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR WEIBULL DISTRIBUTION
C              FOR THE FULL SAMPLE CASE.
C     EXAMPLE--WEIBULL MAXIMUM LIKELIHOOD Y
C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
C                1999, CHAPTER 17.
C              --JOHNSON, KOTZ, AND BALAKRISNAN, "CONTINUOUS
C                UNIVARIATE DISTRIBUTIONS--VOLUME 1", SECOND EDITION,
C                WILEY, 1994, CHAPTER xx.
C              --KEATS, LAWRENCE, AND WANG, "WEIBULL MAXIMUM
C                LIKELIHOOD PARAMETER ESTIMATES WITH CENSORED
C                DATA", JOURNAL OF QUALITY TECHNOLOGY, 29,
C                PP. 105-110.
C              --MURTHY, XIE, AND JIANG, "WEIBULL MODELS", WILEY,
C                2004, PP. 114-118 (FOR INVERTED WEIBULL).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/11
C     ORIGINAL VERSION--NOVEMBER  2004. NOTE: THIS REPLACES SOME
C                                       EARLIER IMPLEMENTATIONS.
C     UPDATED         --AUGUST    2005. UPDATED TO HANDLE THE
C                                       INVERTED WEIBULL DISTRIBUTION
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICENTY
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IWEIBC
      CHARACTER*4 IWEIFL
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*16 IDIST
C
C---------------------------------------------------------------------
C
      PARAMETER (NUMALP=6)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWSC(NUMALP)
      DIMENSION AUPPSC(NUMALP)
      DIMENSION ALOWGA(NUMALP)
      DIMENSION AUPPGA(NUMALP)
      DIMENSION ALOWS2(NUMALP)
      DIMENSION AUPPS2(NUMALP)
      DIMENSION ALOWG2(NUMALP)
      DIMENSION AUPPG2(NUMALP)
C
      DIMENSION Y(*)
      DIMENSION TAG(*)
      DIMENSION XTEMP(*)
      DIMENSION QP(*)
      DIMENSION XQPHAT(*)
      DIMENSION XQPSE(*)
      DIMENSION XQPLCL(*)
      DIMENSION XQPUCL(*)
      DOUBLE PRECISION DTEMP(*)
C
      DOUBLE PRECISION WEIFUN
      DOUBLE PRECISION WEIFU2
      DOUBLE PRECISION WEIFU3
      EXTERNAL SUM
      EXTERNAL WEIFUN
      EXTERNAL WEIFU2
      EXTERNAL WEIFU3
C
      INTEGER IN
      DOUBLE PRECISION DWEISM
      COMMON/WEICOM/DWEISM,IN
C
      INTEGER IN2
      DOUBLE PRECISION DK
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DTERM2
      COMMON/WEICO2/DK,DTERM1,DTERM2,IN2
      INTEGER IN3
      DOUBLE PRECISION DK2
      DOUBLE PRECISION DTERM6
      DOUBLE PRECISION DTERM7
      DOUBLE PRECISION DGAMMA
      COMMON/WEICO3/DK2,DTERM6,DTERM7,DGAMMA,IN3
C
      DOUBLE PRECISION DN
      DOUBLE PRECISION DAE
      DOUBLE PRECISION DRE
      DOUBLE PRECISION DG
      DOUBLE PRECISION DS
      DOUBLE PRECISION DT1
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION DXSTRT
      DOUBLE PRECISION DXLOW
      DOUBLE PRECISION DXUP
      DOUBLE PRECISION XLOWSV
      DOUBLE PRECISION XUPSV
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
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='W1  '
C
      IDIST='WEIBULL'
      IF(IWEIFL.EQ.'IWEI')IDIST='INVERTED WEIBULL'
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW1')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLW1--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,NUMV
   55   FORMAT('N,NUMV,NPERC = ',3I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I),TAG(I)
   57     FORMAT('I,Y(I),TAG(I) = ',I8,2E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
        WRITE(ICOUT,59)ICENTY,IWEIBC
   59   FORMAT('ICENTY,IWEIBC = ',2A4)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)IDIST
 1111   FORMAT('***** ERROR IN ',A16,' MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)
 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 1 ',
     1         'IS <= 1')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)N
 1113   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C  COMPUTE THE SUMMARY STATISTICS BEFORE TRANSFORMING THE
C  DATA FOR THE INVERTED WEIBULL
C
      IERROR='NO'
      IWRITE='OFF'
C
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
      IF(IWEIFL.EQ.'IWEI')THEN
        DO1118I=1,N
          Y(I)=1.0/Y(I)
 1118   CONTINUE
      ENDIF
C
      DO1125I=1,N
        IF(Y(I).LE.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1121)IDIST
 1121     FORMAT('***** ERROR FROM ',A16,' MAXIMUM LIKELIHOOD--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1132)I,Y(I)
 1122     FORMAT('      ROW ',I8,' HAS THE VALUE = ',E15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSE
          XTEMP(I)=LOG(Y(I))
        ENDIF
 1125 CONTINUE
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)IDIST
 1131 FORMAT('***** WARNING FROM WEIBULL ',A16,' LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1132)HOLD
 1132 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
      IF(NPERC.GT.0)THEN
        DO1145I=1,NPERC
          IF(QP(I).LE.0.0 .OR. QP(I).GE.100.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1141)IDIST
 1141       FORMAT('***** WARNING IN ',A16,' MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1143)QP(I)
 1143       FORMAT('      REQUESTED PERCENTILE (',G15.7,') IS ',
     1             'OUTSIDE THE (0,100) INTERVAL')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1144)
 1144       FORMAT('      NO PERCENTILE CONFIDENCE LIMITS WILL BE ',
     1             'COMPUTED.')
            CALL DPWRST('XXX','WRIT')
            NPERC=0
          ENDIF
 1145   CONTINUE
      ENDIF
C
C               **********************************
C               **  STEP 21--                   **
C               **  CARRY OUT CALCULATIONS      **
C               **  FOR WEIBULL MLE             **
C               **  ESTIMATE (FULL SAMPLE CASE) **
C               **********************************
C
C  NOTE AUGUST 2005: CODE UPGRADED TO HANDLE INVERTED WEIBULL CASE.
C                    FOR THE INVERTED WEIBULL CASE, WE TAKE (1/X)
C                    AND WE ALSO TAKE (1/ALPHA) AS THE SCALE ESTIMATE.
C
 2100 CONTINUE
C
C  FOR THE SHAPE PARAMETER, SOLVE THE EQUATION:
C
C    (1/GHAT) -
C    SUM[i=1 to n][Y(I)**GHAT*LN(Y(I))]/SUM[i=1 to n][[Y(I)**GHAT] +
C    (1/N)*SUM[i=1 to n][LN(Y(I))] = 0
C
C  THEN
C
C    SCALE = ((1/N)*SUM[i=1 to n][Y(I)**GHAT])
C
C  FOR STARTING VALUE, USE
C
C    GHAT = 1.28/(STD DEV OF LOG(Y))
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      AN=REAL(N)
C
      CALL SD(XTEMP,N,IWRITE,XLOGSD,IBUGA3,IERROR)
      CALL SUM(XTEMP,N,IWRITE,XLOGSM,IBUGA3,IERROR)
C
C  ESTIMATES FOR 2-PARAMETER MODEL.  USE DFZER2 TO FIND ROOT OF
C  THE EQUATION GIVEN ABOVE.
C
      DO2103I=1,N
        DTEMP(I)=DBLE(Y(I))
 2103 CONTINUE
C
      DWEISM=DBLE(XLOGSM/AN)
      DXSTRT=1.28D0/DBLE(XLOGSD)
      DAE=2.0*0.000001D0*DXSTRT
      DRE=DAE
      IN=N
      IFLAG=0
      DXLOW=DXSTRT/2.0D0
      DXUP=2.0D0*DXSTRT
      ITBRAC=0
 2105 CONTINUE
      XLOWSV=DXLOW
      XUPSV=DXUP
      CALL DFZER2(WEIFUN,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
C
      IF(IFLAG.EQ.4 .AND. ITBRAC.LE.100)THEN
        DXLOW=XLOWSV/2.0D0
        DXUP=2.0D0*XUPSV
        ITBRAC=ITBRAC+1
        GOTO2105
      ENDIF
C
      IF(IFLAG.EQ.2)THEN
C
C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,2111)
C2111   FORMAT('***** WARNING FROM WEIBULL MAXIMUM ',
CCCCC1         'LIKELIHOOD--')
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,2113)
C2113   FORMAT('      ESTIMATE OF SIGMA MAY NOT BE COMPUTED TO ',
CCCCC1         'DESIRED TOLERANCE.')
CCCCC   CALL DPWRST('XXX','BUG ')
      ELSEIF(IFLAG.EQ.3)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2121)IDIST
 2121   FORMAT('***** WARNING FROM ',A16,' MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2123)
 2123   FORMAT('      ESTIMATE OF GAMMA MAY BE NEAR A SINGULAR POINT.')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IFLAG.EQ.4)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2131)IDIST
 2131   FORMAT('***** ERROR FROM ',A16,' MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2133)
 2133   FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IFLAG.EQ.5)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2141)IDIST
 2141   FORMAT('***** WARNING FROM ',A16,' MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2143)
 2143   FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      GAMMA=REAL(DXLOW)
      DSUM=0.0D0
      DO2210I=1,N
        DSUM=DSUM + DBLE(Y(I)**GAMMA)
 2210 CONTINUE
      SCALE=REAL((DSUM/DBLE(N))**DBLE(1.0D0/DBLE(GAMMA)))
      IF(IWEIFL.EQ.'IWEI')SCALE=1.0/SCALE
      BN=1.0 + 2.2/AN**1.13
      GAMMBC=GAMMA/BN
C
C  COMPUTE STANDARD ERRORS (CAN BASE ON EITHER THE NORMAL BIASED
C  ESTIMATORS OR THE BIAS CORRECTED ESTIMATORS)
C
      SCALSE=1.05293*SCALE/(GAMMA*SQRT(AN))
      GAMMSE=0.77970*GAMMA/SQRT(AN)
      GABCSE=0.77970*GAMMA/(BN*SQRT(AN))
      COVSE=0.50697*SQRT(SCALE/AN)
      COBCSE=0.50697*SQRT(SCALE/(AN*BN))
C
C  CONFIDENCE INTERVALS FOR PARAMETERS.  CAN BASE ON EITHER NORMAL
C  APPROXIMATION OR ON LIKELIHOOD RATIO APPROXIMATION.
C
C  NORMAL APPROXIMATION FIRST.
C
      DO2220I=1,NUMALP
        ALP=ALPHA(I)
        P=1.0-(ALP/2.0)
        CALL NORPPF(P,PPF)
        ALOWSC(I)=SCALE - PPF*SCALSE
        AUPPSC(I)=SCALE + PPF*SCALSE
        IF(IWEIBC.EQ.'ON')THEN
          ALOWGA(I)=GAMMBC - PPF*GABCSE
          AUPPGA(I)=GAMMBC + PPF*GABCSE
        ELSE
          ALOWGA(I)=GAMMA - PPF*GAMMSE
          AUPPGA(I)=GAMMA + PPF*GAMMSE
        ENDIF
 2220 CONTINUE
C
C  NOW DO LIKELIHOOD RATIO APPROXIMATION.
C  LIKELIHOOD RATIO INTERVALS FOR INVERTED WEIBULL DO NOT SEEM
C  CORRECT, SO JUST OMIT FOR NOW.
C
      IF(IWEIFL.EQ.'IWEI')GOTO2369
      IN2=N
      IN3=N
      DN=DBLE(N)
      DAE=1.D-7
      DRE=1.D-7
      NUTEMP=1
C
      DN=DBLE(N)
      DG=DBLE(GAMMA)
      DS=DBLE(SCALE)
      DT1=DN*DLOG(DBLE(GAMMA)) - DN*DG*DLOG(DS)
      DSUM1=0.0D0
      DSUM2=0.0D0
      DO2325I=1,N
        DTEMP(I)=DBLE(Y(I))
        DSUM1=DSUM1 + DLOG(DBLE(Y(I)))
        DSUM2=DSUM2 + DBLE(Y(I))**DG
 2325 CONTINUE
      DTERM2=DSUM1
      DTERM1=2.0D0*(DT1 + (DG-1.0D0)*DTERM2 - DS**(-DG)*DSUM2)
      DTERM7=DTERM2
      DTERM6=DTERM1
      DGAMMA=DBLE(GAMMA)
C
      DO2360I=1,NUMALP
        ALP=ALPHA(I)
        CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
        DK=DBLE(APPF)
        DK2=DK
C
        DXSTRT=DBLE(ALOWGA(I))
        DXLOW=DXSTRT/5.0D0
        DXUP=DBLE(GAMMA)
        CALL DFZER2(WEIFU2,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
        ALOWG2(I)=REAL(DXLOW)
C
        DXSTRT=DBLE(AUPPGA(I))
        DXUP=DXSTRT*5.0D0
        DXLOW=DBLE(GAMMA)
        CALL DFZER2(WEIFU2,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
        AUPPG2(I)=REAL(DXLOW)
C
        DXSTRT=DBLE(ALOWSC(I))
        DXLOW=DXSTRT/5.0D0
        DXUP=DBLE(SCALE)
        CALL DFZER2(WEIFU3,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
        ALOWS2(I)=REAL(DXLOW)
C
        DXSTRT=DBLE(AUPPSC(I))
        DXUP=DXSTRT*5.0D0
        DXLOW=DBLE(SCALE)
        CALL DFZER2(WEIFU3,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
        AUPPS2(I)=REAL(DXLOW)
 2360 CONTINUE
 2369 CONTINUE
C
C  CONFIDENCE INTERVALS FOR SELECTED PERCENTILES.
C
C  1. STANDARD ERROR USES TECHNIQUE DEMONSTRATED IN EXAMPLE 17.4
C     (P. 344) OF BURY.  THIS IS BASED ON PROPOGATION OF ERROR.
C 
C  2. CONFIDENCE INTERVAL IS THEN GENERATED USING NORMAL
C     APPROXIMATION (EXAMPLE 17.7 OF BURY).  BURY ALSO DEMONSTRATES
C     A LIKELIHOOD RATIO APPROACH, BUT OMIT THIS FOR NOW.
C
      IF(NPERC.GE.1)THEN
C
        ALPHL=ALPHAP/2.0
        ALPHU=1.0 - ALPHAP/2.0
        CALL NORPPF(ALPHU,Z95)
        MINMAX=1
C
        IF(IWEIBC.EQ.'ON')THEN
          G=GAMMBC
          GSE=GABCSE
          COV=COBCSE
        ELSE
          G=GAMMA
          GSE=GAMMSE
          COV=COVSE
        ENDIF
C
        WRITE(IOUNI1,2431)
        WRITE(IOUNI1,2432)
        DO2429I=1,NPERC
          QPTEMP=QP(I)/100.0
          CALL WEIPPF(QPTEMP,G,MINMAX,APPF)
          XQPHAT(I)=SCALE*APPF
C
          C=LOG(1.0/(1.0 - QPTEMP))
          DA=C**(1.0/G)
          DB=-(SCALE*C**(1.0/G)*LOG(C)/(G**2))
          TERM1=(DA*SCALSE)**2
          TERM2=(DB*GSE)**2
          TERM3=2.0*DA*DB*COV*COV
          SEXQP=SQRT(TERM1 + TERM2 + TERM3)
          XQPSE(I)=SEXQP
          XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
          XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
          WRITE(IOUNI1,'(5E15.7)')
     1         QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
 2429   CONTINUE
 2431   FORMAT(15X,'       POINT     ','     LOWER     ',
     1         '     UPPER')
 2432   FORMAT('    PERCENTILE ','     ESTIMATE   ',
     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
      ENDIF
C
C               *************************************
C               **   STEP 42--                     **
C               **   WRITE OUT EVERYTHING          **
C               **   FOR WEIBULL MLE ESTIMATE      **
C               *************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW1')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5002   FORMAT('<B>',A16,' PARAMETER ESTIMATION:')
 5004   FORMAT('<BR>FULL SAMPLE CASE</B>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)IDIST
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Two-Parameter Model (Location = 0)</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=350>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5060   FORMAT('         Summary Statistics:')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Mean:')
 5063   FORMAT('         Sample Standard Deviation:')
 5064   FORMAT('         Minimum Value:')
 5074   FORMAT('         Maximum Value:')
 5075   FORMAT('         Maximum Likelihood Estimates:')
 5065   FORMAT('         Estimate of Scale Parameter:')
 5066   FORMAT('         Standard Error of Scale Parameter:')
 5067   FORMAT('         Estimate of Shape Parameter:')
 5068   FORMAT('         Standard Error of Shape Parameter:')
55067   FORMAT('         Estimate of Bias Corrected Shape Parameter:')
55068   FORMAT('         Standard Error of Bias Corrected Shape ',
     1         'Parameter:')
 5069   FORMAT('         Standard Error of Covariance of Scale and ',
     1         'Shape Parameter:')
55069   FORMAT('         Standard Error of Bias Corrected Covariance ',
     1         'of Scale and Shape Parameter:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5074)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5075)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMA
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMBC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GABCSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)COVSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)COBCSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Limits for the Shape ',
     1         'Parameter</B><BR>')
 5118   FORMAT('      <B>(Based on Biased Estimate)</B>')
55118   FORMAT('      <B>(Based on Bias Corrected Estimate)</B>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        IF(IWEIBC.EQ.'ON')THEN
          WRITE(ICOUT,55118)
        ELSE
          WRITE(ICOUT,5118)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5134   FORMAT('         &nbsp;')
 5136   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM COLSPAN=2>')
 5137   FORMAT('         Normal Approximation')
 5138   FORMAT('         Likelihood Ratio')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=5>')
 5162   FORMAT('          <HR>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5138)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
C
        IF(IWEIFL.NE.'IWEI')THEN
          WRITE(ICOUT,5129)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5131)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5129)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5133)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        DO5140I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWGA(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPGA(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
C
          IF(IWEIFL.NE.'IWEI')THEN
            WRITE(ICOUT,5149)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5151)ALOWG2(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5147)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5149)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5151)AUPPG2(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5147)
            CALL DPWRST('XXX','WRIT')
          ENDIF
C
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5140   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5217   FORMAT('      <B>Confidence Limits for the Scale ',
     1         'Parameter</B>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5217)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5138)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
C
        IF(IWEIFL.NE.'IWEI')THEN
          WRITE(ICOUT,5129)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5131)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5129)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5133)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
        DO5240I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWSC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPSC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
C
          IF(IWEIFL.NE.'IWEI')THEN
            WRITE(ICOUT,5149)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5151)ALOWS2(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5147)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5149)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5151)AUPPS2(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5147)
            CALL DPWRST('XXX','WRIT')
          ENDIF
C
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5240   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  START THE TABLE FOR PERCENTILE CONFIDENCE INTERVALS
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,999)
          WRITE(ICOUT,5811)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5813)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5815)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5817)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5816)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5819)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5861)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,55862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5863)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5864)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5870)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5872)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5847)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          DO55880I=1,NPERC
            WRITE(ICOUT,5841)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)QP(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPHAT(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPSE(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPLCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPUCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5859)
            CALL DPWRST('XXX','WRIT')
55880     CONTINUE
C
C  END THE TABLE AND RESET ASIS MODE
C
          WRITE(ICOUT,5191)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5193)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,5801)
        CALL DPWRST('XXX','WRIT')
C
 5801     FORMAT('<PRE>')
 5811     FORMAT('<UL>')
 5813     FORMAT('<TABLE NOBORDER>')
 5815     FORMAT('   <CAPTION ALIGN=CENTER>')
 5816     FORMAT('      <BR><B>Alpha = ',F7.3,'</B>')
 5817     FORMAT('      <B>Confidence Limits (Normal Approximation) ',
     1           'for Selected ',
     1           'Percentiles<br>(No Bias Correction Estimates)</B>')
 5818     FORMAT('      <B>Confidence Limits (Normal Approximation)',
     1           ' for Selected ',
     1           'Percentiles<br>(Bias Corrected Estimates)</B>')
 5819     FORMAT('   </CAPTION>')
 5841     FORMAT('   <TR>')
 5843     FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5847     FORMAT('      </TD>')
 5848     FORMAT('      </TH>')
 5849     FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5851     FORMAT('         ',G15.7)
 5859     FORMAT('   </TR>')
 5861     FORMAT('         Percentile')
 5862     FORMAT('         Point <br> Estimate')
55862     FORMAT('         Standard <br> Error')
 5863     FORMAT('         Lower <br>Confidence Limit')
 5864     FORMAT('         Upper <br>Confidence Limit')
 5870     FORMAT('      <TD COLSPAN=5>')
 5872     FORMAT('         <HR WIDTH=600>')
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001   FORMAT(A1,'end{verbatim}')
 8003   FORMAT(A1,'begin{table}')
 8004   FORMAT(A1,'end{table}')
 8005   FORMAT('{',A1,'bf Weibull Parameter ',
     1         'Estimation: Full Sample Case}')
 8006   FORMAT('{',A1,'bf Inverted Weibull Parameter ',
     1         'Estimation: Full Sample Case}')
 8007   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009   FORMAT(A1,'begin{center}')
 8011   FORMAT(5X,'{',A1,'bf Two-Parameter Model ($',A1,
     1         'mu$ = 0 Case)}')
 8013   FORMAT(A1,'end{center}')
 8015   FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(IWEIFL.EQ.'IWEI')THEN
          WRITE(ICOUT,8006)IBASLC
        ELSE
          WRITE(ICOUT,8005)IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020   FORMAT(5X,A1,'begin{tabular} {lr}')
 8021   FORMAT(5X,'Summary Statistics: & ',2X,A1,A1)
 8022   FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8023   FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8024   FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8025   FORMAT(5X,'Minimum Value: & ',G15.7,2X,A1,A1)
 8026   FORMAT(5X,'Maximum Value: & ',G15.7,2X,A1,A1)
 8027   FORMAT(5X,' & ',2X,A1,A1)
 8028   FORMAT(5X,'Maximum Likelihood Estimates: & ',2X,A1,A1)
 8029   FORMAT(5X,'Estimate of Scale Parameter: & ',G15.7,2X,A1,A1)
 8030   FORMAT(5X,'Standard Error of Scale Parameter: & ',
     1         G15.7,2X,A1,A1)
 8031   FORMAT(5X,'Estimate of Shape Parameter: & ',G15.7,2X,A1,A1)
 8032   FORMAT(5X,'Standard Error of Shape Parameter: & ',
     1         G15.7,2X,A1,A1)
 8033   FORMAT(5X,'Estimate of Bias Corrected Shape Parameter: & ',
     1         G15.7,2X,A1,A1)
 8034   FORMAT(5X,'Standard Error of Bias Corrected Shape ',
     1         'Parameter: & ',G15.7,2X,A1,A1)
 8035   FORMAT(5X,'Standard Error of Covariance of Scale and Shape ',
     1         'Parameter: & ',G15.7,2X,A1,A1)
 8036   FORMAT(5X,'Standard Error of Bias Corrected Covariance of ',
     1         'Scale and Shape  Parameter: & ',G15.7,2X,A1,A1)
 8049   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8029)SCALE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)SCALSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)GAMMA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)GAMMSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8033)GAMMBC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8034)GABCSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8035)COVSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8036)COBCSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8093   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for Shape Parameter ',
     1       '(Based on No Bias Correction Estimate)}')
 8112 FORMAT(5X,'{',A1,'bf Confidence Limits for Shape Parameter ',
     1       '(Based on Bias Corrected Estimate)}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IWEIBC.EQ.'ON')THEN
          WRITE(ICOUT,8112)IBASLC
        ELSE
          WRITE(ICOUT,8111)IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120   FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper & Lower & Upper ',
     1         2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit & Limit & Limit',
     1         2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,' & ',G15.7,' & ',
     1         G15.7,2X,A1,A1)
 8126   FORMAT(5X,'& ',A1,'multicolumn{2}{c}{Normal Approximation}',
     1         ' & ',A1,'multicolumn{2}{c}{Likelihood Ratio}',
     1         2X,A1,A1)
 8420   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8421   FORMAT(5X,'Confidence & Lower & Upper ',2X,A1,A1)
 8422   FORMAT(5X,'Value (',A1,'%) & Limit & Limit ',2X,A1,A1)
 8431   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,2X,A1,A1)
 8426   FORMAT(5X,'& ',A1,'multicolumn{2}{c}{Normal Approximation}',
     1         2X,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IWEIFL.EQ.'IWEI')THEN
          WRITE(ICOUT,8420)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8426)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8421)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8422)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8120)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8126)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8121)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8130I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          IF(IWEIFL.EQ.'IWEI')THEN
            WRITE(ICOUT,8431)ATEMP,ALOWGA(I),AUPPGA(I),IBASLC,IBASLC
          ELSE
            WRITE(ICOUT,8131)ATEMP,ALOWGA(I),AUPPGA(I),ALOWG2(I),
     1                       AUPPG2(I),IBASLC,IBASLC
          ENDIF
          CALL DPWRST('XXX','WRIT')
 8130   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8191   FORMAT(A1,'end{table}')
 8193   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8211 FORMAT(5X,'{',A1,'bf Confidence Limits for Scale Parameter}')
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8211)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IWEIFL.EQ.'IWEI')THEN
          WRITE(ICOUT,8420)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8426)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8421)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8422)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8120)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8126)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8121)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8230I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
          IF(IWEIFL.EQ.'IWEI')THEN
            WRITE(ICOUT,8431)ATEMP,ALOWSC(I),AUPPSC(I),IBASLC,IBASLC
          ELSE
            WRITE(ICOUT,8131)ATEMP,ALOWSC(I),AUPPSC(I),ALOWS2(I),
     1                       AUPPS2(I),IBASLC,IBASLC
          ENDIF
          CALL DPWRST('XXX','WRIT')
 8230   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8191)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C WRITE SELECTED PERCENTILES (IF ANY)
C
        IF(NPERC.GT.0)THEN
C
          CALL DPCONA(92,IBASLC)
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8803)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8810)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          IF(IWEIBC.EQ.'ON')THEN
            WRITE(ICOUT,88811)IBASLC
          ELSE
            WRITE(ICOUT,8811)IBASLC
          ENDIF
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8812)IBASLC,IBASLC,ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8813)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8820)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8821)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8822)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,
     1                     IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8840)IBASLC
          CALL DPWRST('XXX','WRIT')
          DO8830I=1,NPERC
            WRITE(ICOUT,8823)QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),
     1                       XQPUCL(I),IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
 8830     CONTINUE
          WRITE(ICOUT,8849)IBASLC
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8891)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8893)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
 8801   FORMAT(A1,'end{verbatim}')
 8803   FORMAT(A1,'begin{table}')
 8807   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8809   FORMAT(A1,'begin{center}')
 8810   FORMAT(5X,'{',A1,'bf Confidence Limits (Normal Approximation)',
     1         'for Selected Percentiles}')
 8811   FORMAT(5X,'{',A1,'bf (Based on No Bias Correction Estimates:}')
88811   FORMAT(5X,'{',A1,'bf (Based on Bias Corrected Estimates:}')
 8812   FORMAT(5X,'{',A1,'bf $',A1,'alpha$ = ',F7.3,'}')
 8813   FORMAT(A1,'end{center}')
 8815   FORMAT(5X,'} ',A1,A1)
 8820   FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8821   FORMAT(5X,' & {',A1,'bf Point} & {',A1,'bf Standard} & {',
     1         A1,'bf Lower} & {',A1,'bf Upper}',2X,A1,A1)
 8822   FORMAT(5X,'{',A1,'bf Percentile} & {',A1,'bf Estimate} & {',
     1         A1,'bf Error} & {',A1,'bf Confidence Limit} & {',
     1         A1,'bf Confidence Limit}',
     1         2X,A1,A1)
 8823   FORMAT(5X,G15.7,' & ',G15.7,' & ',G15.7,' & ',G15.7,
     1         ' & ',G15.7,2X,A1,A1)
 8840   FORMAT(5X,A1,'hline')
 8849   FORMAT(A1,'end{tabular}')
 8891   FORMAT(A1,'end{center}')
 8893   FORMAT(A1,'end{table}')
C
 8899   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8899)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(IWEIFL.EQ.'IWEI')THEN
          WRITE(ICOUT,4201)
 4201     FORMAT(6X,'INVERTED WEIBULL PARAMETER ',
     1           'ESTIMATION: FULL SAMPLE CASE')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4203)
 4203     FORMAT(6X,'WEIBULL PARAMETER ESTIMATION: FULL SAMPLE CASE')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,4209)
 4209   FORMAT(12X,'TWO-PARAMETER MODEL (LOCATION = 0)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4211)
 4211   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4213)N
 4213   FORMAT('NUMBER OF OBSERVATIONS                            = ',
     1         I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4215)XMEAN
 4215   FORMAT('SAMPLE MEAN                                       = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4217)XSD
 4217   FORMAT('SAMPLE STANDARD DEVIATION                         = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4218)XMIN
 4218   FORMAT('SAMPLE MINIMUM                                    = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4219)XMAX
 4219   FORMAT('SAMPLE MAXIMUM                                    = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4221)
 4221   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)SCALE
 4223   FORMAT('ESTIMATE OF SCALE PARAMETER                       = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)SCALSE
 4225   FORMAT('STANDARD ERROR OF SCALE PARAMETER                 = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4227)GAMMA
 4227   FORMAT('ESTIMATE OF SHAPE PARAMETER                       = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4231)GAMMSE
 4231   FORMAT('STANDARD ERROR OF SHAPE PARAMETER                 = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4229)GAMMBC
 4229   FORMAT('BIAS CORRECTED ESTIMATE OF SHAPE PARAMETER        = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4232)GABCSE
 4232   FORMAT('STANDARD ERROR OF BIAS CORRECTED SHAPE PARAMETER  = ',
     1        G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4233)COVSE
 4233   FORMAT('STANDARD ERROR OF SHAPE/SCALE COVARIANCE          = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4234)COBCSE
 4234   FORMAT('STD ERR OF BIAS CORRECTED SHAPE/SCALE COVARIANCE  = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4240)
 4240   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(IWEIFL.EQ.'IWEI')THEN
          WRITE(ICOUT,4142)
 4142     FORMAT('                       NORMAL APPROXIMATION')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4143)
 4143     FORMAT('   CONFIDENCE           LOWER         UPPER')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4145)
 4145     FORMAT('   VALUE (%)            LIMIT         LIMIT')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4146)
 4146     FORMAT('-------------------------------------------')
          CALL DPWRST('XXX','WRIT')
          DO4149I=1,NUMALP
            ATEMP=100.0*(1.0 - ALPHA(I))
            WRITE(ICOUT,4247)ATEMP,ALOWSC(I),AUPPSC(I)
 4147       FORMAT('   ',F8.3,10X,2(G12.6,2X))
            CALL DPWRST('XXX','WRIT')
 4149     CONTINUE
        ELSE
          WRITE(ICOUT,4242)
 4242     FORMAT('                       NORMAL APPROXIMATION',
     1           '            LIKELIHOOD RATIO')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4243)
 4243     FORMAT('   CONFIDENCE           LOWER         UPPER',
     1           '         LOWER         UPPER')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4245)
 4245     FORMAT('   VALUE (%)            LIMIT         LIMIT',
     1           '         LIMIT         LIMIT')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4246)
 4246     FORMAT('------------------------------------------------',
     1           '-----------------------')
          CALL DPWRST('XXX','WRIT')
          DO4249I=1,NUMALP
            ATEMP=100.0*(1.0 - ALPHA(I))
            WRITE(ICOUT,4247)ATEMP,ALOWSC(I),AUPPSC(I),ALOWS2(I),
     1                       AUPPS2(I)
 4247       FORMAT('   ',F8.3,10X,4(G12.6,2X))
            CALL DPWRST('XXX','WRIT')
 4249     CONTINUE
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4252)
 4252   FORMAT('CONFIDENCE INTERVAL FOR SHAPE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        IF(IWEIBC.EQ.'ON')THEN
          WRITE(ICOUT,4254)
 4254     FORMAT('(BASED ON BIAS CORRECTED ESTIMATES)')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4256)
 4256     FORMAT('(BASED ON NO BIAS CORRECTION ESTIMATES)')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(IWEIFL.EQ.'IWEI')THEN
          WRITE(ICOUT,4142)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4145)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4146)
          CALL DPWRST('XXX','WRIT')
          DO4159I=1,NUMALP
            ATEMP=100.0*(1.0 - ALPHA(I))
            WRITE(ICOUT,4147)ATEMP,ALOWGA(I),AUPPGA(I)
            CALL DPWRST('XXX','WRIT')
 4159     CONTINUE
        ELSE
          WRITE(ICOUT,4242)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4243)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4245)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4246)
          CALL DPWRST('XXX','WRIT')
          DO4259I=1,NUMALP
            ATEMP=100.0*(1.0 - ALPHA(I))
            WRITE(ICOUT,4247)ATEMP,ALOWGA(I),AUPPGA(I),ALOWG2(I),
     1                       AUPPG2(I)
            CALL DPWRST('XXX','WRIT')
 4259     CONTINUE
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,4911)
          CALL DPWRST('XXX','WRIT')
          IF(IWEIBC.EQ.'ON')THEN
            WRITE(ICOUT,4913)
          ELSE
            WRITE(ICOUT,4914)
          ENDIF
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4915)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4921)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4922)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4346)
          CALL DPWRST('XXX','WRIT')
C
 4911   FORMAT('CONFIDENCE LIMITS (NORMAL APPROXIMATION) FOR ',
     1         'SELECTED PERCENTILES:')
 4913   FORMAT('(BASED ON BIAS CORRECTED ESTIMATES)')
 4914   FORMAT('(BASED ON NO BIAS CORRECTION ESTIMATES)')
 4915   FORMAT('ALPHA = ',F7.4)
 4921   FORMAT(10X,'      POINT     ','  STANDARD   ',
     1             '        LOWER     ', '       UPPER')
 4922   FORMAT('PERCENTILE','   ESTIMATE   ','      ERROR     ',
     1         'CONFIDENCE LIMIT ',' CONFIDENCE LIMIT')
 4346   FORMAT('-----------------------------------',
     1         '-----------------------------------')
C
          DO4981I=1,NPERC
            WRITE(ICOUT,4932)QP(I),XQPHAT(I),XQPSE(I),
     1                       XQPLCL(I),XQPUCL(I)
 4932       FORMAT(2X,F8.4,2G15.7,2X,G15.7,2X,G15.7)
            CALL DPWRST('XXX','WRIT')
 4981     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,4291)
 4291     FORMAT('THE FOLLOWING INTERNAL PARAMETERS ARE SAVED:')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4293)
 4293     FORMAT('      ALPHAML, ALPHASE, GAMMAML, GAMMASE, ',
     1           'CAMMABC, GAMMABCSE,COVSE,COVBCSE')
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IF(IFEEDB.EQ.'ON')THEN
          IF(NPERC.GT.0)THEN
            WRITE(ICOUT,4943)
 4943       FORMAT('PERCENTILE CONFIDENCE LIMITS  WRITTEN TO ',
     1             'FILE  dpst1f.dat')
            CALL DPWRST('XXX','BUG ')
          ENDIF
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW1')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLW1--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLW2(Y,TAG,N,
     1XTEMP,DTEMP,MAXNXT,
     1SCALE,SCALSE,GAMMA,GAMMSE,GAMMBC,GABCSE,COVSE,COBCSE,
     1NUMV,ICENTY,TEND,
     1ICAPSW,ICAPTY,IWEIBC,IWEIFL,
     1QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
     1IOUNI1,IOUNI2,ALPHAP,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR WEIBULL DISTRIBUTION
C              FOR THE TIME CENSORED (SINGY OR MULTIPLY) CASE.
C     EXAMPLE--WEIBULL MAXIMUM LIKELIHOOD Y X
C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
C                1999, CHAPTER 17.
C              --JOHNSON, KOTZ, AND BALAKRISNAN, "CONTINUOUS
C                UNIVARIATE DISTRIBUTIONS--VOLUME 1", SECOND EDITION,
C                WILEY, 1994, CHAPTER xx.
C              --KEATS, LAWRENCE, AND WANG, "WEIBULL MAXIMUM
C                LIKELIHOOD PARAMETER ESTIMATES WITH CENSORED
C                DATA", JOURNAL OF QUALITY TECHNOLOGY, 29,
C                PP. 105-110.
C              --MURTHY, XIE, AND JIANG, "WEIBULL MODELS", WILEY,
C                2004, PP. 114-118 (FOR INVERTED WEIBULL).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/11
C     ORIGINAL VERSION--NOVEMBER  2004. NOTE: THIS REPLACES SOME
C                                       EARLIER IMPLEMENTATIONS.
C     UPDATED         --AUGUST    2005. UPDATED TO HANDLE THE
C                                       INVERTED WEIBULL DISTRIBUTION.
C                                       CURRENTLY, INVERTED WEIBULL WILL
C                                       ONLY GENERATE POINT ESTIMATES 
C                                       SINCE COMPUTATION OF SCALE SE
C                                       IS NOT RETURNING A REASONABLE
C                                       VALUE.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICENTY
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IWEIBC
      CHARACTER*4 IWEIFL
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASE
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*16 IDIST
C
C---------------------------------------------------------------------
C
      PARAMETER (NUMALP=6)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWSC(NUMALP)
      DIMENSION AUPPSC(NUMALP)
      DIMENSION ALOWGA(NUMALP)
      DIMENSION AUPPGA(NUMALP)
      DIMENSION ALOWS2(NUMALP)
      DIMENSION AUPPS2(NUMALP)
      DIMENSION ALOWG2(NUMALP)
      DIMENSION AUPPG2(NUMALP)
C
      DIMENSION FISH(2,2)
      DIMENSION COV(2,2)
      DIMENSION D(2)
C
      DIMENSION Y(*)
      DIMENSION TAG(*)
      DIMENSION XTEMP(*)
      DIMENSION QP(*)
      DIMENSION XQPHAT(*)
      DIMENSION XQPSE(*)
      DIMENSION XQPLCL(*)
      DIMENSION XQPUCL(*)
      DOUBLE PRECISION DTEMP(*)
      DOUBLE PRECISION WEIFUN
C
      EXTERNAL SUM
      EXTERNAL WEIFUN
CCCCC EXTERNAL WEIFU5
CCCCC EXTERNAL WEIFU6
C
      INTEGER IN
      DOUBLE PRECISION DWEISM
      COMMON/WEICOM/DWEISM,IN
C
      INTEGER IN2
      INTEGER IR2
      DOUBLE PRECISION DK
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DTERM2
      COMMON/WEICO5/DK,DTERM1,DTERM2,IN2,IR2
      INTEGER IN3
      INTEGER IR3
      DOUBLE PRECISION DK2
      DOUBLE PRECISION DTERM6
      DOUBLE PRECISION DTERM7
      DOUBLE PRECISION DGAMMA
      COMMON/WEICO6/DK2,DTERM6,DTERM7,DGAMMA,IN3,IR3
C
      DOUBLE PRECISION DN
      DOUBLE PRECISION AE
      DOUBLE PRECISION RE
      DOUBLE PRECISION DG
      DOUBLE PRECISION DS
      DOUBLE PRECISION DT1
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION XSTART
      DOUBLE PRECISION XLOW
      DOUBLE PRECISION XUP
      DOUBLE PRECISION DX
      DOUBLE PRECISION DSCALE
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
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPML'
      ISUBN2='W2  '
C
      IDIST='WEIBULL'
      IF(IWEIFL.EQ.'IWEI')IDIST='INVERTED WEIBULL'
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLW2--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3,ICENTY = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,NUMV,NPERC
   55   FORMAT('N,NUMV,NPERC = ',3I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I),TAG(I)
   57     FORMAT('I,Y(I),TAG(I) = ',I8,2E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
        WRITE(ICOUT,59)ICENTY,IWEIBC
   59   FORMAT('ICENTY,IWEIBC = ',2A4)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)IDIST
 1111   FORMAT('***** ERROR IN ',A16,' MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)
 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 1 ',
     1         'IS <= 1')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)N
 1113   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      DO1125I=1,N
        IF(Y(I).LE.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1121)IDIST
 1121     FORMAT('***** ERROR FROM ',A16,' MAXIMUM LIKELIHOOD--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,1132)I,Y(I)
 1122     FORMAT('      ROW ',I8,' HAS THE VALUE = ',E15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
 1125 CONTINUE
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)IDIST
 1131 FORMAT('***** WARNING FROM ',A16,' MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1132)HOLD
 1132 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
      IF(NPERC.GT.0)THEN
        DO1145I=1,NPERC
          IF(QP(I).LE.0.0 .OR. QP(I).GE.100.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1141)IDIST
 1141       FORMAT('***** WARNING IN ',A6,' MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1143)QP(I)
 1143       FORMAT('      REQUESTED PERCENTILE (',G15.7,') IS ',
     1             'OUTSIDE THE (0,100) INTERVAL')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1144)
 1144       FORMAT('      NO PERCENTILE CONFIDENCE LIMITS WILL BE ',
     1             'COMPUTED.')
            CALL DPWRST('XXX','WRIT')
            NPERC=0
          ENDIF
 1145   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 21--                             **
C               **  CHECK THE CENSORING VARIABLE: SHOULD  **
C               **  BE AT MOST 2 DISTINCT VALUES, 1       **
C               **  INDICATES FAILURE TIME, 0 INDICATES   **
C               **  CENSORING TIME.                       **
C               ********************************************
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
C
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
C
CCCCC AUGUST 2005: TRANSFORM DATA FOR INVERTED WEIBULL.
C
      IF(IWEIFL.EQ.'IWEI')THEN
        DO1118I=1,N
          Y(I)=1.0/Y(I)
 1118   CONTINUE
      ENDIF
C
CCCCC NOVEMBER 2004.  FOR CENSORED CASE, CHECK THAT SECOND VARIABLE
CCCCC                 CONTAINS TWO DISTINCT VALUES, SET TO 1 AND 0.
C
      CALL DISTIN(TAG,N,IWRITE,XTEMP,NDIST,IBUGA3,IERROR)
      IF(NDIST.EQ.1)THEN
        DO2102I=1,N
          TAG(I)=1.0
 2102   CONTINUE
      ELSEIF(NDIST.EQ.2)THEN
        IF(XTEMP(1).EQ.1.0 .OR. XTEMP(2).EQ.1.0)THEN
          DO2103I=1,N
            IF(TAG(I).NE.1.0)TAG(I)=0.0
 2103     CONTINUE
        ELSE
          ATEMP1=MIN(XTEMP(1),XTEMP(2))
          ATEMP2=MAX(XTEMP(1),XTEMP(2))
          DO2108I=1,N
            IF(TAG(I).EQ.ATEMP1)TAG(I)=1.0
            IF(TAG(I).EQ.ATEMP2)TAG(I)=0.0
 2108     CONTINUE
        ENDIF
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2104)
 2104   FORMAT('***** ERROR IN WEIBULL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2105)
 2105   FORMAT('      FOR CENSORED DATA, THE CENSORING VARIABLE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2106)
 2106   FORMAT('      SHOULD CONTAIN AT MOST TWO DISTINCT VALUES.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2107)NDIST
 2107   FORMAT('      ',I8,' DISTINCT VALUES FOUND.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      CALL SORTC(Y,TAG,N,Y,TAG)
      IR=0
      DO2120I=1,N
        IF(TAG(I).EQ.1.0)IR=IR+1
 2120 CONTINUE
      IM=N-IR
      IR1=IR
      IR2=IR
      IR3=IR
C
      AR=REAL(IR)
      DR=DBLE(IR)
      AN=REAL(N)
      AM=REAL(IM)
C
      IF(IM.EQ.0)THEN
        ICASE='NONE'
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2131)IDIST
 2131   FORMAT('***** WARNING FROM ',A16,' MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2133)
 2133   FORMAT('      NO CENSORING TIMES DETECTED.  IT IS RECOMMENDED')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2135)
 2135   FORMAT('      THAT THE FULL SAMPLE SYNTAX BE USED:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2137)IDIST
 2137   FORMAT('      ',A16,' MAXIMUM LIKELIHOOD  Y')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSE
        ICASE='SING'
        AHOLD=Y(IR+1)
        DO2140I=IR+1,N
          IF(Y(I).NE.AHOLD)THEN
            ICASE='MULT'
            GOTO2149
          ENDIF
 2140   CONTINUE
 2149   CONTINUE
      ENDIF
C
C               **********************************
C               **  STEP 41--                   **
C               **  CARRY OUT CALCULATIONS      **
C               **  FOR WEIBULL MLE             **
C               **  ESTIMATE (FULL SAMPLE CASE) **
C               **********************************
C
 3100 CONTINUE
C
C  FOR THE SHAPE PARAMETER, SOLVE THE EQUATION:
C
C    (1/GHAT) -
C    SUM[i=1 to n][Y(I)**GHAT*LN(Y(I))]/SUM[i=1 to n][[Y(I)**GHAT] +
C    (1/N)*SUM[i=1 to n][LN(Y(I))] = 0
C
C  THEN
C
C    SCALE = ((1/N)*SUM[i=1 to n][Y(I)**GHAT])
C
C  FOR STARTING VALUE, USE
C
C    GHAT = 1.28/(STD DEV OF LOG(Y))
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW2')THEN
        WRITE(ICOUT,2191)IR,IM,ICASE
 2191   FORMAT('IR,IM,ICASE = ',2I8,A4)
        CALL DPWRST('XXX','BUG ')
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        DO2199I=1,N
          WRITE(ICOUT,2197)I,Y(I),TAG(I)
 2197     FORMAT('I,Y(I),TAG(I) = ',I8,2G15.7)
          CALL DPWRST('XXX','BUG ')
 2199   CONTINUE
      ENDIF
C
      DO3010I=1,N
        XTEMP(I)=LOG(Y(I))
 3010 CONTINUE
C
      CALL SD(XTEMP,N,IWRITE,XLOGSD,IBUGA3,IERROR)
C
C  ESTIMATES FOR 2-PARAMETER MODEL.  USE DFZER2 TO FIND ROOT OF
C  THE EQUATION GIVEN ABOVE.
C
      DSUM1=0.0D0
      DO3101I=1,N
        DTEMP(I)=DBLE(Y(I))
        IF(TAG(I).EQ.1)DSUM1=DSUM1 + DLOG(DTEMP(I))
 3101 CONTINUE
      DWEISM=DSUM1/DBLE(AR)
      XSTART=DBLE(1.28/XLOGSD)
      AE=2.0*0.000001*XSTART
      RE=AE
      IN=N
      IFLAG=0
      XLOW=XSTART/2.0D0
      XUP=2.0D0*XSTART
      ITBRAC=0
 3105 CONTINUE
      XLOWSV=XLOW
      XUPSV=XUP
      CALL DFZER2(WEIFUN,XLOW,XUP,XSTART,RE,AE,IFLAG,DTEMP)
C
      IF(IFLAG.EQ.4 .AND. ITBRAC.LE.100)THEN
        XLOW=XLOWSV/2.0D0
        XUP=2.0D0*XUPSV
        ITBRAC=ITBRAC+1
        GOTO3105
      ENDIF
C
      IF(IFLAG.EQ.2)THEN
C
C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,3111)
C3111   FORMAT('***** WARNING FROM WEIBULL MAXIMUM ',
CCCCC1         'LIKELIHOOD--')
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,3113)
C3113   FORMAT('      ESTIMATE OF SIGMA MAY NOT BE COMPUTED TO ',
CCCCC1         'DESIRED TOLERANCE.')
CCCCC   CALL DPWRST('XXX','BUG ')
      ELSEIF(IFLAG.EQ.3)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3121)IDIST
 3121   FORMAT('***** WARNING FROM ',A16,' MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3123)
 3123   FORMAT('      ESTIMATE OF GAMMA MAY BE NEAR A SINGULAR POINT.')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IFLAG.EQ.4)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3131)IDIST
 3131   FORMAT('***** ERROR FROM ',A16,' MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3133)
 3133   FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IFLAG.EQ.5)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3141)IDIST
 3141   FORMAT('***** WARNING FROM ',A16,' MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3143)
 3143   FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      GAMMA=XLOW
      DSUM1=0.0D0
      DO3108I=1,N
        DSUM1=DSUM1 + DBLE(Y(I)**GAMMA)
 3108 CONTINUE
      SCALE=REAL((DSUM1/DBLE(IR))**DBLE(1.0D0/DBLE(GAMMA)))
      IF(IWEIFL.EQ.'IWEI')THEN
        SCALE=1.0/SCALE
        GOTO3499
      ENDIF
C
      BN=1.0 + 2.2/AR**1.13
      GAMMBC=GAMMA/BN
C
C  COMPUTE STANDARD ERRORS.  DO FOR BOTH THE NO BIAS CORRECTION
C  ESTIMATES AND THE BIAS CORRECTED ESTIMATES.
C
      DSUM1=0.0D0
      DSCALE=DBLE(SCALE)
      DO3210I=1,N
        DX=DBLE(Y(I))
        DSUM1=DSUM1 +  ((DX/DSCALE)**GAMMA)*(DLOG(DX/DSCALE))**2
 3210 CONTINUE
      DSUM2=0.0D0
      DO3220I=1,N
        IF(TAG(I).EQ.1.0)THEN
          DX=DBLE(Y(I))
          DSUM2=DSUM2 + DLOG(DX)
        ENDIF
 3220 CONTINUE
C
      FISH(1,1)=AR*(GAMMA/SCALE)**2
      FISH(2,2)=AR/(GAMMA**2) + REAL(DSUM1)
      FISH(2,1)=(GAMMA/SCALE)*(AR*LOG(SCALE) - (AR/GAMMA) - 
     1          REAL(DSUM2))
      FISH(1,2)=FISH(2,1)
C
      NDIM=2
      CALL SGECO(FISH,NDIM,NDIM,ITEMP,RCOND,XTEMP)
      IJOB=1
      CALL SGEDI(FISH,NDIM,NDIM,ITEMP,XTEMP,XTEMP(MAXNXT/2),IJOB)
      DO3230J=1,NDIM
        DO3240I=1,NDIM
          COV(I,J)=FISH(I,J)
 3240   CONTINUE
 3230 CONTINUE
      IF(COV(1,1).GE.0.0)THEN
        SCALSE=SQRT(COV(1,1))
      ELSE
        SCALSE=0.0
      ENDIF
      IF(COV(2,2).GE.0.0)THEN
        GAMMSE=SQRT(COV(2,2))
      ELSE
        GAMMSE=0.0
      ENDIF
      IF(COV(2,1).GE.0.0)THEN
        COVSE=SQRT(COV(2,1))
      ELSE
        COVSE=0.0
      ENDIF
C
      GABCSE=GAMMSE/BN
      COBCSE=COVSE/SQRT(BN)
C
C  CONFIDENCE INTERVALS FOR PARAMETERS.  CAN BASE ON EITHER NORMAL
C  APPROXIMATION OR ON LIKELIHOOD RATIO APPROXIMATION.
C
C  NORMAL APPROXIMATION FIRST.
C
      DO3310I=1,NUMALP
        ALP=ALPHA(I)
        P=1.0-(ALP/2.0)
        CALL NORPPF(P,PPF)
        IF(IWEIBC.EQ.'ON')THEN
          ALOWSC(I)=SCALE - PPF*SCALSE
          AUPPSC(I)=SCALE + PPF*SCALSE
          ALOWGA(I)=GAMMBC - PPF*GABCSE
          AUPPGA(I)=GAMMBC + PPF*GABCSE
        ELSE
          ALOWSC(I)=SCALE - PPF*SCALSE
          AUPPSC(I)=SCALE + PPF*SCALSE
          ALOWGA(I)=GAMMA - PPF*GAMMSE
          AUPPGA(I)=GAMMA + PPF*GAMMSE
        ENDIF
 3310 CONTINUE
C
C  NOW DO LIKELIHOOD RATIO APPROXIMATION.
C
C  THIS NEEDS A LITTLE MORE DEBUGGING.
C
CCCCC IN2=N
CCCCC IN3=N
CCCCC DN=DBLE(N)
CCCCC AE=1.D-7
CCCCC RE=1.D-7
CCCCC NUTEMP=1
C
CCCCC DN=DBLE(N)
CCCCC DR=DBLE(IR)
CCCCC DG=DBLE(GAMMA)
CCCCC DS=DBLE(SCALE)
CCCCC DT1=DN*DLOG(DBLE(GAMMA)) - DN*DG*DLOG(DS)
CCCCC DSUM1=0.0D0
CCCCC DSUM2=0.0D0
CCCCC DO3325I=1,N
CCCCC   DTEMP(I)=DBLE(Y(I))
CCCCC   IF(TAG(I).EQ.1.0)DSUM1=DSUM1 + DLOG(DBLE(Y(I)))
CCCCC   DSUM2=DSUM2 + DBLE(Y(I))**DG
C3325 CONTINUE
CCCCC DTERM2=DSUM1
CCCCC DTERM1=2.0D0*(DT1 + (DG-1.0D0)*DTERM2 - DS**(-DG)*DSUM2)
CCCCC DTERM7=DTERM2
CCCCC DTERM6=DTERM1
CCCCC DGAMMA=DBLE(GAMMA)
C
CCCCC DO3340I=1,NUMALP
CCCCC   ALP=ALPHA(I)
CCCCC   CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
CCCCC   DK=DBLE(APPF)
CCCCC   DK2=DK
C
CCCCC   XSTART=DBLE(ALOWGA(I))
CCCCC   XLOW=XSTART/5.0D0
CCCCC   XUP=DBLE(GAMMA)
CCCCC   CALL DFZER2(WEIFU5,XLOW,XUP,XSTART,RE,AE,IFLAG,DTEMP)
CCCCC   ALOWG2(I)=REAL(XLOW)
C
CCCCC   XSTART=DBLE(AUPPGA(I))
CCCCC   XUP=XSTART*5.0D0
CCCCC   XLOW=DBLE(GAMMA)
CCCCC   CALL DFZER2(WEIFU5,XLOW,XUP,XSTART,RE,AE,IFLAG,DTEMP)
CCCCC   AUPPG2(I)=REAL(XLOW)
C
CCCCC   XSTART=DBLE(ALOWSC(I))
CCCCC   XLOW=XSTART/5.0D0
CCCCC   XUP=DBLE(SCALE)
CCCCC   CALL DFZER2(WEIFU6,XLOW,XUP,XSTART,RE,AE,IFLAG,DTEMP)
CCCCC   ALOWS2(I)=REAL(XLOW)
C
CCCCC   XSTART=DBLE(AUPPSC(I))
CCCCC   XUP=XSTART*5.0D0
CCCCC   XLOW=DBLE(SCALE)
CCCCC   CALL DFZER2(WEIFU6,XLOW,XUP,XSTART,RE,AE,IFLAG,DTEMP)
CCCCC   AUPPS2(I)=REAL(XLOW)
C3340 CONTINUE
C
C  CONFIDENCE INTERVALS FOR SELECTED PERCENTILES.
C
C  1. STANDARD ERROR USES TECHNIQUE DEMONSTRATED IN EXAMPLE 17.4
C     (P. 344) OF BURY.  THIS IS BASED ON PROPOGATION OF ERROR.
C 
C  2. CONFIDENCE INTERVAL IS THEN GENERATED USING NORMAL
C     APPROXIMATION (EXAMPLE 17.7 OF BURY).  BURY ALSO DEMONSTRATES
C     A LIKELIHOOD RATIO APPROACH, BUT OMIT THIS FOR NOW.
C
      IF(NPERC.GE.1)THEN
C
        ALPHL=ALPHAP/2.0
        ALPHU=1.0 - ALPHAP/2.0
        CALL NORPPF(ALPHU,Z95)
        MINMAX=1
C
        IF(IWEIBC.EQ.'ON')THEN
          G=GAMMBC
          GSE=GABCSE
          COVZ=COBCSE
        ELSE
          G=GAMMA
          GSE=GAMMSE
          COVZ=COVSE
        ENDIF
C
        WRITE(IOUNI1,3431)
        WRITE(IOUNI1,3432)
        DO3429I=1,NPERC
          QPTEMP=QP(I)/100.0
          CALL WEIPPF(QPTEMP,G,MINMAX,APPF)
          XQPHAT(I)=SCALE*APPF
C
          C=LOG(1.0/(1.0 - QPTEMP))
          DA=C**(1.0/G)
          DB=-(SCALE*C**(1.0/G)*LOG(C)/(G**2))
          TERM1=(DA*SCALSE)**2
          TERM2=(DB*GSE)**2
          TERM3=2.0*DA*DB*COVZ*COVZ
          SEXQP=SQRT(TERM1 + TERM2 + TERM3)
          XQPSE(I)=SEXQP
          XQPLCL(I)=XQPHAT(I) - Z95*SEXQP
          XQPUCL(I)=XQPHAT(I) + Z95*SEXQP
          WRITE(IOUNI1,'(5E15.7)')
     1         QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),XQPUCL(I)
 3429   CONTINUE
 3431   FORMAT(15X,'       POINT     ','     LOWER     ',
     1         '     UPPER')
 3432   FORMAT('    PERCENTILE ','     ESTIMATE   ',
     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
      ENDIF
C
 3499 CONTINUE
C
C               *************************************
C               **   STEP 42--                     **
C               **   WRITE OUT EVERYTHING          **
C               **   FOR WEIBULL MLE ESTIMATE      **
C               *************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW2')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5002   FORMAT('<B>WEIBULL PARAMETER ESTIMATION:')
 5003   FORMAT('<B>INVERTED WEIBULL PARAMETER ESTIMATION:')
 5004   FORMAT('<BR>TIME CENSORED CASE</B>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(IWEIFL.EQ.'IWEI')THEN
          WRITE(ICOUT,5003)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,5002)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Two-Parameter Model (Location = 0)</BR>')
 5018   FORMAT('      Time Censored Case</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5018)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=350>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5060   FORMAT('         Summary Statistics:')
55060   FORMAT('         Maximum Likelihood Estimates:')
 5061   FORMAT('         Number of Observations:')
55061   FORMAT('         Number of Failures:')
 5062   FORMAT('         Sample Minimum:')
55062   FORMAT('         Sample Maximum:')
 5063   FORMAT('         Sample Mean:')
 5064   FORMAT('         Sample Standard Deviation:')
 5065   FORMAT('         Estimate of Scale Parameter:')
 5066   FORMAT('         Standard Error of Scale Parameter:')
 5067   FORMAT('         Estimate of Shape Parameter:')
 5068   FORMAT('         Standard Error of Shape Parameter:')
55067   FORMAT('         Estimate of Bias Corrected Shape Parameter:')
55068   FORMAT('         Standard Error of Bias Corrected Shape ',
     1         'Parameter:')
 5069   FORMAT('         Standard Error of Covariance of Scale and ',
     1         'Shape Parameter:')
55069   FORMAT('         Standard Error of Bias Corrected Covariance ',
     1         'of Scale and Shape Parameter:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)IR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        IF(IWEIFL.NE.'IWEI')THEN
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5066)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)SCALSE
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5055)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5055)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)GAMMA
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        IF(IWEIFL.NE.'IWEI')THEN
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5068)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)GAMMSE
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,55067)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)GAMMBC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,55068)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)GABCSE
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5055)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5055)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5069)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)COVSE
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,55069)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5051)COBCSE
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5059)
          CALL DPWRST('XXX','WRIT')
C
        ENDIF
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(IWEIFL.EQ.'IWEI')GOTO5499
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
 5115   FORMAT('   <CAPTION ALIGN=CENTER>')
 5117   FORMAT('      <B>Confidence Limits for the Shape ',
     1         'Parameter</B><BR>')
 5118   FORMAT('      <B>(Based on Biased Estimate)</B>')
55118   FORMAT('      <B>(Based on Bias Corrected Estimate)</B>')
 5119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        IF(IWEIBC.EQ.'ON')THEN
          WRITE(ICOUT,55118)
        ELSE
          WRITE(ICOUT,5118)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5125   FORMAT('         Confidence<br>Value (%)')
 5127   FORMAT('      </TH>')
 5129   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5131   FORMAT('         Lower<br>Limit')
 5133   FORMAT('         Upper<br>Limit')
 5134   FORMAT('         &nbsp;')
 5136   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM COLSPAN=2>')
 5137   FORMAT('         Normal Approximation')
 5138   FORMAT('         Likelihood Ratio')
 5139   FORMAT('   </TR>')
C5161   FORMAT('      <TD COLSPAN=5>')
 5161   FORMAT('      <TD COLSPAN=3>')
 5162   FORMAT('          <HR>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5136)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5138)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5127)
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5129)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5131)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5127)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5129)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5133)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5127)
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5147   FORMAT('      </TD>')
 5149   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   </TR>')
        DO5140I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWGA(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPGA(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5149)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5151)ALOWG2(I)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5147)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5149)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5151)AUPPG2(I)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5147)
CCCCC     CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5140   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5217   FORMAT('      <B>Confidence Limits for the Scale ',
     1         'Parameter</B>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5217)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5136)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5138)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5127)
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5129)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5131)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5127)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5129)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5133)
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5127)
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
        DO5240I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWSC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AUPPSC(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5149)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5151)ALOWS2(I)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5147)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5149)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5151)AUPPS2(I)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5147)
CCCCC     CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5240   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  START THE TABLE FOR PERCENTILE CONFIDENCE INTERVALS
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,999)
          WRITE(ICOUT,5811)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5813)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5815)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5817)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5816)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5819)
          CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5861)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,55862)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5863)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5849)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5864)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5848)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5841)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5870)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5872)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5847)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5859)
          CALL DPWRST('XXX','WRIT')
C
          DO55880I=1,NPERC
            WRITE(ICOUT,5841)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)QP(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPHAT(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPSE(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPLCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5843)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5851)XQPUCL(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5847)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5859)
            CALL DPWRST('XXX','WRIT')
55880     CONTINUE
C
C  END THE TABLE AND RESET ASIS MODE
C
          WRITE(ICOUT,5191)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5193)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
 5499   CONTINUE
C
        WRITE(ICOUT,5801)
        CALL DPWRST('XXX','WRIT')
C
 5801     FORMAT('<PRE>')
 5811     FORMAT('<UL>')
 5813     FORMAT('<TABLE NOBORDER>')
 5815     FORMAT('   <CAPTION ALIGN=CENTER>')
 5816     FORMAT('      <BR><B>Alpha = ',F7.3,'</B>')
 5817     FORMAT('      <B>Confidence Limits (Normal Approximation) ',
     1           'for Selected ',
     1           'Percentiles<br>(No Bias Correction Estimates)</B>')
 5818     FORMAT('      <B>Confidence Limits (Normal Approximation)',
     1           ' for Selected ',
     1           'Percentiles<br>(Bias Corrected Estimates)</B>')
 5819     FORMAT('   </CAPTION>')
 5841     FORMAT('   <TR>')
 5843     FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5847     FORMAT('      </TD>')
 5848     FORMAT('      </TH>')
 5849     FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=120>')
 5851     FORMAT('         ',G15.7)
 5859     FORMAT('   </TR>')
 5861     FORMAT('         Percentile')
 5862     FORMAT('         Point <br> Estimate')
55862     FORMAT('         Standard <br> Error')
 5863     FORMAT('         Lower <br>Confidence Limit')
 5864     FORMAT('         Upper <br>Confidence Limit')
 5870     FORMAT('      <TD COLSPAN=5>')
 5872     FORMAT('         <HR WIDTH=600>')
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001   FORMAT(A1,'end{verbatim}')
 8003   FORMAT(A1,'begin{table}')
 8004   FORMAT(A1,'end{table}')
 8005   FORMAT('{',A1,'bf Weibull Parameter ',
     1         'Estimation: Time Censored Case}')
 8006   FORMAT('{',A1,'bf Inverted Weibull Parameter ',
     1         'Estimation: Time Censored Case}')
 8007   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009   FORMAT(A1,'begin{center}')
 8011   FORMAT(5X,'{',A1,'bf Two-Parameter Model ($',A1,
     1         'mu$ = 0 Case)}')
 8013   FORMAT(A1,'end{center}')
 8015   FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(IWEIFL.EQ.'IWEI')THEN
          WRITE(ICOUT,8006)IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8005)IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020   FORMAT(5X,A1,'begin{tabular} {lr}')
 8021   FORMAT(5X,'Summary Statistics: & ',2X,A1,A1)
 8022   FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8023   FORMAT(5X,'Number of Failures: & ',I8,2X,A1,A1)
 8024   FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8025   FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8026   FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8027   FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8028   FORMAT(5X,'  & ',2X,A1,A1)
 8029   FORMAT(5X,'Maximum Likelihood Estimates: & ',2X,A1,A1)
 8030   FORMAT(5X,'Estimate of Scale Parameter: & ',G15.7,2X,A1,A1)
 8031   FORMAT(5X,'Standard Error of Scale Parameter: & ',
     1         G15.7,2X,A1,A1)
 8032   FORMAT(5X,'Estimate of Shape Parameter: & ',G15.7,2X,A1,A1)
 8033   FORMAT(5X,'Standard Error of Shape Parameter: & ',
     1         G15.7,2X,A1,A1)
 8034   FORMAT(5X,'Estimate of Bias Corrected Shape Parameter: & ',
     1         G15.7,2X,A1,A1)
 8035   FORMAT(5X,'Standard Error of Bias Corrected Shape ',
     1         'Parameter: & ',G15.7,2X,A1,A1)
 8036   FORMAT(5X,'Standard Error of Covariance of Scale and Shape ',
     1         'Parameter: & ',G15.7,2X,A1,A1)
 8037   FORMAT(5X,'Standard Error of Bias Corrected Covariance of ',
     1         'Scale and Shape  Parameter: & ',G15.7,2X,A1,A1)
 8049   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)IR,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)XMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)XMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8029)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)SCALE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IWEIFL.NE.'IWEI')THEN
          WRITE(ICOUT,8031)SCALSE,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8028)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8032)GAMMA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IWEIFL.NE.'IWEI')THEN
          WRITE(ICOUT,8033)GAMMSE,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8034)GAMMBC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8028)GABCSE,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8035)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8036)COVSE,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8037)COBCSE,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8093   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(IWEIFL.EQ.'IWEI')GOTO8499
C
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8109 FORMAT(A1,'begin{center}')
 8111 FORMAT(5X,'{',A1,'bf Confidence Limits for Shape Parameter ',
     1       '(Based on No Bias Correction Estimate)}')
 8112 FORMAT(5X,'{',A1,'bf Confidence Limits for Shape Parameter ',
     1       '(Based on Bias Corrected Estimate)}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IWEIBC.EQ.'ON')THEN
          WRITE(ICOUT,8112)IBASLC
        ELSE
          WRITE(ICOUT,8111)IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120   FORMAT(5X,A1,'begin{tabular} {ccc}')
 8121   FORMAT(5X,'Confidence & Lower & Upper ',2X,A1,A1)
 8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit',2X,A1,A1)
 8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,2X,A1,A1)
C8120   FORMAT(5X,A1,'begin{tabular} {ccccc}')
C8121   FORMAT(5X,'Confidence & Lower & Upper & Lower & Upper ',
CCCCC1         2X,A1,A1)
C8122   FORMAT(5X,'Value (',A1,'%) & Limit & Limit & Limit & Limit',
CCCCC1         2X,A1,A1)
C8131   FORMAT(5X,F8.3,' & ',G15.7,' & ',G15.7,' & ',G15.7,' & ',
CCCCC1         G15.7,2X,A1,A1)
 8126   FORMAT(5X,'& ',A1,'multicolumn{2}{c}{Normal Approximation}',
CCCCC1         ' & ',A1,'multicolumn{2}{c}{Likelihood Ratio}',
     1         2X,A1,A1)
 8140   FORMAT(5X,A1,'hline')
 8149   FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8126)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8130I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
CCCCC     WRITE(ICOUT,8131)ATEMP,ALOWGA(I),AUPPGA(I),ALOWG2(I),
CCCCC1                     AUPPG2(I),IBASLC,IBASLC
          WRITE(ICOUT,8131)ATEMP,ALOWGA(I),AUPPGA(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8130   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8191   FORMAT(A1,'end{table}')
 8193   FORMAT(A1,'end{center}')
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8211 FORMAT(5X,'{',A1,'bf Confidence Limits for Scale Parameter}')
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8211)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8126)IBASLC,IBASLC,IBASLC,IBASLC
        WRITE(ICOUT,8126)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8230I=1,NUMALP
          ATEMP=100.0*(1.0-ALPHA(I))
CCCCC     WRITE(ICOUT,8131)ATEMP,ALOWSC(I),AUPPSC(I),ALOWS2(I),
CCCCC1                     AUPPS2(I),IBASLC,IBASLC
          WRITE(ICOUT,8131)ATEMP,ALOWSC(I),AUPPSC(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8230   CONTINUE
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8191)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C WRITE SELECTED PERCENTILES (IF ANY)
C
        IF(NPERC.GT.0)THEN
C
          CALL DPCONA(92,IBASLC)
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8803)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8810)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          IF(IWEIBC.EQ.'ON')THEN
            WRITE(ICOUT,88811)IBASLC
          ELSE
            WRITE(ICOUT,8811)IBASLC
          ENDIF
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8812)IBASLC,IBASLC,ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8807)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8813)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8809)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8820)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8821)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8822)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,
     1                     IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8840)IBASLC
          CALL DPWRST('XXX','WRIT')
          DO8830I=1,NPERC
            WRITE(ICOUT,8823)QP(I),XQPHAT(I),XQPSE(I),XQPLCL(I),
     1                       XQPUCL(I),IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
 8830     CONTINUE
          WRITE(ICOUT,8849)IBASLC
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,8891)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8893)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
 8801   FORMAT(A1,'end{verbatim}')
 8803   FORMAT(A1,'begin{table}')
 8807   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8809   FORMAT(A1,'begin{center}')
 8810   FORMAT(5X,'{',A1,'bf Confidence Limits (Normal Approximation)',
     1         ' for Selected Percentiles}')
 8811   FORMAT(5X,'{',A1,'bf (Based on No Bias Correction Estimates):}')
88811   FORMAT(5X,'{',A1,'bf (Based on Bias Corrected Estimates):}')
 8812   FORMAT(5X,'{',A1,'bf $',A1,'alpha$ = ',F7.3,'}')
 8813   FORMAT(A1,'end{center}')
 8815   FORMAT(5X,'} ',A1,A1)
 8820   FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8821   FORMAT(5X,' & {',A1,'bf Point} & {',A1,'bf Standard} & {',
     1         A1,'bf Lower} & {',A1,'bf Upper}',2X,A1,A1)
 8822   FORMAT(5X,'{',A1,'bf Percentile} & {',A1,'bf Estimate} & {',
     1         A1,'bf Error} & {',A1,'bf Confidence Limit} & {',
     1         A1,'bf Confidence Limit}',
     1         2X,A1,A1)
 8823   FORMAT(5X,G15.7,' & ',G15.7,' & ',G15.7,' & ',G15.7,
     1         ' & ',G15.7,2X,A1,A1)
 8840   FORMAT(5X,A1,'hline')
 8849   FORMAT(A1,'end{tabular}')
 8891   FORMAT(A1,'end{center}')
 8893   FORMAT(A1,'end{table}')
C
 8499   CONTINUE
C
 8899   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8899)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(IWEIFL.EQ.'IWEI')THEN
          WRITE(ICOUT,4201)
 4201     FORMAT(6X,'INVERTED WEIBULL PARAMETER ',
     1           'ESTIMATION: CENSORED CASE')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4203)
 4203     FORMAT(6X,'WEIBULL PARAMETER ESTIMATION: CENSORED CASE')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,4209)
 4209   FORMAT(12X,'TWO-PARAMETER MODEL (LOCATION = 0)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4211)
 4211   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4213)N
 4213   FORMAT('NUMBER OF OBSERVATIONS                            = ',
     1         I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4215)XMEAN
 4215   FORMAT('SAMPLE MEAN                                       = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4217)XSD
 4217   FORMAT('SAMPLE STANDARD DEVIATION                         = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4218)XMIN
 4218   FORMAT('SAMPLE MINIMUM                                    = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4219)XMAX
 4219   FORMAT('SAMPLE MAXIMUM                                    = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(IWEIFL.EQ.'IWEI')GOTO4400
C
        WRITE(ICOUT,4221)
 4221   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)SCALE
 4223   FORMAT('ESTIMATE OF SCALE PARAMETER                       = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)SCALSE
 4225   FORMAT('STANDARD ERROR OF SCALE PARAMETER                 = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4227)GAMMA
 4227   FORMAT('ESTIMATE OF SHAPE PARAMETER                       = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4231)GAMMSE
 4231   FORMAT('STANDARD ERROR OF SHAPE PARAMETER                 = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4229)GAMMBC
 4229   FORMAT('BIAS CORRECTED ESTIMATE OF SHAPE PARAMETER        = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4232)GABCSE
 4232   FORMAT('STANDARD ERROR OF BIAS CORRECTED SHAPE PARAMETER  = ',
     1        G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4233)COVSE
 4233   FORMAT('STANDARD ERROR OF SHAPE/SCALE COVARIANCE          = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4234)COBCSE
 4234   FORMAT('STD ERR OF BIAS CORRECTED SHAPE/SCALE COVARIANCE  = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4240)
 4240   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)
C4242   FORMAT('                       NORMAL APPROXIMATION',
CCCCC1         '            LIKELIHOOD RATIO')
 4242   FORMAT('                       NORMAL APPROXIMATION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)
C4243   FORMAT('   CONFIDENCE           LOWER         UPPER',
CCCCC1         '         LOWER         UPPER')
 4243   FORMAT('   CONFIDENCE           LOWER         UPPER')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)
C4245   FORMAT('   VALUE (%)            LIMIT         LIMIT',
CCCCC1         '         LIMIT         LIMIT')
 4245   FORMAT('   VALUE (%)            LIMIT         LIMIT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4246)
C4246   FORMAT('---------------------------------------------------',
CCCCC1         '--------------------')
 4246   FORMAT('---------------------------------------------')
        CALL DPWRST('XXX','WRIT')
        DO4249I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
CCCCC     WRITE(ICOUT,4247)ATEMP,ALOWSC(I),AUPPSC(I),ALOWS2(I),
CCCCC1                     AUPPS2(I)
          WRITE(ICOUT,4247)ATEMP,ALOWSC(I),AUPPSC(I)
 4247     FORMAT('   ',F8.3,10X,4(G12.6,2X))
          CALL DPWRST('XXX','WRIT')
 4249   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4252)
 4252   FORMAT('CONFIDENCE INTERVAL FOR SHAPE PARAMETER')
        CALL DPWRST('XXX','WRIT')
        IF(IWEIBC.EQ.'ON')THEN
          WRITE(ICOUT,4254)
 4254     FORMAT('(BASED ON BIAS CORRECTED ESTIMATES)')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4256)
 4256     FORMAT('(BASED ON NO BIAS CORRECTION ESTIMATES)')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4246)
        CALL DPWRST('XXX','WRIT')
        DO4259I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
CCCCC     WRITE(ICOUT,4247)ATEMP,ALOWGA(I),AUPPGA(I),ALOWG2(I),
CCCCC1                     AUPPG2(I)
          WRITE(ICOUT,4247)ATEMP,ALOWGA(I),AUPPGA(I)
          CALL DPWRST('XXX','WRIT')
 4259   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
          WRITE(ICOUT,4911)
          CALL DPWRST('XXX','WRIT')
          IF(IWEIBC.EQ.'ON')THEN
            WRITE(ICOUT,4913)
          ELSE
            WRITE(ICOUT,4914)
          ENDIF
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4915)ALPHAP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4921)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4922)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4346)
          CALL DPWRST('XXX','WRIT')
C
 4911   FORMAT('CONFIDENCE LIMITS (NORMAL APPROXIMATION) FOR ',
     1         'SELECTED PERCENTILES:')
 4913   FORMAT('(BASED ON BIAS CORRECTED ESTIMATES)')
 4914   FORMAT('(BASED ON NO BIAS CORRECTION ESTIMATES)')
 4915   FORMAT('ALPHA = ',F7.4)
 4921   FORMAT(10X,'      POINT     ','  STANDARD   ',
     1             '        LOWER     ', '       UPPER')
 4922   FORMAT('PERCENTILE','   ESTIMATE   ','      ERROR     ',
     1         'CONFIDENCE LIMIT ',' CONFIDENCE LIMIT')
 4346   FORMAT('-----------------------------------',
     1         '-----------------------------------')
C
          DO4981I=1,NPERC
            WRITE(ICOUT,4932)QP(I),XQPHAT(I),XQPSE(I),
     1                       XQPLCL(I),XQPUCL(I)
 4932       FORMAT(2X,F8.4,2G15.7,2X,G15.7,2X,G15.7)
            CALL DPWRST('XXX','WRIT')
 4981     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        GOTO4499
C
 4400   CONTINUE
        WRITE(ICOUT,4221)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)SCALE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4227)GAMMA
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
 4499   CONTINUE
C
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,4291)
 4291     FORMAT('THE FOLLOWING INTERNAL PARAMETERS ARE SAVED:')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4293)
 4293     FORMAT('      ALPHAML, ALPHASE, GAMMAML, GAMMASE, ',
     1           'CAMMABC, GAMMABCSE,COVSE,COVBCSE')
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IF(IFEEDB.EQ.'ON')THEN
          IF(NPERC.GT.0)THEN
            WRITE(ICOUT,4943)
 4943       FORMAT('PERCENTILE CONFIDENCE LIMITS  WRITTEN TO ',
     1             'FILE  dpst1f.dat')
            CALL DPWRST('XXX','BUG ')
          ENDIF
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLW2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLW2--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLWA(Y,N,
     1DTEMP1,XTEMP2,YTEMP2,TEMP3,MAXNXT,
     1AMOM,AFREQ,AML,CMOM,CFREQ,CML,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE METHOD OF MOMENTS
C              ESTIMATE FOR WARING DISTRIBUTION.  USE THE FORMULA
C                 U1 = 1/(P-1)
C              WHICH GIVES
C                 P = (1+U1)/U1
C              REPLACE POPULATION MEAN, U1, WITH SAMPLE ESTIMATE,
C              XBAR.  NOTE THAT MEAN IS UNDEFINED FOR P < 1.
C              LARGE VALUES OF THE MEAN INDICATE A VALUE OF P
C              LESS THAN 1, IN WHICH CASE ESTIMATE OF P IS NOT
C              VALID.
C     EXAMPLE--WARING MOMENTS Y
C     REFERENCE--"UNIVARIATE DISCRETE DISTRIBUTIONS", SECOND EDITION,
C                JOHNSON, KOTZ, AND KEMP, WILEY, PP. 276.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/4
C     ORIGINAL VERSION--APRIL     2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IRELAT
      CHARACTER*4 IRHSTG
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*1 IBASLC
C
C---------------------------------------------------------------------
C
      REAL Y(*)
      REAL XTEMP2(*)
      REAL YTEMP2(*)
      REAL TEMP3(*)
      DOUBLE PRECISION DTEMP1(*)
C
      DOUBLE PRECISION FVEC(2)
      DOUBLE PRECISION XPAR(2)
      DOUBLE PRECISION TOL
C
      EXTERNAL WARFU2
      COMMON/WARCOM/NTOT
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='DPML'
      ISUBN2='WA  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLWA')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLWA--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
       ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLWA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN WARING PARAMETER ESTIMATION--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS NON-POSITIVE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** WARNING FROM WARING PARAMETER ESTIMATION--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
C               ******************************
C               **  STEP 41--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR WARING MLE ESTIMATE **
C               ******************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLWA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
C
      DO4105I=1,N
        ITEMP=INT(Y(I)+0.5)
        Y(I)=REAL(ITEMP)
 4105 CONTINUE
      IERROR='NO'
      IWRITE='OFF'
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
      IF(XMIN.LT.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4111)
 4111   FORMAT('***** ERROR FROM WARING PARAMETER ESTIMATION--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4113)
 4113   FORMAT('      NEGATIVE VALUE ENCOUNTERED.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL VAR(Y,N,IWRITE,XVAR,IBUGA3,IERROR)
C
C  COMPUTE MOMENT ESTIMATORS.
C  FROM IRWIN, "MATHEMATICS IN MEDICAL AND BIOLOGICAL
C  STATISTICS", JOURNAL OF THE ROYAL STATISTICAL SOCIETY, A,
C  1963, 126, PP. 1-44.  THE FORMULAS ARE:
C
C    CHAT = XBAR[XVAR + XBAR*(XBAR+1)]/[XVAR - XBAR*(XBAR+1)]
C    AHAT = [XVAR*(XBAR+2) + (XBAR+1)*XBAR**2]/[XVAR-XBAR*(XBAR+1)]
C
      TERM1=XMEAN*(XMEAN+1.0)
      CMOM=XMEAN*(XVAR+TERM1)/(XVAR-TERM1)
      TERM2=XVAR*(XMEAN+2.0) + (XMEAN+1.0)*XMEAN**2
      AMOM=TERM2/(XVAR-TERM1)
C
C  COMPUTE ESTIMATE BASED ON SAMPLE MEAN AND FIRST OBSERVED
C  FREQUENCY.  FROM IRWIN, "MATHEMATICS IN MEDICAL AND BIOLOGICAL
C  STATISTICS", JOURNAL OF THE ROYAL STATISTICAL SOCIETY, A,
C  1963, 126, PP. 1-44.  THE FORMULA IS:
C
C    CHAT = 1/((1/Q1) - (1/XBAR) - 1)
C    AHAT = (1Q1)/((1/Q1) - (1/XBAR) - 1)
C
C  WITH f1 = FIRST OBSERVED FREQUENCY AND Q1=1-F1.  CALL DPBINI TO
C  CREATE f1 VALUES.
C
      IRELAT='OFF'
      IRHSTG='OFF'
      XSTART=XMIN-0.5
      XSTOP=XMAX+0.5
      CLWID=1.0
      CALL DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
     1            YTEMP2,XTEMP2,N2,IBUGA3,IERROR)
      ICNT=0
      DO101I=1,N2
        IF(YTEMP2(I).GT.0)THEN
          ICNT=ICNT+1
          YTEMP2(ICNT)=YTEMP2(I)
          XTEMP2(ICNT)=XTEMP2(I)
        ENDIF
 101  CONTINUE
      N2=ICNT
      IF(IERROR.EQ.'YES')GOTO9000
      F1=YTEMP2(1)/REAL(N)
      Q1=1.0 - F1
      TERM1=1.0/XMEAN
      TERM2=1.0/Q1
      CFREQ=1.0/(TERM2 - TERM1 - 1.0)
      AFREQ=TERM2/(TERM2 - TERM1 - 1.0)
C
C  NOW COMPUTE MAXIMUM LIKELIHOOD ESTIMATE
C
      N22=2*N2
      IF(N22.GT.MAXNXT)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,106)
  106   FORMAT('***** WARNING FROM WARING MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,108)MAXNXT/2
  108   FORMAT('      NUMBER OF FREQUENCY CLASSES EXCEEDED ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,109)
  109   FORMAT('      MAXIMUM LIKELIHOOD ESTIMATION NOT PERFORMED.')
        CALL DPWRST('XXX','BUG ')
        CML=0.0
        AML=0.0
      ELSE
        TEMP3(N22)=YTEMP2(N2)
        IF(N2.GT.1)THEN
          DO110I=N2-1,1,-1
            TEMP3(N2+I)=YTEMP2(I)+TEMP3(N2+I+1)
  110     CONTINUE
        ENDIF
        DO120I=1,N2
          TEMP3(I)=XTEMP2(I)
  120   CONTINUE
        XPAR(1)=DBLE(CFREQ)
        XPAR(2)=DBLE(AFREQ)
        NTOT=N
        NCLASS=N2
        IOPT=2
        TOL=1.0D-6
        NVAR=2
        NPRINT=-1
        INFO=0
        LWA=MAXNXT
        CALL DNSQE(WARFU2,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1           DTEMP1,LWA,TEMP3,NCLASS)
C
        CML=REAL(XPAR(1))
        AML=REAL(XPAR(2))
C
      ENDIF
C
C
C               *********************************
C               **   STEP 42--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR WARING MLE ESTIMATE   **
C               *********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLWA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Waring  Parameter Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=250>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Mean:')
 5063   FORMAT('         Sample Standard Deviation:')
 5064   FORMAT('         Method of Moments Estimate of <i>C</i> ')
 5065   FORMAT('         Method of Moments Estimate of <i>A</i> ')
 5066   FORMAT('         Method of First Frequency Estimate of ',
     1         '<i>C</i> ')
 5067   FORMAT('         Method of First Frequency Estimate of ',
     1         '<i>A</i> ')
 5068   FORMAT('         Maximum Likelihood Estimate of <i>C</i> ')
 5069   FORMAT('         Maximum Likelihood Estimate of <i>A</i> ')
 5071   FORMAT('         Sample First Frequency:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)F1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CMOM
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMOM
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CFREQ
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AFREQ
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Yule Parameter Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Method of Moments Estimate of $C$: & ',
     1       G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Method of Moments Estimate of $A$: & ',
     1       G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Method of First Frequency Estimate of $C$: & ',
     1       G15.7,2X,A1,A1)
 8027 FORMAT(5X,'Method of First Frequency Estimate of $A$: & ',
     1       G15.7,2X,A1,A1)
 8028 FORMAT(5X,'Maximum Likelihood Estimate of $C$: & ',
     1       G15.7,2X,A1,A1)
 8029 FORMAT(5X,'Maximum Likelihood Estimate of $A$: & ',
     1       G15.7,2X,A1,A1)
 8031 FORMAT(5X,'Sample First Frequency: & ',G15.7,2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)F1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)CMOM,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)AMOM,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)CFREQ,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)AFREQ,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)CML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)AML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{center}')
 8093 FORMAT(A1,'end{table}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4301)
 4301   FORMAT('WARING PARAMETER ESTIMATION:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4311)N
 4311   FORMAT(6X,'NUMBER OF OBSERVATIONS                   = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4313)XMEAN
 4313   FORMAT(6X,'SAMPLE MEAN                              = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4315)XSD
 4315   FORMAT(6X,'SAMPLE STANDARD DEVIATION                = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4316)F1
 4316   FORMAT(6X,'SAMPLE FIRST FREQUENCY                   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4317)CMOM
 4317   FORMAT(6X,'METHOD OF MOMENTS ESTIMATE OF C          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4318)AMOM
 4318   FORMAT(6X,'METHOD OF MOMENTS ESTIMATE OF A          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4319)CFREQ
 4319   FORMAT(6X,'METHOD OF FIRST FREQUENCY ESTIMATE OF C  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4320)AFREQ
 4320   FORMAT(6X,'METHOD OF FIRST FREQUENCY ESTIMATE OF A  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4321)CML
 4321   FORMAT(6X,'MAXIMUM LIKELIHOOD ESTIMATE OF C         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4322)AML
 4322   FORMAT(6X,'MAXIMUM LIKELIHOOD ESTIMATE OF A         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4341)
 4341   FORMAT('PMOM AND PFREQ WILL BE SAVED AS INTERNAL PARAMETERS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLWA')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLWA--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMLWC(Y,TAG,N,
     1XTEMP,MAXNXT,
     1GAMMA,ALPHA,NUMV,ICENTY,TEND,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR CENSORED WEIBULL DISTRIBUTION
C              IT ONLY SUPPORTS TYPE 2 CENSORING
C     EXAMPLE--WEIBULL MAXIMUM LIKELIHOOD Y TAG
C     REFERENCE--XX
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/6
C     ORIGINAL VERSION--JUNE      1998.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICENTY
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION TAG(*)
      DIMENSION XTEMP(*)
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='DPML'
      ISUBN2='WC  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLWC')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPMLWC--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,55)N
   55 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,MIN(N,100)
      WRITE(ICOUT,57)I,Y(I),TAG(I)
   57 FORMAT('I,Y(I),TAG(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
      WRITE(ICOUT,58)NUMV
   58 FORMAT('NUMV = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,59)ICENTY
   59 FORMAT('ICENTY = ',A4)
      CALL DPWRST('XXX','WRIT')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPMLWC--THE NUMBER OF OBSERVATIONS ',
     1'FOR VARIABLE 1 IS NON-POSITIVE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1112)N
 1112 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(N.EQ.1)GOTO1120
      GOTO1129
 1120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** NOTE FROM DPMLWC--VARIABLE 1 ',
     1'HAS ONLY 1 ELEMENT')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1129 CONTINUE
C
      HOLD=Y(1)
      DO1135I=2,N
      IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM DPMLWC--VARIABLE 1 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
 1290 CONTINUE
C
C               **********************************
C               **  STEP 51--                   **
C               **  CARRY OUT CALCULATIONS      **
C               **  FOR WEIBULL MLE             **
C               **  ESTIMATE (CENSORED CASE)    **
C               **  TYPE II CENSORING           **
C               **********************************
C
 5100 CONTINUE
C
      ISTEPN='43'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMV.EQ.2.AND.(ICENTY.EQ.'2   '.OR.ICENTY.EQ.'1   '))THEN
        IERROR='NO'
        IWRITE='OFF'
C
        CALL SORTC(Y,TAG,N,Y,TAG)
        IR=0
        DO5105I=1,N
          IF(ABS(TAG(I)).GE.0.5)THEN
            IR=IR+1
            XTEMP(IR)=Y(I)
          ENDIF
 5105   CONTINUE
        IF(IR.LT.2)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5109)
 5109   FORMAT(
     1         '****ERROR FROM DPMLWC: AFTER CENSORING, ONLY ',I3,
     1         ' OBSERVATIONS REMAIN.')
          IERROR='YES'
          GOTO9000
        ENDIF
        AR=REAL(IR)
C
        CALL WBLES2(XTEMP,N,IR,ALPHA,GAMMA,IERROR)
C
C               *********************************
C               **   STEP 52--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR WEIBULL MLE ESTIMATE  **
C               **********************************
C
        ISTEPN='52'
        IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        IF(IPRINT.EQ.'OFF')GOTO5290
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5211)
 5211   FORMAT(
     1'WEIBULL 2-PARAMETER MAXIMUM LIKELIHOOD ESTIMATE (CENSORED ',
     1'CASE):')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5242)N
 5242   FORMAT(6X,'NUMBER OF OBSERVATIONS            = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)IR
 5243   FORMAT(6X,'NUMBER OF UNCENSORED OBSERVATIONS = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5244)GAMMA
 5244   FORMAT(6X,'SHAPE PARAMETER GAMMA             = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5246)ALPHA
 5246   FORMAT(6X,'SCALE PARAMETER ALPHA             = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5278)
 5278   FORMAT(6X,'GAMMA AND ALPHA WILL BE SAVED AS INTERNAL ',
     1         'PARAMETERS.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 5290   CONTINUE
        GOTO9000
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MLWC')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMLWC--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMLYU(Y,N,
     1XTEMP2,YTEMP2,VTEMP,MAXNXT,
     1PMOM,PFREQ,PML,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE METHOD OF MOMENTS
C              ESTIMATE FOR YULE DISTRIBUTION.  USE THE FORMULA
C                 U1 = 1/(P-1)
C              WHICH GIVES
C                 P = (1+U1)/U1
C              REPLACE POPULATION MEAN, U1, WITH SAMPLE ESTIMATE,
C              XBAR.  NOTE THAT MEAN IS UNDEFINED FOR P < 1.
C              LARGE VALUES OF THE MEAN INDICATE A VALUE OF P
C              LESS THAN 1, IN WHICH CASE ESTIMATE OF P IS NOT
C              VALID.
C     EXAMPLE--YULE MOMENTS Y
C     REFERENCE--"UNIVARIATE DISCRETE DISTRIBUTIONS", SECOND EDITION,
C                JOHNSON, KOTZ, AND KEMP, WILEY, PP. 276.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/4
C     ORIGINAL VERSION--APRIL     2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IRELAT
      CHARACTER*4 IRHSTG
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*1 IBASLC
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP2(*)
      DIMENSION YTEMP2(*)
      DIMENSION VTEMP(*)
C
      REAL YULFU2
      EXTERNAL YULFU2
      COMMON/YULCOM/NTOT,NCLASS
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='DPML'
      ISUBN2='YU  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLYU')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMLYU--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
       ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLYU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN YULE METHOD OF MOMENTS ESTIMATION--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS NON-POSITIVE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** WARNING FROM YULE MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
C               ******************************
C               **  STEP 41--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR YULE MLE ESTIMATE   **
C               ******************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
C
      DO4105I=1,N
        ITEMP=INT(Y(I)+0.5)
        Y(I)=REAL(ITEMP)
 4105 CONTINUE
      IERROR='NO'
      IWRITE='OFF'
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
      IF(XMIN.LT.0.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4111)
 4111   FORMAT('***** ERROR FROM YULE METHOD OF MOMENTS ESTIMATION--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4113)
 4113   FORMAT('      NEGATIVE VALUE ENCOUNTERED.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      PMOM=(XMEAN+1.0)/XMEAN
C
C  COMPUTE ESTIMATE BASED ON SAMPLE MEAN AND FIRST OBSERVED
C  FREQUENCY.  FROM IRWIN, "MATHEMATICS IN MEDICAL AND BIOLOGICAL
C  STATISTICS", JOURNAL OF THE ROYAL STATISTICAL SOCIETY, A,
C  1963, 126, PP. 1-44.  THE FORMULA IS:
C
C    PHAT = (1/(1 - f1/N)/((1/(1-f1/N) - (1/XBAR) - 1)
C
C  WITH f1 = FIRST OBSERVED FREQUENCY.  CALL DPBINI TO CREATE f1
C  VALUES.
C
      IRELAT='OFF'
      IRHSTG='OFF'
      XSTART=XMIN-0.5
      XSTOP=XMAX+0.5
      CLWID=1.0
      CALL DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
     1            YTEMP2,XTEMP2,N2,IBUGA3,IERROR)
      ICNT=0
      DO101I=1,N2
        IF(YTEMP2(I).GT.0)THEN
          ICNT=ICNT+1
          YTEMP2(ICNT)=YTEMP2(i)
          XTEMP2(ICNT)=XTEMP2(i)
        ENDIF
 101  CONTINUE
      N2=ICNT
      IF(IERROR.EQ.'YES')GOTO9000
      F1=YTEMP2(1)/REAL(N)
      Q1=1.0 - F1
      PFREQ=(1.0/Q1)/((1.0/Q1) - (1.0/XMEAN) - 1.0) - 1.0
C
C  NOW COMPUTE MAXIMUM LIKELIHOOD ESTIMATE
C
      VTEMP(N2)=YTEMP2(N2)
      IF(N2.GT.1)THEN
        DO110I=N2-1,1,-1
          VTEMP(I)=YTEMP2(I)+VTEMP(I+1)
  110   CONTINUE
      ENDIF
      NTOT=N
      NCLASS=N2
      AE=1.E-6
      RE=1.E-6
      IFLAG=0
      XLOW=1.1
      XUP=20.0
      CALL FZEROY(YULFU2,XLOW,XUP,XUP,RE,AE,IFLAG,XTEMP2,VTEMP)
C
      PML=XLOW - 1.0
C
      IF(IFLAG.EQ.2)THEN
C
C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,111)
CC111   FORMAT('***** WARNING FROM YULE MAXIMUM LIKELIHOOD--')
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,113)
CC113   FORMAT('      ESTIMATE OF P 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 YULE MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,123)
  123   FORMAT('      ESTIMATE OF P 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 YULE MAXIMUM LIKELIHOOD--')
        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 YULE MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,143)
  143   FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C
C               *********************************
C               **   STEP 42--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR YULE MLE ESTIMATE     **
C               **********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLYU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5001   FORMAT('</PRE>')
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>YULE  Parameter Estimation</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=250>')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('         &nbsp;')
 5059   FORMAT('   </TR>')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Mean:')
 5063   FORMAT('         Sample Standard Deviation:')
 5064   FORMAT('         Method of Moments Estimate of <i>P</i> ')
 5065   FORMAT('         Method of First Frequency Estimate of ',
     1         '<i>P</i> ')
 5066   FORMAT('         Maximum Likelihood Estimate of <i>P</i> ')
 5071   FORMAT('         Sample First Frequency:')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)F1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)PMOM
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)PFREQ
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)PML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Yule Parameter Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Method of Moments Estimate of $P$: & ',
     1       G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Method of First Frequency Estimate of $P$: & ',
     1       G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Maximum Likelihood Estimate of $P$: & ',
     1       G15.7,2X,A1,A1)
 8029 FORMAT(5X,'Sample First Frequency: & ',G15.7,2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)XMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)XSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)F1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)PMOM,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)PFREQ,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)PML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{center}')
 8093 FORMAT(A1,'end{table}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4301)
 4301   FORMAT(12X,'YULE PARAMETER ESTIMATION:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4310)
 4310   FORMAT('SUMMARY STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4311)N
 4311   FORMAT('NUMBER OF OBSERVATIONS                   = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4312)XMEAN
 4312   FORMAT('SAMPLE MEAN                              = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4313)XSD
 4313   FORMAT('SAMPLE STANDARD DEVIATION                = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4314)XMIN
 4314   FORMAT('SAMPLE MINIMUM                           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4315)XMAX
 4315   FORMAT('SAMPLE MAXIMUM                           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4316)F1
 4316   FORMAT('SAMPLE FIRST FREQUENCY                   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4317)PMOM
 4317   FORMAT('METHOD OF MOMENTS ESTIMATE OF P          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4319)PFREQ
 4319   FORMAT('METHOD OF FIRST FREQUENCY ESTIMATE OF P  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4321)PML
 4321   FORMAT('MAXIMUM LIKELIHOOD ESTIMATE OF P         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4341)
 4341   FORMAT('PMOM, PFREQ, AND PML WILL BE SAVED AS INTERNAL ',
     1         'PARAMETERS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLYU')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMLYU--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMNTC(ICOM,IHARG,IARGT,ARG,NUMARG,
     1X1COMN,X2COMN,Y1COMN,Y2COMN,
     1NX1CMN,NX2CMN,NY1CMN,NY2CMN,
     1MAXTIC,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE MINOR TIC MARK COORDINATES
C              FOR ANY OF THE 4 FRAME LINES.
C              THE MINOR TIC MARK COORDINATES ARE GIVEN IN UNITS
C              OF THE PLOTTED DATA.
C     ALSO, A SECONDARY PURPOSE IS TO ADJUST ACCORDINGLY
C              THE TIC MARK SWITCHES
C              FOR ANY OF THE 4 FRAME LINES.
C              SUCH TIC MARK SWITCHES TURN ON OR OFF
C              THE TIC MARKS ON THE 4 FRAME LINES OF A PLOT.
C              THE CONTENTS OF A TIC MARK SWITCH ARE
C              ON   OR    OFF
C              THE TIC MARK SWITCHES DEFINE WHETHER
C              THE TIC MARKS FOR A GIVEN FRAME SHOULD
C              BE ON (THAT IS, APPEAR), OR BE OFF (THAT IS,
C              BE SUPPRESSED.
C              THE TIC MARK SWITCHES FOR THE 4 FRAME LINES
C              ARE CONTAINED IN THE 4 VARIABLES
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C                     --MAXTIC
C     OUTPUT ARGUMENTS--
C                     --X1COMN,X2COMN,Y1COMN,Y2COMN,
C                     --NX1CMN,NX2CMN,NY1CMN,NY2CMN,
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION X1COMN(*)
      DIMENSION X2COMN(*)
      DIMENSION Y1COMN(*)
      DIMENSION Y2COMN(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ILOCC=0
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COOR')ILOCC=1
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'COOR')ILOCC=2
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'COOR')ILOCC=3
      ILOCCP=ILOCC+1
      IF(ILOCC.EQ.0)GOTO1900
C
C               *****************************************************
C               **  TREAT THE CASE WHEN TIC MARK COORDINATES ON    **
C               **  BOTH HORIZONTAL FRAME LINES ARE TO BE DEFINED  **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(ILOCC.EQ.NUMARG)GOTO1110
      IF(IHARG(ILOCCP).EQ.'ON')GOTO1110
      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1120
      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1110
      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1110
      GOTO1130
C
 1110 CONTINUE
      IFOUND='YES'
      NX1CMN=-1
      NX2CMN=-1
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)
 1115 FORMAT('THE MINOR TIC MARK COORDINATES (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1116)
 1116 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO1900
C
 1120 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('THE MINOR TIC MARK COORDINATES (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('HAVE JUST BEEN TURNED OFF ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('(THUS NO MINOR TIC MARKS WILL APPEAR ON THEM')
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO1900
C
 1130 CONTINUE
C
      J=0
      DO1131I=ILOCCP,NUMARG
      J=J+1
      IF(J.GT.MAXTIC)GOTO1800
      IF(IARGT(I).NE.'NUMB')GOTO1850
      X1COMN(J)=ARG(I)
      X2COMN(J)=ARG(I)
 1131 CONTINUE
      IFOUND='YES'
      NX1CMN=J
      NX2CMN=J
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('THE MINOR TIC MARK COORDINATES (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN MINOR TIC MARK COORDINATES ON
C               **  ONLY THE BOTTOM HORIZONTAL FRAME LINE ARE TO BE DEFINED **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
C
 1200 CONTINUE
      IF(ILOCC.EQ.NUMARG)GOTO1210
      IF(IHARG(ILOCCP).EQ.'ON')GOTO1210
      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1220
      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1210
      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1210
      GOTO1230
C
 1210 CONTINUE
      IFOUND='YES'
      NX1CMN=-1
C
      IF(IFEEDB.EQ.'OFF')GOTO1219
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('THE MINOR TIC COORDINATES (FOR THE BOTTOM ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
      CALL DPWRST('XXX','BUG ')
 1219 CONTINUE
      GOTO1900
C
 1220 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1229
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1225)
 1225 FORMAT('THE MINOR TIC COORDINATES (FOR THE BOTTOM ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1226)
 1226 FORMAT('HAVE JUST BEEN TURNED OFF ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1227)
 1227 FORMAT('(THUS NO MINOR TIC MARKS WILL APPEAR ON IT)')
      CALL DPWRST('XXX','BUG ')
 1229 CONTINUE
      GOTO1900
C
 1230 CONTINUE
C
      J=0
      DO1231I=ILOCCP,NUMARG
      J=J+1
      IF(J.GT.MAXTIC)GOTO1800
      IF(IARGT(I).NE.'NUMB')GOTO1850
      X1COMN(J)=ARG(I)
 1231 CONTINUE
      IFOUND='YES'
      NX1CMN=J
C
      IF(IFEEDB.EQ.'OFF')GOTO1239
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1235)
 1235 FORMAT('THE MINOR TIC COORDINATES (FOR THE BOTTOM ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1236)
 1236 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
      CALL DPWRST('XXX','BUG ')
 1239 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN MINOR TIC MARK COORDINATES ON
C               **  ONLY THE TOP    HORIZONTAL FRAME LINE ARE TO BE DEFINED **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(ILOCC.EQ.NUMARG)GOTO1310
      IF(IHARG(ILOCCP).EQ.'ON')GOTO1310
      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1320
      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1310
      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1310
      GOTO1330
C
 1310 CONTINUE
      IFOUND='YES'
      NX2CMN=-1
C
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1315)
 1315 FORMAT('THE MINOR TIC COORDINATES (FOR THE TOP ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1316)
 1316 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      GOTO1900
C
 1320 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1329
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1325)
 1325 FORMAT('THE MINOR TIC COORDINATES (FOR THE TOP ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1326)
 1326 FORMAT('HAVE JUST BEEN TURNED OFF ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1327)
 1327 FORMAT('(THUS NO MINOR TIC MARKS WILL APPEAR ON IT)')
      CALL DPWRST('XXX','BUG ')
 1329 CONTINUE
      GOTO1900
C
 1330 CONTINUE
C
      J=0
      DO1331I=ILOCCP,NUMARG
      J=J+1
      IF(J.GT.MAXTIC)GOTO1800
      IF(IARGT(I).NE.'NUMB')GOTO1850
      X2COMN(J)=ARG(I)
 1331 CONTINUE
      IFOUND='YES'
      NX2CMN=J
C
      IF(IFEEDB.EQ.'OFF')GOTO1339
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1335)
 1335 FORMAT('THE MINOR TIC COORDINATES (FOR THE TOP ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1336)
 1336 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
      CALL DPWRST('XXX','BUG ')
 1339 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               ***************************************************
C               **  TREAT THE CASE WHEN MINOR TIC MARK COORDINATES ON  **
C               **  BOTH VERMINOR TICAL FRAME LINES ARE TO BE DEFINED  **
C               ***************************************************
C
      IF(ICOM.EQ.'YMINOR TIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(ILOCC.EQ.NUMARG)GOTO1410
      IF(IHARG(ILOCCP).EQ.'ON')GOTO1410
      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1420
      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1410
      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1410
      GOTO1430
C
 1410 CONTINUE
      IFOUND='YES'
      NY1CMN=-1
      NY2CMN=-1
C
      IF(IFEEDB.EQ.'OFF')GOTO1419
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)
 1415 FORMAT('THE MINOR TIC MARK COORDINATES (FOR BOTH ',
     1'VERTICAL FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1416)
 1416 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
      CALL DPWRST('XXX','BUG ')
 1419 CONTINUE
      GOTO1900
C
 1420 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1429
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1425)
 1425 FORMAT('THE MINOR TIC MARK COORDINATES (FOR BOTH ',
     1'VERTICAL FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1426)
 1426 FORMAT('HAVE JUST BEEN TURNED OFF ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1427)
 1427 FORMAT('(THUS NO MINOR TIC MARKS WILL APPEAR ON THEM')
      CALL DPWRST('XXX','BUG ')
 1429 CONTINUE
      GOTO1900
C
 1430 CONTINUE
C
      J=0
      DO1431I=ILOCCP,NUMARG
      J=J+1
      IF(J.GT.MAXTIC)GOTO1800
      IF(IARGT(I).NE.'NUMB')GOTO1850
      Y1COMN(J)=ARG(I)
      Y2COMN(J)=ARG(I)
 1431 CONTINUE
      IFOUND='YES'
      NY1CMN=J
      NY2CMN=J
C
      IF(IFEEDB.EQ.'OFF')GOTO1439
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1435)
 1435 FORMAT('THE MINOR TIC MARK COORDINATES (FOR BOTH ',
     1'VERTICAL FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1436)
 1436 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
      CALL DPWRST('XXX','BUG ')
 1439 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN MINOR TIC MARK COORDINATES ON
C               **  ONLY THE LEFT   VERMINOR TICAL   FRAME LINE ARE TO BE DEFINE
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(ILOCC.EQ.NUMARG)GOTO1510
      IF(IHARG(ILOCCP).EQ.'ON')GOTO1510
      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1520
      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1510
      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1510
      GOTO1530
C
 1510 CONTINUE
      IFOUND='YES'
      NY1CMN=-1
C
      IF(IFEEDB.EQ.'OFF')GOTO1519
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1515)
 1515 FORMAT('THE MINOR TIC COORDINATES (FOR THE LEFT ',
     1'VERTICAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1516)
 1516 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
      CALL DPWRST('XXX','BUG ')
 1519 CONTINUE
      GOTO1900
C
 1520 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1529
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1525)
 1525 FORMAT('THE MINOR TIC COORDINATE (FOR THE LEFT ',
     1'VERTICAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1526)
 1526 FORMAT('HAVE JUST BEEN TURNED OFF ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1527)
 1527 FORMAT('(THUS NO MINOR TIC MARKS WILL APPEAR ON IT)')
      CALL DPWRST('XXX','BUG ')
 1529 CONTINUE
      GOTO1900
C
 1530 CONTINUE
C
      J=0
      DO1531I=ILOCCP,NUMARG
      J=J+1
      IF(J.GT.MAXTIC)GOTO1800
      IF(IARGT(I).NE.'NUMB')GOTO1850
      Y1COMN(J)=ARG(I)
 1531 CONTINUE
      IFOUND='YES'
      NY1CMN=J
C
      IF(IFEEDB.EQ.'OFF')GOTO1539
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1535)
 1535 FORMAT('THE MINOR TIC COORDINATES (FOR THE LEFT ',
     1'VERTICAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1536)
 1536 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
      CALL DPWRST('XXX','BUG ')
 1539 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN MINOR TIC MARK COORDINATES ON
C               **  ONLY THE RIGHT  VERTCIAL   FRAME LINE ARE TO BE DEFINED **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(ILOCC.EQ.NUMARG)GOTO1610
      IF(IHARG(ILOCCP).EQ.'ON')GOTO1610
      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1620
      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1610
      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1610
      GOTO1630
C
 1610 CONTINUE
      IFOUND='YES'
      NY2CMN=-1
C
      IF(IFEEDB.EQ.'OFF')GOTO1619
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1615)
 1615 FORMAT('THE MINOR TIC COORDINATES (FOR THE RIGHT ',
     1'VERTICAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1616)
 1616 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
      CALL DPWRST('XXX','BUG ')
 1619 CONTINUE
      GOTO1900
C
 1620 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1629
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1625)
 1625 FORMAT('THE MINOR TIC COORDINATES (FOR THE RIGHT ',
     1'VERTICAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1626)
 1626 FORMAT('HAVE JUST BEEN TURNED OFF ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1627)
 1627 FORMAT('(THUS NO MINOR TIC MARKS WILL APPEAR ON IT)')
      CALL DPWRST('XXX','BUG ')
 1629 CONTINUE
      GOTO1900
C
 1630 CONTINUE
C
      J=0
      DO1631I=ILOCCP,NUMARG
      J=J+1
      IF(J.GT.MAXTIC)GOTO1800
      IF(IARGT(I).NE.'NUMB')GOTO1850
      Y1COMN(J)=ARG(I)
 1631 CONTINUE
      IFOUND='YES'
      NY2CMN=J
C
      IF(IFEEDB.EQ.'OFF')GOTO1639
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1635)
 1635 FORMAT('THE MINOR TIC COORDINATES (FOR THE RIGHT ',
     1'VERTICAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1636)
 1636 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
      CALL DPWRST('XXX','BUG ')
 1639 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               **************************************************
C               **  TREAT THE CASE WHEN MINOR TIC MARK COORDINATES ON **
C               **  THE ENTIRE 4-SIDED FRAME ARE TO BE DEFINED  **
C               **************************************************
C
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      IF(ICOM.EQ.'MINOR TICS')GOTO1700
      IF(ICOM.EQ.'MINOR TIC ')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(ILOCC.EQ.NUMARG)GOTO1710
      IF(IHARG(ILOCCP).EQ.'ON')GOTO1710
      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1720
      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1710
      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1710
      GOTO1730
C
 1710 CONTINUE
      IFOUND='YES'
      NX1CMN=-1
      NX2CMN=-1
      NY1CMN=-1
      NY2CMN=-1
C
      IF(IFEEDB.EQ.'OFF')GOTO1719
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1715)
 1715 FORMAT('THE MINOR TIC COORDINATES (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1716)
 1716 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
      CALL DPWRST('XXX','BUG ')
 1719 CONTINUE
      GOTO1900
C
 1720 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1729
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1725)
 1725 FORMAT('THE MINOR TIC COORDINATES (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1726)
 1726 FORMAT('HAVE JUST BEEN TURNED OFF ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1727)
 1727 FORMAT('(THUS NO MINOR TIC MARKS WILL APPEAR ON ANY ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
 1729 CONTINUE
      GOTO1900
C
 1730 CONTINUE
C
      J=0
      DO1731I=ILOCCP,NUMARG
      J=J+1
      IF(J.GT.MAXTIC)GOTO1800
      IF(IARGT(I).NE.'NUMB')GOTO1850
      X1COMN(J)=ARG(I)
      X2COMN(J)=ARG(I)
      Y1COMN(J)=ARG(I)
      Y2COMN(J)=ARG(I)
 1731 CONTINUE
      IFOUND='YES'
      NX1CMN=J
      NX2CMN=J
      NY1CMN=J
      NY2CMN=J
C
      IF(IFEEDB.EQ.'OFF')GOTO1739
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1735)
 1735 FORMAT('THE MINOR TIC COORDINATES (FOR ALL 4 FRAMES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1736)
 1736 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
      CALL DPWRST('XXX','BUG ')
 1739 CONTINUE
      GOTO1900
C
 1799 CONTINUE
      GOTO1900
C
 1800 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1801)
 1801 FORMAT('***** ERROR IN DPMNTC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1802)
 1802 FORMAT('      THE NUMBER OF SPECIFIED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1803)
 1803 FORMAT('      MINOR TIC COORDINATES HAS JUST EXCEEDED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1804)MAXTIC
 1804 FORMAT('      THE ALLOWABLE MAXIMUM OF ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO1900
C
 1850 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1851)
 1851 FORMAT('***** ERROR IN DPMNTC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1852)
 1852 FORMAT('      A SPECIFICATION IN THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1853)
 1853 FORMAT('      MINOR TIC COORDINATES COMMAND HAS JUST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1854)
 1854 FORMAT('      BEEN ENCOUNTERED WHICH IS NON-NUMERIC')
      CALL DPWRST('XXX','BUG ')
      GOTO1900
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPMORE(NUMLPR,NCPREH,ICPREH,IRESP,IBUGS2,IERROR)
CCCCC THE IRESP ARGUMENT WAS ADDED JULY 1990
C
C     PURPOSE--WRITE OUT A LINE WHICH SAYS     MORE...
C              AND PAUSE UNTIL RECEIVE A CARRIAGE RETURN
C              (USED BY HELP AND LIST COMMANDS)
C     INPUT ARGUMENTS--NUMLPR = NUMBER OF LINE PRINTED ALREADY
C     OUTPUT ARGUMENTS--IRESP (YES OR NO)
C     NOTE--IT IS TYPICAL TO HAVE A LINE
C              IF(NUMLPR.GE.IHELMX)NUMLPR=0
C           IN THE CALLING ROUTINE IMMEDIATELY AFTER
C           THE CALL TO DPMORE.
C     NOTE--THE CALLING ROUTINE ALSO TYPICALLY HAS
C              NUMLPR=0
C              IRESP='YES'
C           EARLY ON IN THE CODE FOR INITIALIZATION.
C           (IF OMIT   IRESP='YES'    THEN WILL GET MIS-EXECUTION!)
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/8
C     ORIGINAL VERSION--JULY      1989.
C     UPDATED         --JULY      1989.  CHAR*4 STATEMENTS FOR ISUBN1/2
C     UPDATED         --JULY      1990.   CHANGE MORE... TO MORE...?
C     UPDATED         --JULY      1990.   ALLOW MORE... TO STOP LIST
C     UPDATED         --FEBRUARY  1993.   SKIP ALL IF TURBO-C MENU
C     UPDATED         --SEPTEMBER 1993.   ALLOW ALWAYS-WRITING
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*40 ICPREH
CCCCC CHARACTER*40 ICPOSH
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 IERROR
C
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1990
      CHARACTER*4 IRESP
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED JULY 1989
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C-----COMMON----------------------------------------------------------
C
CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1993
      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
      ISUBN1='DPMO'
      ISUBN2='RE  '
C
      IF(IBUGS2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMORE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMLPR
   53 FORMAT('NUMLPR = ',I8)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED FEBRUARY 1993
      WRITE(ICOUT,54)TCMENU
   54 FORMAT('TCMENU = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  TREAT THE MORE/PAUSE CASE  **
C               *********************************
C
CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1993
      IF(TCMENU.EQ.'ON')GOTO9000
C
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1990
      IRESP='YES'
C
      WRITE(ICOUT,1101)
 1101 FORMAT('                                      MORE...?')
CCCCC CALL DPWRST('XXX','BUG ')  SEPTEMBER 1993
      CALL DPWRST('XXX','WRIT')
CCCCC THE FOLLOWING 2 LINES WERE MODIFIED JULY 1990
CCCCC READ(IRD,1102)
C1102 FORMAT()
      READ(IRD,1102)IRESP
 1102 FORMAT(A4)
CCCCC THE FOLLOWING 4 LINES WERE ADDED JULY 1990
CCCCC MODIFIED AUGUST 1992.
      IF(IRESP.EQ.'N')IRESP='NO'
CCCCC IF(IRESP.EQ.'NO')GOTO9000
      IF(IRESP.EQ.'n')IRESP='NO'
CCCCC IF(IRESP.EQ.'no')GOTO9000
      IF(IRESP.EQ.'no')IRESP='NO'
      IF(IRESP.EQ.'NO')GOTO9000
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT AUGUST 1990
CCCCC NUMLPR=0
      IF(NCPREH.LE.0)GOTO1109
      WRITE(ICOUT,1106)(ICPREH(J:J),J=1,NCPREH)
 1106 FORMAT(80A1)
CCCCC CALL DPWRST('XXX','BUG ')    SEPTEMBER 1993
      CALL DPWRST('XXX','WRIT')
 1109 CONTINUE
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE BEGINNING OF DPMORE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NUMLPR
 9013 FORMAT('NUMLPR = ',I8)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED FEBRUARY 1993
      WRITE(ICOUT,9014)TCMENU
 9014 FORMAT('TCMENU = ',A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED JULY 1990
      WRITE(ICOUT,9015)IRESP
 9015 FORMAT('IRESP = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMOV2(X1,Y1,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--MOVE TO A POINT
C              WITH THE COORDINATES (X1,Y1)
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT2
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IPATT
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(10)
      DIMENSION PY(10)
CCCCC DIMENSION PX3(10)
CCCCC DIMENSION PY3(10)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'MOV2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMOV2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IFIG
   59 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE THE COORDINATES  **
C               **  FOR THE POINT              **
C               *********************************
C
      PX(1)=X1
      PY(1)=Y1
C
      NP=1
C
C               ***********************
C               **  STEP 2--         **
C               **  FILL THE FIGURE  **
C               **  (IF CALLED FOR)  **
C               ***********************
C
      IF(IREFSW(1).EQ.'OFF')GOTO2190
      IPATT=IREPTY(1)
      IPATT2='SOLI'
      PTHICK=PREPTH(1)
      PXGAP=PREPSP(1)
      PYGAP=PREPSP(1)
      ICOLF=IREFCO(1)
      ICOLP=IREPCO(1)
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
 2190 CONTINUE
C
C               ***************************
C               **  STEP 3--             **
C               **  DRAW OUT THE FIGURE  **
C               ***************************
C
      IPATT=ILINPA(1)
      PTHICK=PLINTH(1)
      ICOL=ILINCO(1)
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'MOV2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMOV2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NP
 9013 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)I,PX(I),PY(I)
 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMOVE(IHARG,IARGT,ARG,NUMARG,
     1PXSTAR,PYSTAR,
     1PXEND,PYEND,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG,
     1IGRASW,IDIASW,
     1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1992
CCCCC AND THEN CHANGED             FEBRUARY 1995
CCCCC1UNITSW,
     1X1UNIT,Y1UNIT,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--MOVE TO ONE OR MORE POINTS
C              (DEPENDING ON HOW MANY NUMBERS ARE PROVIDED).
C              THE COORDINATES ARE IN STANDARDIZED UNITS
C              OF 0 TO 100.
C     NOTE--THE INPUT COORDINATES DEFINE THE
C           POINT.
C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 1
C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*1 = 2.
C     NOTE--IF NO NUMBERS ARE PROVIDED,
C           THEN THE POINT MOVED TO WILL BE
C           AT THE LAST CURSOR POSITION
C     NOTE--IF 2 NUMBERS ARE PROVIDED,
C           THEN THE POINT MOVED TO WILL BE
C           AT THE ABSOLUTE (X,Y) POSITION
C           AS DEFINED BY THE 2 NUMBERS
C     NOTE--AND SO FORTH FOR 2, 3, 4, ... NUMBERS.
C     INPUT  ARGUMENTS--IHARG
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PXSTAR
C                     --PYSTAR
C     OUTPUT ARGUMENTS--PXEND
C                     --PYEND
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --NOVEMBER  1982.
C     UPDATED         --JANUARY   1989.  CALL LIST FOR OFFSET VAR (ALAN)
C     UPDATED         --NOVEMBER  1992.  UNITS SWITCH (DATA OR SCREEN)
C     UPDATED         --SEPTEMBER 1993.  DECLARE DUMMY   ISUBRO
C     UPDATED         --SEPTEMBER 1993.  FIX BUG FORMAT STATEMENT
C     UPDATED         --FEBRUARY  1995.  GENERALIZED MOVE.... COMMAND
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C
C-----NON-COMMON VARIABLES-----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
C
CCCCC THE FOLLOWING LINE WAS ADDED   SEPTEMBER 1993
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IFIG
      CHARACTER*4 IBELSW
      CHARACTER*4 IERASW
      CHARACTER*4 IBACCO
      CHARACTER*4 ICOPSW
      CHARACTER*4 ITYPEO
C
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1992
CCCCC AND THEN CHANGED             FEBRUARY 1995
CCCCC CHARACTER*4 UNITSW
      CHARACTER*4 X1UNIT
      CHARACTER*4 Y1UNIT
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
      IERRG4=IERROR
CCCCC IBUGG4=IBUGD2
CCCCC ISUBG4=ISUBRO
C
CCCCC THE FOLLOWING LINE WAS ADDED   SEPTEMBER 1993
      ISUBRO='DUMM'
C
      ILOCFN=0
      NUMNUM=0
C
      X1=0.0
      Y1=0.0
      X2=0.0
      Y2=0.0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'MOVE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMOVE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMARG
   53 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I),IARGT(I),ARG(I)
   56 FORMAT('I,IHARG(I),IARGT(I),ARG(I) = ',I8,2X,A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,57)PXSTAR,PYSTAR
   57 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)PXEND,PYEND
   58 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)IGRASW,IDIASW
   76 FORMAT('IGRASW,IDIASW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)PGRAXF,PGRAYF,PDIAXC,PDIAYC
   77 FORMAT('PGRAXF,PGRAYF,PDIAXC,PDIAYC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,78)PDIAHE,PDIAWI,PDIAVG,PDIAHG
   78 FORMAT('PDIAHE,PDIAWI,PDIAVG,PDIAHG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80)NUMDEV
   80 FORMAT('NUMDEV= ',I8)
      CALL DPWRST('XXX','BUG ')
      DO81I=1,NUMDEV
      WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
   82 FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I)
   83 FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I)
   84 FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
      WRITE(ICOUT,85)X1UNIT,Y1UNIT
   85 FORMAT('X1UNIT, Y1UNIT = ',2A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,87)IFOUND
   87 FORMAT('IFOUND= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4
   88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGD2,IERROR
   89 FORMAT('IBUGD2,IERROR= ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFIG='POIN'
      NUMPT=1
      NUMPT2=2*NUMPT
C
C               ********************************
C               **  STEP 0--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
C  AUGUST 1988.  ADD OFFSET VARIABLE
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               ************************************
C               **  STEP 1--                      **
C               **  CARRY OUT OPENING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      CALL DPOPDE
C
      IBELSW='OFF'
      NUMRIN=0
      IERASW='OFF'
      IBACCO='JUNK'
C
      CALL DPOPPL(IGRASW,
     1IBELSW,NUMRIN,IERASW,
     1IBACCO)
C
C               *****************************************
C               **  STEP 2--                           **
C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
C               *****************************************
C
      IF(NUMARG.GE.2.AND.
     1IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1111
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ABSO'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1112
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'RELA'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1113
      GOTO1130
C
 1111 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=1
      GOTO1119
C
 1112 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=2
      GOTO1119
C
 1113 CONTINUE
      ITYPEO='RELA'
      ILOCFN=2
      GOTO1119
 1119 CONTINUE
C
      IF(ILOCFN.GT.NUMARG)GOTO1129
      DO1120I=ILOCFN,NUMARG
      IF(IARGT(I).EQ.'NUMB')GOTO1120
      GOTO1129
 1120 CONTINUE
      IFOUND='YES'
      GOTO1149
 1129 CONTINUE
      GOTO1130
C
 1130 CONTINUE
      IERRG4='YES'
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPMOVE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ILLEGAL FORM FOR DRAW ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1134)
 1134 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('      SUPPOSE IT IS DESIRED TO DRAW A POINT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      AT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      POINT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      BOX ABSOLUTE 20 20 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1149 CONTINUE
C
C               ****************************
C               **  STEP 3--              **
C               **  MOVE TO THE POINT(S)  **
C               ****************************
C
      NUMNUM=NUMARG-ILOCFN+1
      IF(NUMNUM.LT.NUMPT2)GOTO1151
      GOTO1152
C
 1151 CONTINUE
      J=ILOCFN-1
      X1=PXSTAR
      Y1=PYSTAR
      GOTO1170
C
 1152 CONTINUE
      J=ILOCFN
      IF(J.GT.NUMARG)GOTO1190
      X1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1992
CCCCC AND THEN CHANGED             FEBRUARY 1995
CCCCC IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR)
      IF(X1UNIT.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR)
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1992
CCCCC AND THEN CHANGED             FEBRUARY 1995
CCCCC IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR)
      IF(Y1UNIT.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR)
      GOTO1170
C
 1160 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1992
CCCCC AND THEN CHANGED             FEBRUARY 1995
CCCCC IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
      IF(X1UNIT.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X2=X1+X2
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1992
CCCCC AND THEN CHANGED             FEBRUARY 1995
CCCCC IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
      IF(Y1UNIT.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
      X1=X2
      Y1=Y2
      GOTO1170
C
 1170 CONTINUE
      CALL DPMOV2(X1,Y1,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      X1=X1
      Y1=Y1
C
      GOTO1160
 1190 CONTINUE
C
      PXEND=X1
      PYEND=Y1
C
C               ************************************
C               **  STEP 4--                      **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSW='OFF'
      NUMCOP=0
      CALL DPCLPL(ICOPSW,NUMCOP,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
 8000 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'MOVE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMOVE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOCFN,NUMNUM
 9012 FORMAT('ILOCFN,NUMNUM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X1,Y1
 9013 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PXSTAR,PYSTAR
 9015 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PXEND,PYEND
 9016 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IFIG
 9017 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)IFOUND
 9027 FORMAT('IFOUND = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGG4,ISUBG4,IERRG4
CCCCC THE FOLLOWING LINE WAS FIXED   SEPTEMBER 1993
C9028 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4)
 9028 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGD2,IERROR
 9029 FORMAT('IBUGD2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMPCO(IHARG,NUMARG,IDEMPC,MAXMAR,IMAPCO,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE MARKER PATTERN COLORS = THE COLORS
C              OF THE LINES MAKING UP A PATTERN WITHIN A MARKER.
C              THESE ARE LOCATED IN THE VECTOR IMAPCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEMPC
C                     --MAXMAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IMAPCO (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEMPC
      CHARACTER*4 IMAPCO
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IMAPCO(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPMP'
      ISUBN2='CO  '
C
      NUMMAR=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMPCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXMAR,NUMMAR
   53 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEMPC
   55 FORMAT('IDEMPC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IMAPCO(1)
   70 FORMAT('IMAPCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IMAPCO(I)
   76 FORMAT('I,IMAPCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMMAR=1
      IMAPCO(1)=IDEMPC
      GOTO1270
C
 1220 CONTINUE
      NUMMAR=NUMARG-2
      IF(NUMMAR.GT.MAXMAR)NUMMAR=MAXMAR
      DO1225I=1,NUMMAR
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDEMPC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEMPC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMPC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMPC
      IMAPCO(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMMAR
      WRITE(ICOUT,1276)I,IMAPCO(I)
 1276 FORMAT('THE COLOR OF MARKER PATTERN ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMMAR=MAXMAR
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDEMPC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEMPC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMPC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMPC
      DO1315I=1,NUMMAR
      IMAPCO(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IMAPCO(I)
 1316 FORMAT('THE COLOR OF ALL MARKER PATTERNS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMPCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXMAR,NUMMAR
 9013 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEMPC
 9015 FORMAT('IDEMPC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IMAPCO(1)
 9030 FORMAT('IMAPCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IMAPCO(I)
 9036 FORMAT('I,IMAPCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMPLI(IHARG,IHARG2,NUMARG,IDEMPL,MAXMAR,IMAPLI,
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC SUBROUTINE DPMPLI(IHARG,NUMARG,IDEMPL,MAXMAR,IMAPLI,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN LINES = THE LINES TYPES
C              OF THE PATTERN WITHIN THE MARKERS.
C              THESE ARE LOCATED IN THE VECTOR IMAPLI(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEMPL
C                     --MAXMAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IMAPLI (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C     UPDATED         --AUGUST    1995.  DASH2 BUG
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      CHARACTER*4 IHARG2
      CHARACTER*4 IDEMPL
      CHARACTER*4 IMAPLI
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      DIMENSION IHARG2(*)
      DIMENSION IMAPLI(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPMP'
      ISUBN2='LI  '
C
      NUMMAR=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMPLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXMAR,NUMMAR
   53 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEMPL
   55 FORMAT('IDEMPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IMAPLI(1)
   70 FORMAT('IMAPLI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IMAPLI(I)
   76 FORMAT('I,IMAPLI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO9000
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      IF(NUMARG.EQ.5)GOTO1150
      GOTO1160
C
 1130 CONTINUE
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(5).EQ.'ALL')IHOLD1='    '
      IF(IHARG(5).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
CCCCC APRIL 1996.  IHOLD TO IHOLD1 BELOW
      IF(IHARG(5).EQ.'ALL')THEN
        IHOLD1=IHARG(6)
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'2')IHOLD1='DA2'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'3')IHOLD1='DA3'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'4')IHOLD1='DA4'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'5')IHOLD1='DA5'
        GOTO1300
      ENDIF
      IF(IHARG(6).EQ.'ALL')THEN
        IHOLD1=IHARG(5)
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'2')IHOLD1='DA2'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'3')IHOLD1='DA3'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'4')IHOLD1='DA4'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'5')IHOLD1='DA5'
        GOTO1300
      ENDIF
      GOTO1200
C
 1160 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.3)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMMAR=1
      IMAPLI(1)='    '
      GOTO1270
C
 1220 CONTINUE
      NUMMAR=NUMARG-3
      IF(NUMMAR.GT.MAXMAR)NUMMAR=MAXMAR
      DO1225I=1,NUMMAR
      J=I+3
      IHOLD1=IHARG(J)
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'2')IHOLD1='DA2'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'3')IHOLD1='DA3'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'4')IHOLD1='DA4'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'5')IHOLD1='DA5'
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMPL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMPL
      IMAPLI(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMMAR
      WRITE(ICOUT,1276)I,IMAPLI(I)
 1276 FORMAT('THE LINE TYPE FOR MARKER PATTERN ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMMAR=MAXMAR
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMPL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMPL
      DO1315I=1,NUMMAR
      IMAPLI(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IMAPLI(I)
 1316 FORMAT('THE LINE TYPE FOR ALL MARKER PATTERNS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMPLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXMAR,NUMMAR
 9013 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEMPL
 9015 FORMAT('IDEMPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IMAPLI(1)
 9030 FORMAT('IMAPLI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IMAPLI(I)
 9036 FORMAT('I,IMAPLI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMPSP(IHARG,IARGT,ARG,NUMARG,PDEMPS,MAXMAR,PMAPSP,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE MARKER PATTERN SPACINGS = THE SPACINGS
C              BETWEEN THE LINES WHICH MAKE UP THE PATTERNS WITHIN THE MARKERS.
C              THESE ARE LOCATED IN THE VECTOR PMAPSP(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --PDEMPS
C                     --MAXMAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--PMAPSP (A FLOATING POINT VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
      DIMENSION PMAPSP(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPMP'
      ISUBN2='SP  '
C
      NUMMAR=0
      IHOLD1='-999'
      HOLD1=-999.0
      HOLD2=-999.0
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMPSP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXMAR,NUMMAR
   53 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)PDEMPS
   55 FORMAT('PDEMPS = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)PMAPSP(1)
   70 FORMAT('PMAPSP(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,PMAPSP(I)
   76 FORMAT('I,PMAPSP(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')HOLD1=PDEMPS
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')HOLD1=ARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMMAR=1
      PMAPSP(1)=PDEMPS
      GOTO1270
C
 1220 CONTINUE
      NUMMAR=NUMARG-2
      IF(NUMMAR.GT.MAXMAR)NUMMAR=MAXMAR
      DO1225I=1,NUMMAR
      J=I+2
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEMPS
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEMPS
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEMPS
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEMPS
      PMAPSP(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMMAR
      WRITE(ICOUT,1276)I,PMAPSP(I)
 1276 FORMAT('THE SPACING BETWEEN (LINES WITHIN) PATTERN ',I6,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMMAR=MAXMAR
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEMPS
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEMPS
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEMPS
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEMPS
      DO1315I=1,NUMMAR
      PMAPSP(I)=HOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)PMAPSP(I)
 1316 FORMAT('THE SPACING BETWEEN (LINES WITHIN) ALL PATTERNS',
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMPSP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXMAR,NUMMAR
 9013 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PDEMPS
 9015 FORMAT('PDEMPS = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)PMAPSP(1)
 9030 FORMAT('PMAPSP(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,PMAPSP(I)
 9036 FORMAT('I,PMAPSP(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMPTH(IHARG,IARGT,ARG,NUMARG,PDEMPT,MAXMAR,PMAPTH,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE MARKER PATTERN THICKNESSES = THE THICKNESSES
C              OF THE LINES WHICH MAKE UP THE PATTERNS WITHIN THE MARKERS.
C              THESE ARE LOCATED IN THE VECTOR PMAPTH(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --PDEMPT
C                     --MAXMAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--PMAPTH (A FLOATING POINT VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
      DIMENSION PMAPTH(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPMP'
      ISUBN2='TH  '
C
      NUMMAR=0
      IHOLD1='-999'
      HOLD1=-999.0
      HOLD2=-999.0
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMPTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXMAR,NUMMAR
   53 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)PDEMPT
   55 FORMAT('PDEMPT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)PMAPTH(1)
   70 FORMAT('PMAPTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,PMAPTH(I)
   76 FORMAT('I,PMAPTH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')HOLD1=PDEMPT
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')HOLD1=ARG(2)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMMAR=1
      PMAPTH(1)=PDEMPT
      GOTO1270
C
 1220 CONTINUE
      NUMMAR=NUMARG-2
      IF(NUMMAR.GT.MAXMAR)NUMMAR=MAXMAR
      DO1225I=1,NUMMAR
      J=I+2
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEMPT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEMPT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEMPT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEMPT
      PMAPTH(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMMAR
      WRITE(ICOUT,1276)I,PMAPTH(I)
 1276 FORMAT('THE THICKNESS OF (LINES WITHIN) PATTERN ',I6,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMMAR=MAXMAR
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEMPT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEMPT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEMPT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEMPT
      DO1315I=1,NUMMAR
      PMAPTH(I)=HOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)PMAPTH(I)
 1316 FORMAT('THE THICKNESS OF (LINES WITHIN) ALL PATTERNS',
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMPTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXMAR,NUMMAR
 9013 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PDEMPT
 9015 FORMAT('PDEMPT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)PMAPTH(1)
 9030 FORMAT('PMAPTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,PMAPTH(I)
 9036 FORMAT('I,PMAPTH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMPTY(IHARG,NUMARG,IDEMPT,MAXMAR,IMAPTY,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN TYPES = THE TYPES
C              OF THE PATTERN WITHIN THE MARKERS.
C              THESE ARE LOCATED IN THE VECTOR IMAPTY(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEMPT
C                     --MAXMAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IMAPTY (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEMPT
      CHARACTER*4 IMAPTY
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IMAPTY(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPMP'
      ISUBN2='TY  '
C
      NUMMAR=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMPTY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXMAR,NUMMAR
   53 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEMPT
   55 FORMAT('IDEMPT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IMAPTY(1)
   70 FORMAT('IMAPTY(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IMAPTY(I)
   76 FORMAT('I,IMAPTY(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMMAR=1
      IMAPTY(1)='    '
      GOTO1270
C
 1220 CONTINUE
      NUMMAR=NUMARG-2
      IF(NUMMAR.GT.MAXMAR)NUMMAR=MAXMAR
      DO1225I=1,NUMMAR
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMPT
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMPT
      IMAPTY(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMMAR
      WRITE(ICOUT,1276)I,IMAPTY(I)
 1276 FORMAT('THE TYPE FOR MARKER PATTERN ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMMAR=MAXMAR
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMPT
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMPT
      DO1315I=1,NUMMAR
      IMAPTY(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IMAPTY(I)
 1316 FORMAT('THE TYPE FOR ALL MARKER PATTERNS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMPTY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXMAR,NUMMAR
 9013 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEMPT
 9015 FORMAT('IDEMPT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IMAPTY(1)
 9030 FORMAT('IMAPTY(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IMAPTY(I)
 9036 FORMAT('I,IMAPTY(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMUCC(IHARG,IHARG2,IARGT,ARG,NUMARG,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,IANS,IWIDTH,
     1PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE MULTIPLOT CORNER COORDINATES
C              (LOWER LEFT AND UPPER RIGHT)
C              WHICH IN TURN WILL DEFINE THE SIZE AND SHAPE
C              OF THE TOTAL PLOT FRAME FOR MULTIPLOTS.
C              THE 2 PAIRS OF COORDINATES ARE CONTAINED IN THE
C              4 VARIABLES    PMXMIN,PMYMIN    AND    PMXMAX,PMYMAX
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--PMXMIN = X COOR. FOR LOWER LEFT  CORNER
C                     --PMXMAX = X COOR. FOR UPPER RIGHT CORNER
C                     --PMYMIN = Y COOR. FOR LOWER LEFT  CORNER
C                     --PMYMAX = Y COOR. FOR UPPER RIGHT CORNER
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/7
C     ORIGINAL VERSION--MARCH     1986.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IANS
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IHWORD
      CHARACTER*4 IHWOR2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IN(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
      DIMENSION IANS(*)
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='DPMU'
      ISUBN2='CC  '
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE END       OF DPMUCC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IFOUND,IERROR
   52 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)PMXMIN,PMXMAX,PMYMIN,PMYMAX
   53 FORMAT('PMXMIN,PMXMAX,PMYMIN,PMYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  TREAT THE    MULTIPLOT COORDINATES    CASE  **
C               **************************************************
C
      IF(NUMARG.EQ.1)GOTO1150
      GOTO1110
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(NUMARG.GE.2)GOTO1175
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPMUCC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR MULTIPLOT COORDINATES ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('      SUPPOSE IT IS DESIRED TO POSITION   ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      THE LOWER LEFT CORNER OF THE MULTIPLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      10% ACROSS THE PAGE AND 20% UP THE PAGE, AND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      THE UPPER RIGHT CORNER OF THE MULTIPLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1129)
 1129 FORMAT('      90% ACROSS THE PAGE AND 80% UP THE PAGE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      MULTIPLOT COORDINATES 10 20 90 80')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      PMXMIN=15.
      PMYMIN=20.
      PMXMAX=85.
      PMYMAX=90.
      GOTO1180
C
 1175 CONTINUE
      DO1176J=2,NUMARG
      IF(IARGT(J).EQ.'NUMB')GOTO1177
      GOTO1178
 1177 CONTINUE
      IF(J.EQ.2)PMXMIN=ARG(J)
      IF(J.EQ.3)PMYMIN=ARG(J)
      IF(J.EQ.4)PMXMAX=ARG(J)
      IF(J.EQ.5)PMYMAX=ARG(J)
      GOTO1176
 1178 CONTINUE
      IHWORD=IHARG(J)
      IHWOR2=IHARG2(J)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHWORD,IHWOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(J.EQ.2)PMXMIN=VALUE(ILOC)
      IF(J.EQ.3)PMYMIN=VALUE(ILOC)
      IF(J.EQ.4)PMXMAX=VALUE(ILOC)
      IF(J.EQ.5)PMYMAX=VALUE(ILOC)
 1176 CONTINUE
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1185)
 1185 FORMAT('THE MULTIPLOT COORDINATES HAVE JUST BEEN SET ',
     1'AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)PMXMIN,PMYMIN
 1186 FORMAT('    (X,Y) FOR LOWER LEFT  CORNER OF MULTIPLOT = ',
     12E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1187)PMXMAX,PMYMAX
 1187 FORMAT('    (X,Y) FOR UPPER RIGHT CORNER OF MULTIPLOT = ',
     12E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMUCC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)PMXMIN,PMXMAX,PMYMIN,PMYMAX
 9013 FORMAT('PMXMIN,PMXMAX,PMYMIN,PMYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE 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)
C
C     PURPOSE--DEFINE THE MULTIPLOT PARAMETERS
C              WHICH ALLOW PROPER POSITIONING OF
C              SUCCEEDING SUB-PLOTS.
C              IMPSW = MULTIPLOT SWITCH (OFF OR ON)
C              IMPNR = NUMBER OF MULTIPLOT ROWS
C              IMPNC = NUMBER OF MULTIPLOT COLUMNS
C              IMPCO = CURRENT MULTIPLOT EXISTING SUBPLOT COUNT
C              IMPARG= NUMBER OF ARGUMENTS FOR MULTIPLOT
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --IARG   (AN INTEGER VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS/-IMPSW = ON-OFF MULTIPLOT SWITCH
C                     --IMPNR = NUMBER OF ROWS OF SUBPLOTS
C                     --IMPNC = NUMBER OF COLUMNS OF SUBPLOTS
C                     --IMPCO = NUMBER OF ALREADY-EXISTING SUBPLOTS
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--MULTIPLOT IS USED IN DPGRAP
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MARCH     1986.
C     UPDATED         --MARCH     1988.  ALLOW 4-ARGUMENT FORM
C     UPDATED         --NOVEMBER  1991.  MULTIPLOT FREEZE OR HOLD
C     UPDATED         --NOVEMBER  1991.  MULTIPLOT UNFREEZE OR UNHOLD
C     UPDATED         --SEPTEMBER 1992.  CHECK FOR ARGS = 0
C     UPDATED         --SEPTEMBER 1993.  OMIT AUTO-ERASE
C     UPDATED         --SEPTEMBER 1993.  FIX FREEZE/UNFREEZE
C     UPDATED         --OCTOBER   1993.  FIX OVERWRITE
C     UPDATED         --SEPTEMBER 1995.  FIX NO-ARGUMENT BOMB
C     UPDATED         --SEPTEMBER 1998.  MULTIPLOT SCALE FACTOR
C     UPDATED         --AUGUST    1999.  RETURN NUMBER OF ARGUMENTS
C                                        (INITIAL PAGE ERASE SUPPRESSED
C                                        FOR 3 AND 4 ARGUMENT VERSION
C                                        OF MULTIPLOT)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IANS
C
      CHARACTER*4 IMPSW
      CHARACTER*4 IERASV
      CHARACTER*4 IERASW
CCCCC CHARACTER*4 IX1TSW
CCCCC CHARACTER*4 IX2TSW
CCCCC CHARACTER*4 IY1TSW
CCCCC CHARACTER*4 IY2TSW
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IHWORD
      CHARACTER*4 IHWOR2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IN(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
      DIMENSION IANS(*)
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='DPMU'
      ISUBN2='LT  '
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMULT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGP2,IFOUND,IERROR
   53 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,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)IERASW
   83 FORMAT('IERASW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)PWXMIN,PWXMAX,PWYMIN,PWYMAX
   84 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,85)IERASV
   85 FORMAT('IERASV = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,86)PWXMIS,PWXMAS,PWYMIS,PWYMAS
   86 FORMAT('PWXMIS,PWXMAS,PWYMIS,PWYMAS = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************************
C               **  TREAT THE    MULTIPLOT           CASE  **
C               *********************************************
C
C               *********************************************
C               **  STEP 1--
C               **  FOR ALL CASES, REGARDLESS OF WHETHER
C               **  MULTIPLOT IS BEING TURNED ON OR OFF,
C               **  REDEFINE PWXMIN ETC FROM THE SAVED VALUES
C               **  SO AS TO AVOID THE PROBLEM OF OVERWRITING
C               **  THE SAVED VALUES WHEN THE ANALYST
C               **  ENTERS MULTIPLE   MULTIPLOT ON'S
C               **  WITHOUT AN INTERMEDIATE   MULTIPLOT OFF  .
C               **  THUS INITIALLY TREAT ALL CASES AS A
C               **  MULTIPLOT OFF   .
C               *********************************************
C
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT NOVEMBER 1991
CCCCC IMPSW='OFF'
C
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT      SEPTEMBER 1993
CCCCC TO FIX PROBLEM OF MULTIPLOT AUTO-ERASE    SEPTEMBER 1993
CCCCC EVEN IF PRE-ERASE HAD BEEN SET TO OFF     SEPTEMBER 1993
CCCCC IERASW=IERASV
C
CCCCC THE FOLLOWING IF-CHECK WAS ADDED     SEPTEMBER 1995
      IF(NUMARG.GE.1)THEN
CCCCC THE FOLLOWING 2 LINES WERE ENTERED    SEPTEMBER 1993
         IF(IHARG(NUMARG).EQ.'FREE')GOTO1090
         IF(IHARG(NUMARG).EQ.'UNFR')GOTO1090
C
         PWXMIN=PWXMIS
         PWXMAX=PWXMAS
         PWYMIN=PWYMIS
         PWYMAX=PWYMAS
C
CCCCC THE FOLLOWING LINE WAS ENTERED    SEPTEMBER 1993
 1090    CONTINUE
      ENDIF
CCCCC ADD FOLLOWING LINE AUGUST 1999.
      IMPARG=1
C
C               *********************************************
C               **  STEP 2--
C               **  BRANCH TO THE VARIOUS CASES
C               *********************************************
C
      IF(NUMARG.LE.0)GOTO1150
      GOTO1110
C
 1110 CONTINUE
CCCCC ADD FOLLOWING LINE SEPTEMBER 1998.
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SCAL')GOTO1120
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1160
CCCCC THE FOLLOWING 2 LINES WERE ADDED NOVEMBER 1991
      IF(IHARG(NUMARG).EQ.'FREE')GOTO1140
      IF(IHARG(NUMARG).EQ.'HOLD')GOTO1140
      IF(IHARG(NUMARG).EQ.'UNFR')GOTO1145
      IF(IHARG(NUMARG).EQ.'UNHO')GOTO1145
      IF(NUMARG.LE.0)GOTO1150
      GOTO1170
C
 1120 CONTINUE
CCCC ADD FOLLOWING SECTION  SEPTEMBER 1998.
CCCC MULTIPLOT SCALE FACTOR
      AMPSCH=1.0
      AMPSCW=1.0
      IF(IHARG(NUMARG).EQ.'SCAL')THEN
        AMPSCH=1.0
        AMPSCW=1.0
      ELSEIF(IHARG(NUMARG).EQ.'AUTO')THEN
        AMPSCH=1.0
        AMPSCW=1.0
      ELSEIF(IHARG(NUMARG).EQ.'DEFA')THEN
        AMPSCH=1.0
        AMPSCW=1.0
      ELSEIF(IHARG(NUMARG).EQ.'ON')THEN
        AMPSCH=1.0
        AMPSCW=1.0
      ELSEIF(IHARG(NUMARG).EQ.'OFF')THEN
        AMPSCH=1.0
        AMPSCW=1.0
      ELSEIF(IARGT(NUMARG).EQ.'NUMB'.AND.IARGT(NUMARG-1).EQ.'NUMB')THEN
        AMPSCW=ARG(NUMARG)
        AMPSCH=ARG(NUMARG-1)
        IF(AMPSCW.LE.0.0)AMPSCW=1.0
        IF(AMPSCW.GE.100.0)AMPSCW=1.0
        IF(AMPSCH.LE.0.0)AMPSCH=1.0
        IF(AMPSCH.GE.100.0)AMPSCH=1.0
      ELSEIF(IARGT(NUMARG).EQ.'NUMB')THEN
        AMPSCF=ARG(NUMARG)
        IF(AMPSCF.LE.0.0)AMPSCF=1.0
        IF(AMPSCF.GE.100.0)AMPSCF=1.0
        AMPSCH=AMPSCF
        AMPSCW=AMPSCF
      ELSE
        AMPSCH=1.0
        AMPSCW=1.0
      ENDIF
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)AMPSCH
 1211 FORMAT('MULTIPLOT HEIGHT SCALE FACTOR SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)AMPSCW
 1213 FORMAT('MULTIPLOT WIDTH  SCALE FACTOR SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
CCCCC THE FOLLOWING SECTION (3 LINES) WAS ADDED NOVEMBER 1991
 1140 CONTINUE
      IF(IMPSW.EQ.'ON')IMPSW='FREE'
      GOTO1180
C
CCCCC THE FOLLOWING SECTION (6 LINES) WAS ADDED NOVEMBER 1991
 1145 CONTINUE
      IF(IMPSW.EQ.'FREE')THEN
         IMPSW='ON'
         IMPCO=IMPCO+1
      ENDIF
      GOTO1180
C
 1150 CONTINUE
CCCCC THE FOLLOWING LINE WAS ADDED                  OCTOBER 1993
CCCCC TO SOLVE THE MULTIPLOT OVERWRITING PROBLEM    OCTOBER 1993
      IF(IMPSW.EQ.'OFF')IERASV=IERASW
      IMPSW='ON'
      IMPNR=2
      IMPNC=2
      IMPCO=1
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT          OCTOBER 1993
CCCCC TO SOLVE THE MULTIPLOT OVERWRITING PROBLEM    OCTOBER 1993
CCCCC IERASV=IERASW
      PWXMIS=PWXMIN
      PWXMAS=PWXMAX
      PWYMIS=PWYMIN
      PWYMAS=PWYMAX
      GOTO1180
C
 1160 CONTINUE
CCCCC THE FOLLOWING LINE WAS ADDED                  OCTOBER 1993
CCCCC TO SOLVE THE MULTIPLOT OVERWRITING PROBLEM    OCTOBER 1993
      IF(IMPSW.EQ.'ON')IERASW=IERASV
      IMPSW='OFF'
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT          OCTOBER 1993
CCCCC TO SOLVE THE MULTIPLOT OVERWRITING PROBLEM    OCTOBER 1993
CCCCC IERASW=IERASV
      PWXMIN=PWXMIS
      PWXMAX=PWXMAS
      PWYMIN=PWYMIS
      PWYMAX=PWYMAS
      GOTO1180
C
 1170 CONTINUE
CCCCC THE FOLLOWING 2 LINES WERE ADDED              OCTOBER 1993
CCCCC TO SOLVE THE MULTIPLOT OVERWRITING PROBLEM    OCTOBER 1993
      IF(IMPSW.EQ.'OFF')IERASV=IERASW
      IF(IMPSW.EQ.'ON')IERASW=IERASV
      IMPSW='ON'
      IMPCO=1
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT          OCTOBER 1993
CCCCC TO SOLVE THE MULTIPLOT OVERWRITING PROBLEM    OCTOBER 1993
CCCCC IERASV=IERASW
      PWXMIS=PWXMIN
      PWXMAS=PWXMAX
      PWYMIS=PWYMIN
      PWYMAS=PWYMAX
CCCCC RETURN NUMBER OF ARGUMENTS (IMPARG)    AUGUST 1999
      DO1171J=1,NUMARG
      IF(IARGT(J).EQ.'NUMB')GOTO1172
      GOTO1173
 1172 CONTINUE
      IF(J.EQ.1)IMPNR=IARG(J)
      IF(J.EQ.1)IMPARG=1
      IF(J.EQ.2)IMPNC=IARG(J)
      IF(J.EQ.2)IMPARG=2
CCCCC IF(J.EQ.3)IMPCO=IARG(J)                     MARCH 1988
CCCCC THE FOLLOWING 3 LINES WERE ADJUSTED/ENTERED MARCH 1988
      IF(J.EQ.3.AND.NUMARG.EQ.3)IMPCO=IARG(J)
      IF(J.EQ.3.AND.NUMARG.NE.3)IHOLD3=IARG(J)
      IF(J.EQ.3)IMPARG=3
      IF(J.EQ.4)IMPCO=(IHOLD3-1)*IMPNC+IARG(J)
      IF(J.EQ.4)IMPARG=4
      GOTO1171
 1173 CONTINUE
      IHWORD=IHARG(J)
      IHWOR2=IHARG2(J)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHWORD,IHWOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(J.EQ.1)IMPNR=VALUE(ILOC)+0.5
      IF(J.EQ.2)IMPNC=VALUE(ILOC)+0.5
CCCCC IF(J.EQ.3)IMPCO=VALUE(ILOC)+0.5             MARCH 1988
CCCCC THE FOLLOWING 4 LINES WERE ADJUSTED/ENTERED MARCH 1988
      IF(J.EQ.3.AND.NUMARG.EQ.3)IMPCO=VALUE(ILOC)+0.5
      IF(J.EQ.3.AND.NUMARG.NE.3)IHOLD3=VALUE(ILOC)+0.5
      IF(J.EQ.4)IHOLD4=VALUE(ILOC)+0.5
      IF(J.EQ.4)IMPCO=(IHOLD3-1)*IMPNC+IHOLD4
 1171 CONTINUE
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
CCCCC THE FOLLOWING SECTION WAS ADDE    SEPTEMBER 1993
      IF(IMPNR.LE.0.OR.IMPNC.LE.0)THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2011)
 2011    FORMAT('***** ERROR IN SUBROUTINE DPMULT--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2012)
 2012    FORMAT('      NEGATIVE ARGUMENT ENCOUNTERED.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2013)IMPNR
 2013    FORMAT('      ARGUMENT 1 = ',I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2014)IMPNC
 2014    FORMAT('      ARGUMENT 2 = ',I8)
         CALL DPWRST('XXX','BUG ')
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE MULTIPLOT SWITCH HAS JUST BEEN SET ')
      CALL DPWRST('XXX','BUG ')
      IF(IMPSW.EQ.'OFF')WRITE(ICOUT,1182)
 1182 FORMAT('TO   OFF')
      IF(IMPSW.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(IMPSW.EQ.'ON')WRITE(ICOUT,1183)
 1183 FORMAT('TO   ON   WITH THE FOLLOWING SETTINGS--')
      IF(IMPSW.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(IMPSW.EQ.'ON')WRITE(ICOUT,1184)IMPNR
 1184 FORMAT('      NUMBER OF ROWS    OF PLOTS = ',I8)
      IF(IMPSW.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(IMPSW.EQ.'ON')WRITE(ICOUT,1185)IMPNC
 1185 FORMAT('      NUMBER OF COLUMNS OF PLOTS = ',I8)
      IF(IMPSW.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(IMPSW.EQ.'ON')WRITE(ICOUT,1186)IMPCO
 1186 FORMAT('      NEXT PLOT TO BE GENERATED  = ',I8)
      IF(IMPSW.EQ.'ON')CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMULT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGP2,IFOUND,IERROR
 9013 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,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)IERASW
 9043 FORMAT('IERASW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)PWXMIN,PWXMAX,PWYMIN,PWYMAX
 9044 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9045)IERASV
 9045 FORMAT('IERASV = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9046)PWXMIS,PWXMAS,PWYMIS,PWYMAS
 9046 FORMAT('PWXMIS,PWXMAS,PWYMIS,PWYMAS = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMXRL(IHARG,IARGT,IARG,NUMARG,IDEFRL,NUMRCM,MAXRCL,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE MAXIMUM RECORD LENGTH FOR READING DATA FILES.
C              NOTE THAT THIS CURRENTLY ONLY SPECIFIES THE LENGTH OF
C              DATA LINE READ.  IT IS NOT CURRENTLY USED WHEN OPENING
C              THE FILE (ALTHOUGH THIS COULD BE ADDED AT A LATER DATE).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --IARG   (AN INTEGER VECTOR)
C                     --NUMARG
C                     --IDEFRL (AN INTEGER DEFINING THE DEFAULT MAXIMUM
C                              RECORD LENGTH)
C                     --MAXRCL (AN INTEGER DEFINING THE MAXIMUM VALUE THAT
C                              THE MAXIMUM RECORD LENGTH CAN BE SET TO)
C     OUTPUT ARGUMENTS--NUMRCM (AN INTEGER VARIABLE CONTAINING THE CURRENT
C                              SETTING FOR THE MAXIMUM RECORD LENGTH FOR
C                              DATA FILES)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003/2
C     ORIGINAL VERSION--FEBRUARY  2003.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IHOLD1=0
C
C               ****************************************************
C               **  TREAT THE CASE WHEN                           **
C               **  THE MAXIMUM RECORD LENGTH IS TO BE CHANGED    **
C               ****************************************************
C
 1100 CONTINUE
      IF(NUMARG.LE.0)GOTO9000
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'RECO'.AND.IHARG(2).EQ.'LENG')
     1GOTO1110
      GOTO9000
C
 1110 CONTINUE
      IF(NUMARG.EQ.2)GOTO1120
      IF(IHARG(NUMARG).EQ.'ON')GOTO1120
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1120
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1120
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1120
      IF(IHARG(NUMARG).EQ.'?')GOTO8100
      IF(NUMARG.GE.3.AND.IARGT(3).EQ.'NUMB')GOTO1130
      GOTO9000
C
 1120 CONTINUE
      IHOLD1=IDEFRL
      GOTO1180
C
 1130 CONTINUE
      IHOLD1=IARG(3)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      NUMRCM=IHOLD1
C
C  CHECK AGAINST MAXIMUM RECORD LENGTH
C
      IF(NUMRCM.LT.132)NUMRCM=132
      IF(NUMRCM.GT.MAXRCL)NUMRCM=MAXRCL
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1185)
 1185 FORMAT('THE MAXIMUM RECORD LENGTH (FOR READ AND SERIAL READ)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)NUMRCM
 1186 FORMAT('HAVE JUST BEEN SET TO ',I8)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
C               ********************************************
C               **  STEP 81--                             **
C               **  TREAT THE    ?    CASE--              **
C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
C               ********************************************
C
 8100 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8111)NUMRCM
 8111 FORMAT('THE CURRENT MAXIMUM RECORD LENGTH IS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)IDEFRL
 8112 FORMAT('THE DEFAULT MAXIMUM RECORD LENGTH IS ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE 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)
C
C     PURPOSE--TREAT THE NAME/RENAME CASE--
C              NAMING OR RENAMING OF COLUMNS.
C              EXAMPLE--NAME 7 X
C                       RENAME 7 X
C                       RENAME PRESSURE Y
C     NOTE--THE RECOMMENDED VERB (FOR EASE OF REMEMBRANCE) IS RENAME.
C           THE SYNTAX IS    RENAME    EXISTING NAME     NEW NAME
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION (IN DPLET)--DECEMBER 1977.
C     ORIGINAL VERSION AS A SEPARATE SUBROUTINE--MARCH 1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --NOVEMBER  1980.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --NOVEMBER  1986.
C     UPDATED         --JANUARY   2000. UPDATE VARIABLE LABEL
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*40 IVARLB
      CHARACTER*4 IANS
      CHARACTER*4 IBUGS2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 NEWNAM
      CHARACTER*4 NEWCOL
      CHARACTER*4 IRIGHT
      CHARACTER*4 IRIGH2
      CHARACTER*4 ILEFT
      CHARACTER*4 ILEFT2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IN(*)
      DIMENSION IVSTAR(*)
      DIMENSION IVSTOP(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
      DIMENSION IVARLB(*)
C
      DIMENSION IANS(*)
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='DPNA'
      ISUBN2='ME  '
C
      ICOLL=0
      ILISTR=0
      ILISTL=0
C
      IRIGHT='UNKN'
      IRIGH2='UNKN'
      ILEFT='UNKN'
      ILEFT2='UNKN'
C
C               **********************************
C               **  TREAT THE NAME/RENAME CASE  **
C               **********************************
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE VARIABLES.      **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFOUND='YES'
      IERROR='NO'
C
      NEWNAM='NO'
      NEWCOL='NO'
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK THAT THERE ARE AT LEAST 2 ARGUMENTS.       **
C               **  WHEN HAVE MORE THAN 2 ARGUMENTS,                 **
C               **  THEN THE FIRST AND THE LAST ARGUMENTS            **
C               **  ARE THE ONES WHICH ARE EXAMINED,                 **
C               **  (WITH INTERMEDIATE INFORMATION IGNORED).         **
C               **  EXAMINE THE 2 ARGUMENTS                          **
C               **  AND CHECK TO SEE THAT EXACTLY ONE IS A WORD      **
C               **  AND EXACTLY ONE IS A NUMBER.                     **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      DO2000IPASS=1,NUMARG,2
      IPASSP=IPASS+1
C
      IF(IARGT(IPASS).EQ.'WORD'.AND.IARGT(IPASSP).EQ.'NUMB')GOTO250
      IF(IARGT(IPASS).EQ.'NUMB'.AND.IARGT(IPASSP).EQ.'WORD')GOTO250
      IF(IARGT(IPASS).EQ.'WORD'.AND.IARGT(IPASSP).EQ.'WORD')GOTO1250
C
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,211)
  211 FORMAT('***** ERROR IN DPNAME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,212)
  212 FORMAT('      AT LEAST ONE OF THE ARGUMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,213)
  213 FORMAT('      IN THE NAME COMMAND MUST BE A VARIABLE NAME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,214)
  214 FORMAT('      IT IS NOT PERMITTED TO HAVE NUMBERS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,215)
  215 FORMAT('      FOR BOTH ARGUMENTS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,217)
  217 FORMAT('      AN ERROR CONDITION EXISTS HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,218)IHARG(IPASS),IHARG2(IPASS),IARGT(IPASS)
  218 FORMAT('          FIRST  ARGUMENT = ',2A4,'--A  ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,219)IHARG(2),IHARG2(2),IARGT(2)
  219 FORMAT('          SECOND ARGUMENT = ',2A4,'--A  ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,220)
  220 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,221)(IANS(I),I=1,IWIDTH)
  221 FORMAT(6X,80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  250 CONTINUE
      ILOCN=IPASS
      ILOCW=IPASSP
      IF(IARGT(IPASSP).EQ.'NUMB')ILOCN=IPASSP
      IF(IARGT(IPASS).EQ.'WORD')ILOCW=IPASS
C
      ILEFT=IHARG(ILOCN)
      ILEFT2=IHARG2(ILOCN)
      IRIGHT=IHARG(ILOCW)
      IRIGH2=IHARG2(ILOCW)
      ICOLL=IARG(ILOCN)
C
C               ********************************************************
C               **  STEP 3--                                          **
C               **  EXAMINE THE NAME ARGUMENT--                       **
C               **  IS THE NAME                                       **
C               **  ALREADY IN THE NAME LIST?                         **
C               **  NOTE THAT     ILISTR    IS THE LINE IN THE TABLE  **
C               **  OF THE NAME.                                      **
C               ********************************************************
C
      ISTEPN='3'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMNAM.LE.0)GOTO310
      DO300I=1,NUMNAM
      I2=I
      IF(IRIGHT.EQ.IHNAME(I).AND.IRIGH2.EQ.IHNAM2(I))GOTO380
  300 CONTINUE
  310 CONTINUE
      NEWNAM='YES'
      ILISTR=NUMNAM+1
      IF(ILISTR.GT.MAXNAM)GOTO320
      GOTO390
C
  320 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,321)
  321 FORMAT('***** ERROR IN DPNAME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,322)
  322 FORMAT('      THE NUMBER OF VARIABLE/PARAMETER/FUNCTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,323)ILISTR,MAXNAM
  323 FORMAT('      NAMES (= ',I8,') HAS JUST EXCEEDED THE ',
     1'ALLOWABLE ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,324)
  324 FORMAT('      SUGGESTION--ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,325)
  325 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,326)
  326 FORMAT('      AND THEN REDEFINE (REUSE) ONE OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,327)
  327 FORMAT('      ALREADY-USED NAMES')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  380 CONTINUE
      ILISTR=I2
  390 CONTINUE
C
C               ****************************************************************
C               **  STEP 4--
C               **  EXAMINE THE NUMBER ARGUMENT--
C               **  IS IT A VALID COLUMN DESIGNATION (1 TO MAXCOL)?
C               **  IS IT AN OLD (PREVIOUSLY-USED) OR NEW COLUMN DESIGNATION?
C               **  NOTE THAT     ILISTL    IS THE LINE IN THE TABLE
C               **  OF THE NUMBER ARGUMENT.
C               **  NOTE THAT     ICOLL    IS THE DATA COLUMN (1 TO MAXCOL)
C               **  FOR THE NUMBER ARGUMENT.
C               ****************************************************************
C
      ISTEPN='4'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICOLL.LE.MAXCOL)GOTO419
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,405)
  405 FORMAT('***** ERROR IN DPNAME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,406)
  406 FORMAT('      THE COLUMN SPECIFICATION ON THE RIGHT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,407)MAXCOL
  407 FORMAT('      SIDE SHOULD BE BETWEEN 1 AND ',I8,
     1' (INCLUSIVE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,408)
  408 FORMAT('      BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,409)ICOLL
  409 FORMAT('      THE REFERENCED COLUMN WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,411)
  411 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,412)(IANS(I),I=1,IWIDTH)
  412 FORMAT(6X,80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  419 CONTINUE
C
      IF(NUMNAM.LE.0)GOTO432
      DO430I=1,NUMNAM
      I2=I
CCCCC IF(IN(I).EQ.ICOLL.AND.IUSE(I).EQ.'V')GOTO434
      IF(IVALUE(I).EQ.ICOLL.AND.IUSE(I).EQ.'V')GOTO434
  430 CONTINUE
  432 CONTINUE
      NEWCOL='YES'
      ILISTL=NUMNAM+1
      GOTO439
  434 CONTINUE
      NEWCOL='NO'
      ILISTL=I2
      GOTO439
  439 CONTINUE
C
      IF(ILISTL.LE.MAXNAM)GOTO459
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,451)
  451 FORMAT('***** ERROR IN DPNAME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,452)
  452 FORMAT('      THE NUMBER OF VARIABLE/PARAMETER/FUNCTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,453)ILISTR,MAXNAM
  453 FORMAT('      NAMES (= ',I8,') HAS JUST EXCEEDED THE ',
     1'ALLOWABLE ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,454)
  454 FORMAT('      SUGGESTION--ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,455)
  455 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,456)
  456 FORMAT('      AND THEN REDEFINE (REUSE) ONE OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,457)
  457 FORMAT('      ALREADY-USED NAMES')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  459 CONTINUE
C
C               *************************************************
C               **  STEP 5--                                   **
C               **  MAKE THE ADJUSTMENTS TO THE INTERNAL LIST  **
C               **  ON THE BASIS OF THE LEFT SIDE              **
C               **  AND RIGHT SIDE INFORMATION.                **
C               *************************************************
C
      ISTEPN='5'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHNAME(ILISTR)=IRIGHT
      IHNAM2(ILISTR)=IRIGH2
      IF(ILISTL.EQ.ILISTR)GOTO511
      GOTO512
  511 CONTINUE
      IUSE(ILISTR)='V'
      IVALUE(ILISTR)=ILISTR
      VALUE(ILISTR)=ILISTR
      GOTO519
  512 CONTINUE
      IUSE(ILISTR)=IUSE(ILISTL)
      IVALUE(ILISTR)=IVALUE(ILISTL)
      VALUE(ILISTR)=VALUE(ILISTL)
      IN(ILISTR)=IN(ILISTL)
      IVARLB(ILISTR)=IVARLB(ILISTL)
      GOTO519
  519 CONTINUE
      IVSTAR(ILISTR)=MAXN*(ICOLL-1)+1
      IVSTOP(ILISTR)=MAXN*ICOLL-1
      IF(NEWNAM.EQ.'YES')NUMNAM=NUMNAM+1
      IF(NEWCOL.EQ.'YES'.AND.ICOLL.GT.NUMCOL)NUMCOL=ICOLL
C
C               **********************************************
C               **  STEP 6--                                **
C               **  PRINT OUT A BRIEF MESSAGE               **
C               **  INDICATING THAT THE NAME EQUIVALENCING  **
C               **  HAS BEEN CARRIED OUT.                   **
C               **********************************************
C
      ISTEPN='6'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFEEDB.EQ.'OFF')GOTO619
      IF(IPASS.EQ.1)WRITE(ICOUT,999)
      IF(IPASS.EQ.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,611)ICOLL,IRIGHT,IRIGH2
  611 FORMAT('COLUMN ',I8,' HAS JUST BEEN RENAMED ',2A4)
      CALL DPWRST('XXX','BUG ')
  619 CONTINUE
      GOTO2000
C
C               ********************************************************
C               **  STEP 13--                                        **
C               **  EXAMINE THE FIRST ARGUMENT--                      **
C               **  IS THE NAME                                       **
C               **  ALREADY IN THE NAME LIST?                         **
C               **  NOTE THAT     ILISTL    IS THE LINE IN THE TABLE  **
C               **  OF THE NAME.                                      **
C               ********************************************************
C
 1250 CONTINUE
      ISTEPN='13'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ILEFT=IHARG(IPASS)
      ILEFT2=IHARG2(IPASS)
      IRIGHT=IHARG(IPASSP)
      IRIGH2=IHARG2(IPASSP)
C
      IF(NUMNAM.LE.0)GOTO1310
      DO1300I=1,NUMNAM
      I2=I
      IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I))GOTO1380
 1300 CONTINUE
C
 1310 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1311)
 1311 FORMAT('***** ERROR IN DPNAME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1312)
 1312 FORMAT('      WHEN USING THE RENAME COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1313)
 1313 FORMAT('      WITH BOTH ARGUMENTS BEING NAMES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1314)
 1314 FORMAT('      THE FIRST ARGUMENT MUST BE A NAME')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1315)
 1315 FORMAT('      OF A PRE-EXISTING VARIABLE/PARAMETER/FUNCTION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1316)
 1316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1317)ILEFT,ILEFT2
 1317 FORMAT('THE ARGUMENT NAME IS ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1380 CONTINUE
      ILISTL=I2
 1390 CONTINUE
C
C               ****************************************************************
C               **  STEP 14--
C               **  EXAMINE THE SECOND ARGUMENT--
C               **  IS THE NAME                                       **
C               **  ALREADY IN THE NAME LIST?                         **
C               **  NOTE THAT     ILISTR    IS THE LINE IN THE TABLE  **
C               **  OF THE NAME.                                      **
C               ****************************************************************
C
      ISTEPN='14'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NEWNAM='NO'
      IF(NUMNAM.LE.0)GOTO1410
      DO1400I=1,NUMNAM
      I2=I
      IF(IRIGHT.EQ.IHNAME(I).AND.IRIGH2.EQ.IHNAM2(I))GOTO1480
 1400 CONTINUE
C
 1410 CONTINUE
      NEWNAM='YES'
      ILISTR=NUMNAM+1
      IF(ILISTR.GT.MAXNAM)GOTO1420
      GOTO1490
C
 1420 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1421)
 1421 FORMAT('***** ERROR IN DPNAME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1422)
 1422 FORMAT('      THE NUMBER OF VARIABLE/PARAMETER/FUNCTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1423)ILISTR,MAXNAM
 1423 FORMAT('      NAMES (= ',I8,') HAS JUST EXCEEDED THE ',
     1'ALLOWABLE ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1424)
 1424 FORMAT('      SUGGESTION--ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1425)
 1425 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1426)
 1426 FORMAT('      AND THEN REDEFINE (REUSE) ONE OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1427)
 1427 FORMAT('      ALREADY-USED NAMES')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1480 CONTINUE
      ILISTR=I2
 1490 CONTINUE
C
C               *************************************************
C               **  STEP 15--                                  **
C               **  MAKE THE ADJUSTMENTS TO THE INTERNAL LIST  **
C               **  ON THE BASIS OF THE LEFT SIDE              **
C               **  AND RIGHT SIDE INFORMATION.                **
C               *************************************************
C
      ISTEPN='15'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHNAME(ILISTR)=IRIGHT
      IHNAM2(ILISTR)=IRIGH2
      IUSE(ILISTR)=IUSE(ILISTL)
      IVALUE(ILISTR)=IVALUE(ILISTL)
      VALUE(ILISTR)=VALUE(ILISTL)
      IN(ILISTR)=IN(ILISTL)
      IVSTAR(ILISTR)=IVSTAR(ILISTL)
      IVSTOP(ILISTR)=IVSTOP(ILISTL)
      IF(NEWNAM.EQ.'YES')NUMNAM=NUMNAM+1
C
C               **********************************************
C               **  STEP 16--                               **
C               **  PRINT OUT A BRIEF MESSAGE               **
C               **  INDICATING THAT THE NAME EQUIVALENCING  **
C               **  HAS BEEN CARRIED OUT.                   **
C               **********************************************
C
      ISTEPN='16'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFEEDB.EQ.'OFF')GOTO1619
      IF(IPASS.EQ.1)WRITE(ICOUT,999)
      IF(IPASS.EQ.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1611)ILEFT,ILEFT2,IRIGHT,IRIGH2
 1611 FORMAT('NAME ',2A4,' HAS JUST BEEN RENAMED ',2A4,'   .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1612)
 1612 FORMAT('NOTE THAT THE ORIGINAL NAME IS NOT DESTROYED;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1613)
 1613 FORMAT('THUS EITHER NAME MAY BE USED TO REFER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1614)
 1614 FORMAT('TO THE ORIGINAL VARIABLE/PARAMETER/FUNCTION.')
      CALL DPWRST('XXX','BUG ')
 1619 CONTINUE
      GOTO2000
 2000 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
C
      IF(IBUGS2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPNAME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILEFT,ILEFT2
 9012 FORMAT('ILEFT,ILEFT2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IRIGHT,IRIGH2
 9013 FORMAT('IRIGHT,IRIGH2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NEWCOL
 9014 FORMAT('NEWCOL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)ICOLL,ILISTR,ILISTL
 9016 FORMAT('ICOLL,ILISTR,ILISTL = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)NUMNAM,NEWNAM
 9021 FORMAT('NUMNAM,NEWNAM = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)ILISTL,ILISTR
 9022 FORMAT('ILISTL,ILISTR = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMNAM
      WRITE(ICOUT,9026)I,IHNAME(I),IHNAM2(I)
 9026 FORMAT('I,IHNAME(I),IHNAM2(I) = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO9030I=1,NUMNAM
      WRITE(ICOUT,9031)I,IUSE(I),IVALUE(I),IN(I)
 9031 FORMAT('I,IUSE(I),IVALUE(I),IN(I) = ',I8,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
 9030 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPNAN2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW A LOGICAL NAND (= A NAND BOX)
C              WITH THE MIDDLE OF THE FLATTER SIDE
C              AT THE POINT (X1,Y1),
C              AND WITH THE MIDDLE OF THE POINTED SIDE
C              AT THE POINT (X2,Y2).
C     NOTE--THE HEIGHT OF THE BOX WILL BE EQUAL TO
C           THE ABOVE-DESCRIBED WIDTH OF THE BOX
C           (THAT IS, THE HEIGHT
C           OF THE BOX WILL BE EQUAL TO
C           THE WIDTH FROM (X1,Y1) TO (X2,Y2).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT2
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IPATT
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(1000)
      DIMENSION PY(1000)
CCCCC FEBRUARY 1994.  ADD FOLLOWING SECTION
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR11),PX(1))
      EQUIVALENCE (G2RBAG(IGAR12),PY(1))
CCCCC END CHANGE
CCCCC DIMENSION PX3(1000)
CCCCC DIMENSION PY3(1000)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'NAN2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPNAN2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y2
   54 FORMAT('X2,Y2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IFIG
   59 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE THE COORDINATES  **
C               **  FOR THE LOGICAL NAND      **
C               *********************************
C
C
      POWER=1.4
      FACTOR=0.2
C
      DELX=X2-X1
      DELY=Y2-Y1
      ALEN=0.0
      TERM=(X2-X1)**2+(Y2-Y1)**2
      IF(TERM.GT.0.0)ALEN=SQRT(TERM)
      R=ALEN/2.0
      IF(ABS(DELX).GE.0.00001)THETA=ATAN(DELY/DELX)
      IF(ABS(DELX).LT.0.00001.AND.DELY.GE.0.0)THETA=3.1415926/2.0
      IF(ABS(DELX).LT.0.00001.AND.DELY.LT.0.0)THETA=-3.1415926/2.0
C
      K=0
C
      X=R
      Y=-R
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      DO5310I=271,451,10
      PHI2=I-1
      PHI2=PHI2*(2.0*3.1415926)/360.0
      ABSCOS=ABS(COS(PHI2))
      ABSSIN=ABS(SIN(PHI2))
      X=R*(ABSCOS**POWER)
      Y=R*(ABSSIN**POWER)
      IF(SIN(PHI2).LT.0.0)Y=-Y
      X=X+R
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
 5310 CONTINUE
C
      X=0
      Y=R
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      DO5320I=271,451,10
      PHI2=I-1
      PHI2=360.0-PHI2
      PHI2=PHI2*(2.0*3.1415926)/360.0
      X=FACTOR*R*COS(PHI2)
      Y=R*SIN(PHI2)
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
 5320 CONTINUE
C
      X=R
      Y=-R
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      NP=K
C
C               ***********************
C               **  STEP 2--         **
C               **  FILL THE FIGURE  **
C               **  (IF CALLED FOR)  **
C               ***********************
C
      IF(IREFSW(1).EQ.'OFF')GOTO2190
      IPATT=IREPTY(1)
      IPATT2='SOLI'
      PTHICK=PREPTH(1)
      PXGAP=PREPSP(1)
      PYGAP=PREPSP(1)
      ICOLF=IREFCO(1)
      ICOLP=IREPCO(1)
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
 2190 CONTINUE
C
      IPATT=ILINPA(1)
      PTHICK=PLINTH(1)
      ICOL=ILINCO(1)
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
      K=0
C
      X=-0.2*R
      Y=R
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      DO5330I=271,451,10
      PHI2=I-1
      PHI2=360.0-PHI2
      PHI2=PHI2*(2.0*3.1415926)/360.0
      X=FACTOR*R*COS(PHI2)
      Y=R*SIN(PHI2)
      X=X-0.2*R
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
 5330 CONTINUE
C
      NP=K
C
      IPATT2='SOLI'
      IF(IREFSW(1).EQ.'ON')
     1CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
C
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'NAN2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPNAN2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NP
 9014 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)I,PX(I),PY(I)
 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPNAND(IHARG,IARGT,ARG,NUMARG,
     1PXSTAR,PYSTAR,
     1PXEND,PYEND,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG,
     1IGRASW,IDIASW,
     1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
CCCCC ADD FOLLOWING LINE JULY 1997.
     1UNITSW,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DRAW ONE OR MORE LOGICAL NANDS
C              (DEPENDING ON HOW MANY NUMBERS ARE PROVIDED).
C              THE COORDINATES ARE IN STANDARDIZED UNITS
C              OF 0 TO 100.
C     NOTE--THE INPUT COORDINATES DEFINE THE BACK CENTER AND THE FRONT CENTER
C           OF THE LOGICAL NAND.
C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 2
C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*2 = 4.
C     NOTE--IF 2 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN LOGICAL NAND WILL GO
C           FROM THE LAST CURSOR POSITION
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE 2 NUMBERS.
C     NOTE--IF 4 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN LOGICAL NAND WILL GO
C           FROM THE ABSOLUTE (X,Y) POSITION
C           AS DEFINED BY THE FIRST 2 NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS.
C     NOTE--IF 6 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN LOGICAL NAND WILL GO
C           FROM THE (X,Y) POSITION
C           AS RESULTING FROM THE THIRD AND FOURTH NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIFTH AND SIXTH NUMBERS.
C     NOTE--AND SO FORTH FOR 8, 10, 12, ... NUMBERS.
C     INPUT  ARGUMENTS--IHARG
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PXSTAR
C                     --PYSTAR
C     OUTPUT ARGUMENTS--PXEND
C                     --PYEND
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --NOVEMBER  1982.
C     UPDATED         --JANUARY   1989.  CALL LIST FOR OFFSET VAR (ALAN)
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C     UPDATED         --JULY      1997.  SUPPORT FOR "DATA" UNITS (ALAN)
C
C-----NON-COMMON VARIABLES-----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
CCCCC ADD FOLLOWING LINE JULY 1997.
      CHARACTER*4 UNITSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IFIG
      CHARACTER*4 IBELSW
      CHARACTER*4 IERASW
      CHARACTER*4 IBACCO
      CHARACTER*4 ICOPSW
      CHARACTER*4 ITYPEO
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
      IERRG4=IERROR
CCCCC IBUGG4=IBUGD2
CCCCC ISUBG4=ISUBRO
C
      ILOCFN=0
      NUMNUM=0
C
      X1=0.0
      Y1=0.0
      X2=0.0
      Y2=0.0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'NAND')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPNAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMARG
   53 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I),IARGT(I),ARG(I)
   56 FORMAT('I,IHARG(I),IARGT(I),ARG(I) = ',I8,2X,A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,57)PXSTAR,PYSTAR
   57 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)PXEND,PYEND
   58 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)IGRASW,IDIASW
   76 FORMAT('IGRASW,IDIASW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)PGRAXF,PGRAYF,PDIAXC,PDIAYC
   77 FORMAT('PGRAXF,PGRAYF,PDIAXC,PDIAYC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,78)PDIAHE,PDIAWI,PDIAVG,PDIAHG
   78 FORMAT('PDIAHE,PDIAWI,PDIAVG,PDIAHG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80)NUMDEV
   80 FORMAT('NUMDEV= ',I8)
      CALL DPWRST('XXX','BUG ')
      DO81I=1,NUMDEV
      WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
   82 FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I)
   83 FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I)
   84 FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
      WRITE(ICOUT,87)IFOUND
   87 FORMAT('IFOUND= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4
   88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGD2,IERROR
   89 FORMAT('IBUGD2,IERROR= ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFIG='NAND'
      NUMPT=2
      NUMPT2=2*NUMPT
C
C               ********************************
C               **  STEP 0--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
C  AUGUST 1988.  ADD OFFSET VARIABLE
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               ************************************
C               **  STEP 1--                      **
C               **  CARRY OUT OPENING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      CALL DPOPDE
C
      IBELSW='OFF'
      NUMRIN=0
      IERASW='OFF'
      IBACCO='JUNK'
C
      CALL DPOPPL(IGRASW,
     1IBELSW,NUMRIN,IERASW,
     1IBACCO)
C
C               *****************************************
C               **  STEP 2--                           **
C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
C               *****************************************
C
      IF(NUMARG.GE.2.AND.
     1IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1111
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ABSO'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1112
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'RELA'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1113
      GOTO1130
C
 1111 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=1
      GOTO1119
C
 1112 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=2
      GOTO1119
C
 1113 CONTINUE
      ITYPEO='RELA'
      ILOCFN=2
      GOTO1119
 1119 CONTINUE
C
      IF(ILOCFN.GT.NUMARG)GOTO1129
      DO1120I=ILOCFN,NUMARG
      IF(IARGT(I).EQ.'NUMB')GOTO1120
      GOTO1129
 1120 CONTINUE
      IFOUND='YES'
      GOTO1149
 1129 CONTINUE
      GOTO1130
C
 1130 CONTINUE
      IERRG4='YES'
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPNAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ILLEGAL FORM FOR DRAW ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1134)
 1134 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('      SUPPOSE IT IS DESIRED TO DRAW A LOGICAL NAND ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      WITH THE MIDDLE OF THE FLATTER SIDE  ',
     1'AT THE POINT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      AND WITH THE POINTED END AT THE POINT 40 60')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      LOGICAL NAND 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      LOGICAL NAND ABSOLUTE 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1149 CONTINUE
C
C               ****************************
C               **  STEP 3--              **
C               **  DRAW OUT THE LINE(S)  **
C               ****************************
C
      NUMNUM=NUMARG-ILOCFN+1
      IF(NUMNUM.LT.NUMPT2)GOTO1151
      GOTO1152
C
 1151 CONTINUE
      J=ILOCFN-1
      X1=PXSTAR
      Y1=PYSTAR
      GOTO1159
C
 1152 CONTINUE
      J=ILOCFN
      IF(J.GT.NUMARG)GOTO1190
      X1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR)
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR)
      GOTO1159
 1159 CONTINUE
C
 1160 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X2=X1+X2
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
C
 1170 CONTINUE
      CALL DPNAN2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      X1=X2
      Y1=Y2
C
      GOTO1160
 1190 CONTINUE
C
      PXEND=X2
      PYEND=Y2
C
C               ************************************
C               **  STEP 4--                      **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSW='OFF'
      NUMCOP=0
      CALL DPCLPL(ICOPSW,NUMCOP,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
 8000 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'NAND')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPNAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOCFN,NUMNUM
 9012 FORMAT('ILOCFN,NUMNUM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X1,Y1,X2,Y2
 9013 FORMAT('X1,Y1,X2,Y2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PXSTAR,PYSTAR
 9015 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PXEND,PYEND
 9016 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IFIG
 9017 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)IFOUND
 9027 FORMAT('IFOUND = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGG4,ISUBG4,IERRG4
 9028 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGD2,IERROR
 9029 FORMAT('IBUGD2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPNDER(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IA,PARAM,IPARN,IPARN2,
     1IANGLU,IBUGA3,IBUGCO,IBUGEV,IBUGQ,ISUBRO,IERROR)
C
C     PURPOSE--TREAT THE LET CASE FOR
C              FINDING THE NUMERICAL DERIVATIVE OF AN FUNCTION.
C     EXAMPLE--LET A = NUMERICAL DERIVATIVE X**3+2*X**2-4*X+5 FOR X = 1
C            --LET X = NUMERICAL DERIVATIVE F1 FOR X = B
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/1
C     ORIGINAL VERSION--JANUARY   2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ITYPEH
      CHARACTER*4 IW21HO
      CHARACTER*4 IW22HO
      CHARACTER*4 IA
      CHARACTER*4 IPARN
      CHARACTER*4 IPARN2
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 NEWNAM
      CHARACTER*4 IHOUT
      CHARACTER*4 IHOUT2
      CHARACTER*4 IUOUT
      CHARACTER*4 IDUMV
      CHARACTER*4 IDUMV2
      CHARACTER*4 IHPARN
      CHARACTER*4 IHPAR2
      CHARACTER*4 IHL
      CHARACTER*4 IHL2
      CHARACTER*4 IWD1
      CHARACTER*4 IWD2
      CHARACTER*4 IWD12
      CHARACTER*4 IWD22
      CHARACTER*4 ILAB
      CHARACTER*4 IKEY
      CHARACTER*4 IKEY2
      CHARACTER*4 INCLUN
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEL
      CHARACTER*4 IFOUND
      CHARACTER*4 IFOUN1
      CHARACTER*4 IFOUN2
      CHARACTER*4 IERRO2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IOLD
      CHARACTER*4 IOLD2
      CHARACTER*4 INEW
      CHARACTER*4 INEW2
C
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION ITYPEH(*)
      DIMENSION IW21HO(*)
      DIMENSION IW22HO(*)
      DIMENSION W2HOLD(*)
C
      DIMENSION IA(*)
      DIMENSION PARAM(*)
      DIMENSION IPARN(*)
      DIMENSION IPARN2(*)
C
      DIMENSION IDUMV(100)
      DIMENSION IDUMV2(100)
C
      DIMENSION ILAB(10)
      DIMENSION IOLD(10)
      DIMENSION IOLD2(10)
      DIMENSION INEW(10)
      DIMENSION INEW2(10)
C
C-----MAKE DUMMY COMMON BLOCK FOR FUNCTION CALL-----------
C
      PARAMETER (IDUMCH=1000)
      PARAMETER (IDUMC2=100)
C
      CHARACTER*4 IBUGAZ
      CHARACTER*4 IZNAME
      CHARACTER*4 IZNAM2
      CHARACTER*4 ZTYPEH
      CHARACTER*4 ZW21HO
      CHARACTER*4 ZW22HO
      CHARACTER*4 ZIPARN
      CHARACTER*4 ZPARN2
      CHARACTER*4 ZMODEL
      CHARACTER*4 ZIDUMV
      CHARACTER*4 ZDUMV2
C
      DIMENSION ZMODEL(IDUMCH)
      DIMENSION ZTYPEH(IDUMCH)
      DIMENSION ZW21HO(IDUMCH)
      DIMENSION ZW22HO(IDUMCH)
      DIMENSION Z2HOLD(IDUMCH)
C
      DIMENSION ZPARAM(IDUMC2)
      DIMENSION ZIPARN(IDUMC2)
      DIMENSION ZPARN2(IDUMC2)
      DIMENSION ZIDUMV(IDUMC2)
      DIMENSION ZDUMV2(IDUMC2)
      DIMENSION LOCDUZ(IDUMC2)
C
      COMMON /DUMCMC/ IBUGAZ, ZTYPEH, ZW21HO, ZW22HO, ZIPARN, ZPARN2, 
     &                ZIDUMV, ZDUMV2, ZMODEL, IZNAME, IZNAM2, IZNDEX
      COMMON /DUMCMR/ ZPARAM, Z2HOLD, 
     &                NUMCHZ, NUMPVZ, NWHOLZ, NUMDVZ, LOCDUZ
CCCCC EXTERNAL OPTFCN
C
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1989
      DIMENSION BJUNK(1)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
      INCLUDE 'DPCOZZ.INC'
      DIMENSION XFULL(MAXOBV)
      DIMENSION YDER(MAXOBV)
      EQUIVALENCE (GARBAG(IGARB2),YDER(1))
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPND'
      ISUBN2='ER  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IERROR='NO'
C
      ILOCMX=0
      NUMLIM=0
      ILOC3=0
      IP=0
      IV=0
      LOCDUM=0
C
      IHLEFT='UNKN'
      IHLEF2='UNKN'
C
C               **********************************************
C               **  TREAT THE NUMERICAL DERIVATIVE SUBCASE  **
C               **  OF THE LET COMMAND                      **
C               **********************************************
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'NDER')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPNDER--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)IBUGCO,IBUGEV
   53   FORMAT('IBUGCO,IBUGEV = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,54)IBUGQ
   54   FORMAT('IBUGQ = ',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'NDER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NEWNAM='NO'
C
      MAXN2=MAXCHF
      MAXN3=MAXCHF
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'NDER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ******************************************************
C               **  STEP 2--                                         *
C               **  EXAMINE THE LEFT-HAND SIDE--                     *
C               **  IS THE NAME     NAME TO LEFT OF = SIGN           *
C               **  ALREADY IN THE NAME LIST?                        *
C               **  NOTE THAT     ILISTL    IS THE LINE IN THE TABLE *
C               **  OF THE NAME ON THE LEFT.                         *
C               ******************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'NDER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      DO2000I=1,NUMNAM
        I2=I
        IF(IHLEFT.EQ.IHNAME(I).AND.IHLEF2.EQ.IHNAM2(I))GOTO2100
 2000 CONTINUE
      NEWNAM='YES'
      ILISTL=NUMNAM+1
      IF(ILISTL.GT.MAXNAM)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2201)
 2201   FORMAT('***** ERROR IN DPNDER--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2202)
 2202   FORMAT('      THE NUMBER OF VARIABLE, PARAMETER, & FUNCTION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2203)MAXNAM
 2203   FORMAT('      NAMES HAS JUST EXCEEDED THE ALLOWABLE ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2204)
 2204   FORMAT('      ENTER      STAT')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2205)
 2205   FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2206)
 2206   FORMAT('      AND THEN REDEFINE (REUSE) SOME OF THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2207)
 2207   FORMAT('      ALREADY-USED NAMES')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
 2100 CONTINUE
      ILISTL=I2
C
C               *****************************************************
C               **  STEP 3.1--                                     **
C               **  EXTRACT THE RIGHT-SIDE FUNCTIONAL              **
C               **  EXPRESSION FROM THE INPUT COMMAND LINE         **
C               **  (STARTING WITH THE FIRST NON-BLANK LOCATION    **
C               **  AFTER THE                                      **
C               **  EQUAL SIGN AND ENDING WITH THE END OF THE LINE **
C               **  OR WITH THE LAST NON-BLANK CHARACTER BEFORE    **
C               **  WRT  .                                         **
C               **  PLACE THE FUNCTION IN IFUNC2(.)  .             **
C               *****************************************************
C
      ISTEPN='3.1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'NDER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWD1=IHARG(4)
      IWD12=IHARG2(4)
      IWD2='WRT '
      IWD22='    '
      CALL DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
     1            IFUNC2,N2,IBUGA3,IFOUND,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      IF(IFOUND.EQ.'NO')THEN
        IWD1=IHARG(4)
        IWD12=IHARG2(4)
        IWD2='FOR '
        IWD22='    '
        CALL DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
     1              IFUNC2,N2,IBUGA3,IFOUND,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IF(IFOUND.EQ.'NO')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,3101)
 3101     FORMAT('***** ERROR IN NUMERICAL DERIVATIVE--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,3102)
 3102     FORMAT('      INVALID COMMAND FORM FOR INTEGRATION.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,3103)
 3103     FORMAT('      GENERAL FORM--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,3104)
 3104     FORMAT('      LET ... = NUMERICAL DERIVATIVE ... WRT  ... ',
     1           'FOR ... = ...')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,3105)
 3105     FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,3106)(IANS(I),I=1,MIN(100,IWIDTH))
 3106       FORMAT('      ',100A1)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
        ENDIF
      ENDIF
C
C               ******************************************************
C               **  STEP 4--                                        **
C               **  DETERMINE IF THE EXPRESSION HAS ANY FUNCTION    **
C               **  NAMES.  INBEDDED.  IF SO, REPLACE THE FUNCTION  **
C               **  NAMES  BY EACH                                  **
C               **  FUNCTION'S DEFINITION.  DO SO REPEATEDLY        **
C               **  UNTIL ALL FUNCTION REFERENCES HAVE BEEN         **
C               **  ANNIHILATED AND THE EXPRESSION IS LEFT ONLY WITH**
C               **  CONSTANTS, PARAMETERS, AND VARIABLES--NO        **
C               **  FUNCTIONS.  PLACE THE                           **
C               **  RESULTING FUNCTIONAL EXPRESSION INTO IFUNC3(.)  **
C               ******************************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'NDER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPEXFU(IFUNC2,N2,IHNAME,IHNAM2,IUSE,IVSTAR,IVSTOP,
     1NUMNAM,IANS,IWIDTH,IFUNC,NUMCHF,MAXCHF,IFUNC3,N3,MAXN3,
     1IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'NDER')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        ILAB(1)='INPU'
        ILAB(2)='T FU'
        ILAB(3)='NCTI'
        ILAB(4)='ON  '
        ILAB(5)='    '
        ILAB(6)='  = '
        NUMWDL=6
        CALL DPPRIF(ILAB,NUMWDL,IFUNC3,N3,IBUGA3)
        WRITE(ICOUT,5081)IDUMV(1),IDUMV2(1)
 5081   FORMAT('DIFFERATION VARIABLE  = ',A4,A4)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
C
C               *************************************
C               **  STEP 5--                       **
C               **  EXTRACT QUALIFIER INFORMATION. **
C               *************************************
C
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'NDER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *************************************************
C               **  STEP 5.1--                                 **
C               **  DETERMINE THE DUMMY VARIABLE FOR THE       **
C               **  DIFFERENTIATION.                           **
C               *************************************************
C
      ISTEPN='5.1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'NDER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NRIGHT=-1
C
      IKEY='WRT '
      IKEY2='    '
      ISHIFT=1
      ILOCA=1
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO5119
      IDUMV(1)=IHOUT
      IDUMV2(1)=IHOUT2
      IZNAME=IDUMV(1)
      IZNAM2=IDUMV2(1)
C
C  CHECK TO SEE IF DUMMY VARIABLE IS ALREADY DEFINED AS A
C  VARIABLE (USE THESE VALUES IF NO FOR CLAUSE SPECIFIED)
C
      IHWUSE='V'
      MESSAG='NO'
      CALL CHECKN(IZNAME,IZNAM2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'NO')THEN
        ICOLR=IVALUE(ILOCV)
        NRIGHT=IN(ILOCV)
      ENDIF
C
      NUMDV=1
      GOTO5190
 5119 CONTINUE
C
      IKEY='FOR '
      IKEY2='    '
      ISHIFT=1
      ILOCA=1
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO5129
      IDUMV(1)=IHOUT
      IDUMV2(1)=IHOUT2
      IZNAME=IDUMV(1)
      IZNAM2=IDUMV2(1)
C
C  CHECK TO SEE IF DUMMY VARIABLE IS ALREADY DEFINED AS A
C  VARIABLE (USE THESE VALUES IF NO FOR CLAUSE SPECIFIED)
C
      IHWUSE='V'
      MESSAG='NO'
      CALL CHECKN(IZNAME,IZNAM2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'NO')THEN
        ICOLR=IVALUE(ILOCV)
        NRIGHT=IN(ILOCV)
      ENDIF
C
      NUMDV=1
      GOTO5190
 5129 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5181)
 5181 FORMAT('***** ERROR IN NUMERICAL DIFFERENTIATION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5182)
 5182 FORMAT('      INVALID COMMAND FORM FOR DIFFERENTIATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5183)
 5183 FORMAT('      NO VARIABLE OF DIFFERENTIATION DEFINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5185)
 5185 FORMAT('      GENERAL FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5186)
 5186 FORMAT('      LET ... = NUMERICAL DERIVATIVE ... WRT ... ',
     1'FOR ... = ... TO ...')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5187)
 5187 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,5189)(IANS(I),I=1,MIN(100,IWIDTH))
 5189   FORMAT('      ',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
 5190 CONTINUE
C
C               **************************************************
C               **  STEP 5.2--                                  **
C               **  DETERMINE THE POINT AT WHICH TO COMPUTE THE **
C               **  DERIVATIVE.                                 **
C               **************************************************
C
      ISTEPN='5.2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'NDER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMLIM=0
C
      IKEY='FOR '
      IKEY2='    '
      ISHIFT=3
      ILOCA=1
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IFOUN1.EQ.'NO'.AND.IFOUN2.EQ.'NO')THEN
        IF(NRIGHT.GT.0)THEN
          DO5215J=1,NRIGHT
            IJ=MAXN*(ICOLR-1)+J
            IF(ICOLR.LE.MAXCOL)XFULL(J)=V(IJ)
            IF(ICOLR.EQ.MAXCP1)XFULL(J)=PRED(I)
            IF(ICOLR.EQ.MAXCP2)XFULL(J)=RES(I)
            IF(ICOLR.EQ.MAXCP3)XFULL(J)=YPLOT(I)
            IF(ICOLR.EQ.MAXCP4)XFULL(J)=XPLOT(I)
            IF(ICOLR.EQ.MAXCP5)XFULL(J)=X2PLOT(I)
            IF(ICOLR.EQ.MAXCP6)XFULL(J)=TAGPLO(I)
 5215     CONTINUE
        ELSE
          GOTO5219
        ENDIF
      ENDIF
      X0=VOUT
      NUMLIM=NUMLIM+1
      ILOCMX=ILOC2
 5219 CONTINUE
C
CCCCC CHECK TO SEE IF DIFFERENTIATION VARIABLE HAS BEEN PREVIOUSLY
CCCCC DEFINED.
C
      IF(NUMLIM.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5281)
 5281   FORMAT('***** ERROR IN NUMERICAL DERIVATIVE--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5282)
 5282   FORMAT('      INVALID COMMAND FORM FOR DIFFERENTIATION.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5283)
 5283   FORMAT('      THE POINT AT WHICH TO COMPUTE THE NUMERICAL ',
     1         'DERIVATIVE IS NOT DEFINED.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5286)
 5286   FORMAT('      GENERAL FORM--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5287)
 5287   FORMAT('      LET ... = NUMERICAL DERIVATIVE ... WRT ... ',
     1         'FOR ... = ...')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5288)
 5288   FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,5289)(IANS(I),I=1,MIN(100,IWIDTH))
 5289     FORMAT('      ',100A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               **********************************************
C               **  STEP 6.3--                              **
C               **  SCAN THE QUALIFIERS FOR VARIABLE,       **
C               **  PARAMETER, FUNCTION, AND VALUE CHANGES  **
C               **  IN THE FUNCTION.                        **
C               **********************************************
C
      ISTEPN='6.3'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'NDER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NCHANG=0
      DO6300IFORI=1,10
C
        IKEY='FOR '
        IKEY2='    '
        ISHIFT=1
        IF(IFORI.EQ.1)ILOCA=ILOCMX
        IF(IFORI.NE.1)ILOCA=ILOC3
        ILOCB=NUMARG
        INCLUN='NO'
        CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1  IHARG,IHARG2,NUMARG,
     1  INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1  IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1  INOUT,IBUGA3,IERROR)
        IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO'.AND.IERROR.EQ.'NO')GOTO6350
C
        ILOC3=ILOC2+2
        IF(IERROR.EQ.'YES' .OR. ILOC3.GT.NUMARG)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,6301)
 6301     FORMAT('***** ERROR IN NUMERICAL DERIVATIVE--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,6302)
 6302     FORMAT('      INVALID COMMAND FORM FOR DIFFERENTATION.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,6303)
 6303     FORMAT('      GENERAL FORM--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,6304)
 6304     FORMAT('      LET FUNCTION ... = NUMERICAL DERIVATIVE ... ',
     1           'WRT ... FOR ... = ...')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,6305)
 6305     FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,6306)(IANS(I),I=1,MIN(100,IWIDTH))
 6306       FORMAT('      ',100A1)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
        ENDIF
        NCHANG=NCHANG+1
        IOLD(NCHANG)=IHARG(ILOC2)
        IOLD2(NCHANG)=IHARG2(ILOC2)
        INEW(NCHANG)=IHARG(ILOC3)
        INEW2(NCHANG)=IHARG2(ILOC3)
C
 6300 CONTINUE
 6350 CONTINUE
C
 6390 CONTINUE
C
C               **********************************************
C               **  STEP 6.4--                              **
C               **  CARRY OUT THE VARIABLE,                 **
C               **  PARAMETER, AND FUNCTION CHANGES         **
C               **  AND THEN PRINT OUT A BRIEF MESSAGE      **
C               **  INDICATING THAT THE CHANGES             **
C               **  HAVE BEEN MADE.                         **
C               **********************************************
C
      ISTEPN='6.4'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'NDER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO6490
      IF(IFEEDB.EQ.'OFF')GOTO6490
      IF(NCHANG.LE.0)GOTO6490
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      ILAB(1)='PRE '
      ILAB(2)='-CHA'
      ILAB(3)='NGE '
      ILAB(4)='FUNC'
      ILAB(5)='TION'
      ILAB(6)='  = '
      NUMWDL=6
      CALL DPPRIF(ILAB,NUMWDL,IFUNC3,N3,IBUGA3)
C
      CALL COMPIC(IFUNC3,N3,IOLD,IOLD2,INEW,INEW2,NCHANG,IFUNC3,N3,
     1IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      ILAB(1)='POST'
      ILAB(2)='-CHA'
      ILAB(3)='NGE '
      ILAB(4)='FUNC'
      ILAB(5)='TION'
      ILAB(6)='  = '
      NUMWDL=6
      CALL DPPRIF(ILAB,NUMWDL,IFUNC3,N3,IBUGA3)
C
 6490 CONTINUE
C
C               *******************************************************
C               **  STEP 6.7--                                       **
C               **  MAKE A NON-CALCULATING PASS AT THE FUNCTION      **
C               **  SO AS TO EXTRACT ALL PARAMETER AND VARIABLE NAMES.*
C               *******************************************************
C
      ISTEPN='6.8'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'NDER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C
      IPASS=1
      CALL COMPIM(IFUNC3,N3,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,AJUNK,
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      IZNDEX=1
      DO6493I=1,NUMPV
        IF(IPARN(I).EQ.IZNAME .AND. IPARN2(I).EQ.IZNAM2)THEN
          IZNDEX=I
          GOTO6499
        ENDIF
 6493 CONTINUE
 6499 CONTINUE
C
C               ***********************************************
C               **  STEP 7--                                 **
C               **  CHECK THAT ALL PARAMETERS                **
C               **  IN THE FUNCTION ARE ALREADY PRESENT      **
C               **  IN THE AVAILABLE NAME LIST IHNAME(.).    **
C               ***********************************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'NDER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IP=0
      IV=0
      IF(NUMPV.LE.0)GOTO7650
      DO7600J=1,NUMPV
        IHPARN=IPARN(J)
        IHPAR2=IPARN2(J)
        IF(IHPARN.EQ.IDUMV(1).AND.IHPAR2.EQ.IDUMV2(1))THEN
          IV=IV+1
          LOCDUM=J
          GOTO7600
        ENDIF
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHPARN,IHPAR2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
        IF(IERRO2.EQ.'YES')THEN
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7611)
 7611     FORMAT('***** ERROR IN NUMERICAL DERIVATIVE--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7612)
 7612     FORMAT('      A PARAMETER/FUNCTION HAS BEEN ENCOUNTERED')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7613)
 7613     FORMAT('      IN THE FUNCTION TO BE DIFFERENTIATED')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7614)
 7614     FORMAT('      WHICH HAS NOT YET BEEN DEFINED')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7615)
 7615     FORMAT('      THE UNKNOWN PARAMETER/FUNCTION = ',A4,A4)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7616)
 7616     FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,7617)(IANS(I),I=1,MIN(100,IWIDTH))
 7617       FORMAT('      ',100A1)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
        ENDIF
C
        IP=IP+1
        PARAM(J)=VALUE(ILOCP)
 7600 CONTINUE
 7650 CONTINUE
C
C               ******************************
C               **  STEP 8--                **
C               **  COMPUTE THE DERIVATIVE  **
C               ******************************
C
      ISTEPN='8'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'NDER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'NDER')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7711)
 7711   FORMAT('***** FROM DPNDER, IMMEDIATELY BEFORE CALLING ',
     1         'DPNDE2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7712)N3,NUMPV
 7712   FORMAT('N3,NUMPV = ',I8,I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7713)NUMDV,X0,XDER,NRIGHT
 7713   FORMAT('NUMDV,X0,XDER,NRIGHT = ',I8,2E15.7,I8)
        CALL DPWRST('XXX','BUG ')
        DO7714I=1,NUMDV
          WRITE(ICOUT,7715)I,IDUMV(I),IDUMV2(I)
 7715     FORMAT('I,IDUMV(I),IDUMV2(I) = ',I8,2X,A4,A4)
          CALL DPWRST('XXX','BUG ')
 7714   CONTINUE
        WRITE(ICOUT,7716)IBUGA3,IBUGCO,IBUGEV
 7716   FORMAT('IBUGA3,IBUGCO,IBUGEV = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C  COPY OVER DUMMY COMMON BLOCKS FOR DUMFUN ROUTINE
C
      DO7805KK=1,MAXF3
        ZMODEL(KK)=IFUNC3(KK)
 7805 CONTINUE
      DO7810KK=1,IDUMCH
        ZTYPEH(KK)=ITYPEH(KK)
        ZW21HO(KK)=IW21HO(KK)
        ZW22HO(KK)=IW22HO(KK)
        Z2HOLD(KK)=W2HOLD(KK)
 7810 CONTINUE
      DO7820KK=1,IDUMC2
        ZPARAM(KK)=PARAM(KK)
        ZIPARN(KK)=IPARN(KK)
        ZPARN2(KK)=IPARN2(KK)
        ZIDUMV(KK)=IDUMV(KK)
        ZDUMV2(KK)=IDUMV2(KK)
 7820 CONTINUE
      NUMCHZ=N3
      NUMPVZ=NUMPV
      NWHOLZ=NWHOLD
      NUMDVZ=NUMDV
      IBUGAZ=IBUGA3
C
      IHP='XMIN'
      IHP2='    '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        XMIN=CPUMIN
      ELSE
        XMIN=VALUE(ILOCP)
      ENDIF
C
      IHP='XMAX'
      IHP2='    '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        XMAX=CPUMAX
      ELSE
        XMAX=VALUE(ILOCP)
      ENDIF
C
      IHP='XERR'
      IHP2='OR  '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        XERROR=CPUMIN
      ELSE
        XERROR=VALUE(ILOCP)
      ENDIF
C
      DO7889I=1,MAXOBV
        YDER(I)=0.0
 7889 CONTINUE
C
      CALL DPNDE2(X0,XDER,XMIN,XMAX,XERROR,
     1XFULL,YDER,NRIGHT,
     1IBUGA3,IBUGCO,IBUGEV,ISUBRO,IERROR)
C
C               *****************************************************
C               **  STEP 9--                                       **
C               **  ENTER THE DERIVATIVE VALUE INTO THE DATAPLOT   **
C               **  HOUSEKEEPING ARRAY                             **
C               *****************************************************
C
      ISTEPN='9'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'NDER')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHL=IHLEFT
      IHL2=IHLEF2
      ICASEL='P'
      IF(NRIGHT.GT.0)THEN
        ICASEL='V'
        XDER=YDER(1)
        IXDER=XDER+0.5
        CALL DPINVP(IHL,IHL2,ICASEL,YDER,NRIGHT,XDER,IXDER,
     1              ISUBN1,ISUBN2,IBUGA3,IERROR)
      ELSE
        ICASEL='P'
        IXDER=XDER+0.5
        BJUNK(1)=AJUNK
        NJUNK=1
        CALL DPINVP(IHL,IHL2,ICASEL,BJUNK,NJUNK,XDER,IXDER,
     1              ISUBN1,ISUBN2,IBUGA3,IERROR)
      ENDIF
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT      **
C               ****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'NDER')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END OF DPNDER--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IBUGA3
 9012   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)IBUGCO,IBUGEV
 9013   FORMAT('IBUGCO,IBUGEV = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)IBUGQ
 9014   FORMAT('IBUGQ = ',A4)
        CALL DPWRST('XXX','BUG ')
        DO9015I=1,NUMNAM
        WRITE(ICOUT,9016)I,IHNAME(I),IHNAM2(I),IUSE(I),
     1                   IVSTAR(I),IVSTOP(I)
 9016   FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I)=',
     1         I8,2X,A4,A4,2X,A4,I8,I8)
        CALL DPWRST('XXX','BUG ')
 9015   CONTINUE
        WRITE(ICOUT,9017)NUMCHF,MAXCHF,IWIDTH,N2
 9017   FORMAT('NUMCHF,MAXCHF,IWIDTH,N2 = ',4I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9018)(IFUNC(I),I=1,IWIDTH)
 9018   FORMAT('IFUNC(.) = ',115A1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9019)(IFUNC2(I),I=1,N2)
 9019   FORMAT('IFUNC2(.) = ',115A1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9020)N3
 9020   FORMAT('N3 = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9021)(IFUNC3(I),I=1,N3)
 9021   FORMAT('IFUNC3(.) = ',115A1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9022)NUMPV
 9022   FORMAT('NUMPV = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9023)IP,IV,IDUMV(1),IDUMV2(1),LOCDUM
 9023   FORMAT('IP,IV,IDUMV(1),IDUMV2(1),LOCDUM = ',I8,I8,2X,A4,A4,I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9024)IHLEFT,IHLEF2
 9024   FORMAT('IHLEFT,IHLEF2 = ',A4,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9025)ICASEL,IFOUND,IERROR
 9025   FORMAT('ICASEL,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9026)XMIN,XMAX,XDER
 9026   FORMAT('XMIN,XMAX,XDER = ',3E15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPNDE2(X0,XDER,XMIN,XMAX,XERROR,
     1XFULL,YDER,N,
     1IBUGA3,IBUGCO,IBUGEV,ISUBRO,IERROR)
C
C     PURPOSE--COMPUTE THE DERIVATIVE OF A FUNCTION AT THE POINT X0.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/1
C     ORIGINAL VERSION--JANUARY   2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      REAL XFULL(*)
      REAL YDER(*)
C
      REAL DUMFUN
      EXTERNAL DUMFUN
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='DPND'
      ISUBN2='E2  '
C
      IORD=1
      IF(XERROR.EQ.CPUMIN)THEN
        EPS=0.0001
      ELSE
        EPS=XERROR
      ENDIF
      ACCUR=0.0
      IFAIL=0
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'NDE2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPNDE2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA3,IBUGCO,IBUGEV
   52   FORMAT('IBUGA3,IBUGCO,IBUGEV = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,62)X0,EPS
   62   FORMAT('X0,EPS = ',2E15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,64)N
   64   FORMAT('N = ',I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***************************************************
C               **  STEP 1--                                     **
C               **  CALL DIFF ROUTINE (FROM CMLIB) TO COMPUTE    **
C               **  THE DERIVATIVE.                              **
C               ***************************************************
C
      IF(N.LE.0)THEN
        CALL DIFF(IORD,X0,XMIN,XMAX,DUMFUN,EPS,ACCUR,XDER,ERROR,IFAIL)
C
        IF(IFAIL.EQ.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,301)
  301     FORMAT('***** WARNING IN NUMERICAL DERIVATIVE--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,303)
  303     FORMAT('      THE ESTIMATED ERROR IN THE RESULT EXCEEDS THE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,305)
  305     FORMAT('      REQUESTED ERROR, BUT THE MOST ACCURATE RESULT')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,307)
  307     FORMAT('      POSSIBLE HAS BEEN RETURNED.')
          CALL DPWRST('XXX','BUG ')
        ELSEIF(IFAIL.EQ.2)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,311)
  311     FORMAT('***** ERROR IN NUMERICAL DERIVATIVE--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,313)
  313     FORMAT('      ERROR IN THE INPUT TO THE DIFF ROUTINE.')
          CALL DPWRST('XXX','BUG ')
          XDER=0.0
          ERROR=0.0
          IERROR='YES'
          GOTO9000
        ELSEIF(IFAIL.EQ.3)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,321)
  321     FORMAT('***** ERROR IN NUMERICAL DERIVATIVE--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,323)
  323     FORMAT('      THE INTERVAL FOR DIFFERENTIATION, (',G15.7,
     1           ',',G15.7,')')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,325)
  325     FORMAT('      IS TOO SMALL.')
          CALL DPWRST('XXX','BUG ')
          XDER=0.0
          ERROR=0.0
          IERROR='YES'
          GOTO9000
        ENDIF
      ELSE
        DO400I=1,N
          X0=XFULL(I)
          CALL DIFF(IORD,X0,XMIN,XMAX,DUMFUN,EPS,ACCUR,XDER,
     1              ERROR,IFAIL)
          YDER(I)=XDER
C
          IF(IFAIL.EQ.1)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,401)X0
  401       FORMAT('***** WARNING IN NUMERICAL DERIVATIVE AT ',G15.7)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,403)
  403       FORMAT('      THE ESTIMATED ERROR IN THE RESULT EXCEEDS ',
     1             'THE')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,405)
  405       FORMAT('      REQUESTED ERROR, BUT THE MOST ACCURATE ',
     1             'RESULT')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,407)
  407       FORMAT('      POSSIBLE HAS BEEN RETURNED.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFAIL.EQ.2)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,411)X0
  411       FORMAT('***** ERROR IN NUMERICAL DERIVATIVE AT ',G15.7)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,413)
  413       FORMAT('      ERROR IN THE INPUT TO THE DIFF ROUTINE.')
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IFAIL.EQ.4)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,421)X0
  421       FORMAT('***** ERROR IN NUMERICAL DERIVATIVE AT ',G15.7)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,423)
  423       FORMAT('      THE INTERVAL FOR DIFFERENTIATION, (',G15.7,
     1           ',',G15.7,')')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,425)
  425       FORMAT('      IS TOO SMALL.')
            CALL DPWRST('XXX','BUG ')
          ENDIF
  400   CONTINUE
      ENDIF
C
      IF(IFEEDB.EQ.'ON' .AND. N.LE.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3511)X0,XDER
 3511   FORMAT('AT X0 = ',G15.7,' THE DERIVATIVE VALUE  = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3513)ERROR
 3513   FORMAT('(WITH ESTIMATED ERROR = ',G15.7,')')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'NDE2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPNDE2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)ERROR,XMIN,XMAX,X0,XDER
 9012   FORMAT('ERROR,XMIN,XMAX,X0,XDER = ',5G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)IERROR
 9014   FORMAT('IERROR = ',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPNEGA(IHARG,NUMARG,INEGSW,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE NEGATIVE SWITCH INEGSW
C              (WHICH IS USEFUL, FOR EXAMPLE, IN GENERATING
C              HANGING HISTOGRAMS).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--INEGSW  ('ON'  OR 'OFF')
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1978.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 INEGSW
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1150
      IF(NUMARG.GE.1)GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1160
      GOTO1199
C
 1150 CONTINUE
      INEGSW='ON'
      GOTO1180
C
 1160 CONTINUE
      INEGSW='OFF'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)INEGSW
 1181 FORMAT('THE NEGATIVE SWITCH HAS JUST BEEN TURNED ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPNEWS(IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DISPLAY DATAPLOT NEWS
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--OCTOBER   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1985.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*80 IFILE
      CHARACTER*12 ISTAT
      CHARACTER*12 IFORM
      CHARACTER*12 IACCES
      CHARACTER*12 IPROT
      CHARACTER*12 ICURST
      CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*80 ISTRIN
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOF2.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPNE'
      ISUBN2='WS  '
C
      IFOUND='YES'
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'NEWS')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPNEWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR
   53 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,54)IWIDTH
CCC54 FORMAT('IWIDTH = ',I8)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)INEWNU
   61 FORMAT('INEWNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)INEWNA
   62 FORMAT('INEWNA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)INEWST
   63 FORMAT('INEWST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)INEWFO
   64 FORMAT('INEWFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)INEWAC
   65 FORMAT('INEWAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)INEWFO
   66 FORMAT('INEWFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)INEWCS
   67 FORMAT('INEWCS = ',A12)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************
C               **  STEP 11--           **
C               **  COPY OVER VARIABLES **
C               **************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'NEWS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=INEWNU
      IFILE=INEWNA
      ISTAT=INEWST
      IFORM=INEWFO
      IACCES=INEWAC
      IPROT=INEWPR
      ICURST=INEWCS
C
      ISUBN0='NEWS'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'NEWS')GOTO1199
      WRITE(ICOUT,1193)IOUNIT
 1193 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1194)IFILE
 1194 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1195)ISTAT,IFORM,IACCES,IPROT,ICURST
 1195 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1196)ISUBN0,IERRFI
 1196 FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1199 CONTINUE
C
C               ****************************************
C               **  STEP 12--                         **
C               **  CHECK TO SEE IF NEWS FILE EXISTS  **
C               ****************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'NEWS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')GOTO1200
      GOTO1290
 1200 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPNEWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE DESIRED NEWS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      CANNOT BE GIVEN BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      THE REQUIRED SYSTEM MASS STORAGE FILE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      WHICH STORES SUCH NEWS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      IS NOT AVAILABLE AT THIS INSTALLATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)ISTAT,INEWST
 1217 FORMAT('ISTAT,INEWST = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1290 CONTINUE
C
C               *********************
C               **  STEP 31--      **
C               **  OPEN THE FILE  **
C               *********************
C
      ISTEPN='31'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'NEWS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
C               ******************************
C               **  STEP 41--               **
C               **  READ THE FILE.          **
C               **  WRITE OUT THE NEWS.     **
C               ******************************
C
      ISTEPN='41'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MESS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ANUMLI=0.0
      READ(IOUNIT,4111,END=4190)ANUMLI
 4111 FORMAT(F10.0)
      NUMLIN=ANUMLI+0.5
C
      IF(NUMLIN.LE.0)GOTO4190
      DO4120I=1,NUMLIN
      READ(IOUNIT,4121,END=4190)(ISTRIN(J:J),J=1,80)
 4121 FORMAT(80A1)
      CALL DPDB80(ISTRIN,JMAX,IBUGS2,ISUBRO,IERROR)
      IF(JMAX.GE.1)WRITE(ICOUT,4122)(ISTRIN(J:J),J=1,JMAX)
 4122 FORMAT(5X,80A1)
      IF(JMAX.GE.1)CALL DPWRST('XXX','BUG ')
      IF(JMAX.LE.0)WRITE(ICOUT,999)
      IF(JMAX.LE.0)CALL DPWRST('XXX','BUG ')
 4120 CONTINUE
 4190 CONTINUE
C
C               ***********************
C               **  STEP 51--        **
C               **  CLOSE THE FILE.  **
C               ***********************
C
      ISTEPN='51'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'NEWS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'NEWS')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPNEWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR
 9012 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IOUNIT
 9021 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IFILE
 9022 FORMAT('IFILE  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)ISTAT
 9023 FORMAT('ISTAT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)IFORM
 9024 FORMAT('IFORM  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)IACCES
 9025 FORMAT('IACCES = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)IPROT
 9026 FORMAT('IPROT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)ICURST
 9027 FORMAT('ICURST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IENDFI
 9028 FORMAT('IENDFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IREWIN
 9029 FORMAT('IREWIN = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)ISUBN0
 9031 FORMAT('ISUBN0 = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IERRFI
 9032 FORMAT('IERRFI = ',A12)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPNORM(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1IX1TSC,IX2TSC,IY1TSC,IY2TSC,
     1IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--FORM A NORMAL PLOT
C              (= A NORMAL PROBABILITY PLOT
C              BUT WITH DATA ON HORIZONTAL AXIS
C              AND WITH NEAT PROBABILITY VALUES
C              ON THE VERTICAL AXIS).
C     EXAMPLE--NORMAL PLOT Y
C              NORMAL PLOT Y TAG
C     NOTE--NORMALLY THIS COMMAND HAS 1 ARGUMENT.
C           ARGUMENT 1 IS THE RESPONSE VARIABLE
C           IF THE NORMAL PLOT COMMAND HAS ONLY
C           1 ARGUMENT, THEN IT IS ASSUMED THAT ALL
C           OF THE DATA IS TO BE INCLUDED
C           (THAT IS, NO CENSORING).
C     NOTE--SOMETIMES THIS COMMAND HAS 2 ARGUMENTS--
C           ARGUMENT 1 IS THE RESPONSE VARIABLE
C           ARGUMENT 2 IS THE CENSOR-TAG VARIABLE
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--90/6
C     ORIGINAL VERSION--MAY       1990.
C     UPDATED         --APRIL     1992. DEFINE CUTOFF (ALAN)
C     UPDATED         --APRIL     1992. SPLIT 'SIGMA'
C     UPDATED         --APRIL     1992. COMMENT OUT IHRI3./4.
C     UPDATED         --MAY       1995. ADD LINE TO EQUIVALENCE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
C
      CHARACTER*4 IX1TSC
      CHARACTER*4 IX2TSC
      CHARACTER*4 IY1TSC
      CHARACTER*4 IY2TSC
C
      CHARACTER*4 IX1TSV
      CHARACTER*4 IX2TSV
      CHARACTER*4 IY1TSV
      CHARACTER*4 IY2TSV
C
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IHRI11
      CHARACTER*4 IHRI12
      CHARACTER*4 IHRI21
      CHARACTER*4 IHRI22
CCCCC THE FOLLOWING 4 LINES WERE COMMENTED OUT   APRIL 1992
CCCCC CHARACTER*4 IHRI31
CCCCC CHARACTER*4 IHRI32
CCCCC CHARACTER*4 IHRI41
CCCCC CHARACTER*4 IHRI42
      CHARACTER*4 IHRIX1
      CHARACTER*4 IHRIX2
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IERRO4
C
      CHARACTER*4 ICTAR1
      CHARACTER*4 ICTAR2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
CCCCC THE FOLLOWING LINE WAS ADDED   APRIL 1992
      INCLUDE 'DPCOHO.INC'
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOZI.INC'
      DIMENSION YS(MAXOBV)
      DIMENSION TAGC2(MAXOBV)
      DIMENSION ITAGC2(MAXOBV)
      DIMENSION WAR(MAXOBV)
      DIMENSION WMR(MAXOBV)
      DIMENSION WMRT(MAXOBV)
      DIMENSION YST(MAXOBV)
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
      EQUIVALENCE (GARBAG(IGARB3),YS(1))
      EQUIVALENCE (GARBAG(IGARB4),TAGC2(1))
      EQUIVALENCE (GARBAG(IGARB5),YST(1))
      EQUIVALENCE (GARBAG(IGARB6),WAR(1))
      EQUIVALENCE (GARBAG(IGARB7),WMRT(1))
CCCCC MAY 1995.  ADD FOLLOWING LINE TO EQUIVALENCE
      EQUIVALENCE (GARBAG(IGARB8),WMR(1))
      EQUIVALENCE (IGARBG(IIGAR1),ITAGC2(1))
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPNO'
      ISUBN2='RM  '
C
      IFOUND='NO'
      IERROR='NO'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MINN2=2
C
      SIGMA=(-999.0)
      AMU=(-999.0)
      SDSIGM=(-999.0)
      SDAMU=(-999.0)
      BPT1=(-999.0)
      BPT5=(-999.0)
      B1=(-999.0)
      B5=(-999.0)
      B10=(-999.0)
      B20=(-999.0)
      B50=(-999.0)
      B80=(-999.0)
      B90=(-999.0)
      B95=(-999.0)
      B99=(-999.0)
      B995=(-999.0)
      B999=(-999.0)
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED   APRIL 1992
      ICUTMX=NUMBPW
      IF(IHOST1.EQ.'CDC '.OR.IHOST1.EQ.'CYBE')ICUTMX=48
      IF(IHOST1.EQ.'205 ')ICUTMX=48
      CUTOFF=2**(ICUTMX-3)
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'NORM')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPNORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NPLOTV,NPLOTP,NS
   52 FORMAT('NPLOTV,NPLOTP,NS = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,IAND1,IAND2
   53 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IANGLU,IBUGG2,IBUGG3,IBUGQ
   54 FORMAT('IANGLU,IBUGG2,IBUGG3,IBUGQ = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)ICASPL,MAXN
   56 FORMAT('ICASPL,MAXN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IFOUND,IERROR
   57 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)MAXNPP
   58 FORMAT('MAXNPP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IX1TSC,IX2TSC,IY1TSC,IY2TSC
   61 FORMAT('IX1TSC,IX2TSC,IY1TSC,IY2TSC = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IX1TSV,IX2TSV,IY1TSV,IY2TSV
   62 FORMAT('IX1TSV,IX2TSV,IY1TSV,IY2TSV = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***********************************
C               **  TREAT THE NORMAL  PLOT CASE  **
C               ***********************************
C
C               ***************************
C               **  STEP 11--            **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'NORM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO1110
      GOTO9000
C
 1110 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO1190
C
 1190 CONTINUE
      IFOUND='YES'
      ICASPL='NORM'
C
C               ********************************************************
C               **  STEP 12--                                         **
C               **  CARRY OUT A GENERAL CHECK FOR THE                 **
C               **  PROPER NUMBER OF INPUT ARGUMENTS                  **
C               **  (IT SHOULD BE 1 OR 2).                            **
C               ********************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'NORM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               *****************************************
C               **  STEP 13--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='13'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'NORM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1390
      DO1300J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO1310
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO1310
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO1320
 1300 CONTINUE
      GOTO1390
 1310 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1390
 1320 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1390
 1390 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'NORM')GOTO1395
      WRITE(ICOUT,1391)ICASEQ,NUMARG,ILOCQ
 1391 FORMAT('ICASEQ,NUMARG,ILOCQ = ',A4,2X,2I8)
      CALL DPWRST('XXX','BUG ')
 1395 CONTINUE
C
C               ********************************************************
C               **  STEP 14--                                         **
C               **  CARRY OUT A SPECIFIC CHECK FOR THE                **
C               **  PROPER NUMBER OF INPUT ARGUMENTS                  **
C               **  (IT SHOULD BE 1 OR 2).                            **
C               ********************************************************
C
      ISTEPN='14'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'NORM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=ILOCQ-1
      IF(NUMVAR.EQ.1)GOTO1490
      IF(NUMVAR.EQ.2)GOTO1490
      GOTO1410
C
 1410 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPNORM--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MECC')WRITE(ICOUT,1412)
 1412 FORMAT('      FOR A NORMAL PLOT, ')
      IF(ICASPL.EQ.'MECC')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1418)
 1418 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1419)
 1419 FORMAT('      MUST BE EITHER 1 OR 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1420)
 1420 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1421)
 1421 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1422)NUMVAR
 1422 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1423)
 1423 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1424)(IANS(I),I=1,IWIDTH)
 1424 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1490 CONTINUE
C
C               ****************************************************************
C               **  STEP 15--                                                  *
C               **  EXAMINE THE VARIABLES--                                    *
C               **  HAS EACH VARIABLE                                          *
C               **  ALREADY BEEN DEFINED?                                      *
C               **  NOTE THAT     ILISR1, ILISR2,                              *
C               **  IS THE LINE IN THE TABLE                                   *
C               **  OF THE FIRST, SECOND                VARIABLE               *
C               **  RESPECTIVELY.                                              *
C               **  NOTE THAT     ICOLR1, ICOLR2,                              *
C               **  IS THE DATA COLUMN (1 TO 10+6)                             *
C               **  OF THE FIRST, SECOND                VARIABLE               *
C               **  RESPECTIVELY.                                              *
C               ****************************************************************
C
      ISTEPN='15'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'NORM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICTAR1='FIRS'
      ICTAR2='T   '
      ILOCR1=1
      IHRI11=IHARG(ILOCR1)
      IHRI12=IHARG2(ILOCR1)
      IHRIX1=IHRI11
      IHRIX2=IHRI12
      DO1510I=1,NUMNAM
      I2=I
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1519
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1510 CONTINUE
      GOTO1570
 1519 CONTINUE
      ILISR1=I2
      ICOLR1=IVALUE(ILISR1)
      NIRIG1=IN(ILISR1)
C
      IF(NUMVAR.LE.1)GOTO1590
      ICTAR1='SECO'
      ICTAR2='ND  '
      ILOCR2=2
      IHRI21=IHARG(ILOCR2)
      IHRI22=IHARG2(ILOCR2)
      IHRIX1=IHRI21
      IHRIX2=IHRI22
      DO1520I=1,NUMNAM
      I2=I
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1529
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1520 CONTINUE
      GOTO1570
 1529 CONTINUE
      ILISR2=I2
      ICOLR2=IVALUE(ILISR2)
      NIRIG2=IN(ILISR2)
      GOTO1590
C
 1560 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1561)
 1561 FORMAT('***** ERROR IN DPNORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1562)ICTAR1,ICTAR2
 1562 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1565)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1563)IHRIX1,IHRIX2
 1563 FORMAT('      (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
 1565 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      WRITE(ICOUT,1566)
 1566 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1567)
 1567 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1568)
 1568 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1569)(IANS(I),I=1,IWIDTH)
 1569 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1571)
 1571 FORMAT('***** ERROR IN DPNORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1572)ICTAR1,ICTAR2
 1572 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1573)IHRIX1,IHRIX2
 1573 FORMAT('      (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1575)
 1575 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1576)
 1576 FORMAT('      OF AVAILABLE VARIABLE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1577)IHRI11,IHRI12
 1577 FORMAT('      THE VARIABLE IN QUESTION WAS ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1578)
 1578 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1579)(IANS(I),I=1,IWIDTH)
 1579 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1590 CONTINUE
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  CHECK THAT VARIABLES 1 AND 2       HAVE         **
C               **  THE SAME NUMBER OF ELEMENTS.                    **
C               ******************************************************
C
 2100 CONTINUE
      ISTEPN='21'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'NORM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMVAR.LE.1)GOTO2190
      IF(NIRIG1.EQ.NIRIG2)GOTO2190
C
 2110 CONTINUE
      WRITE(ICOUT,2111)
 2111 FORMAT('***** ERROR IN DPNORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2113)
 2113 FORMAT('      THE NUMBER OF OBSERVATIONS IN VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2114)
 2114 FORMAT('      1 AND 2 MUST BE THE SAME;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2115)
 2115 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2116)IHRI11,IHRI12,NIRIG1
 2116 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2117)IHRI21,IHRI22,NIRIG2
 2117 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2120)
 2120 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2121)(IANS(I),I=1,IWIDTH)
 2121 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2190 CONTINUE
C
C               *********************************************
C               **  STEP 32--                              **
C               **  FORM THE VECTOR ISUB(.)                **
C               **  DEPENDING ON THE TYPE OF CASE          **
C               **  FOR THE QUALIFIER.                     **
C               **  BRANCH TO THE PROPER CASE.             **
C               *********************************************
C
      ISTEPN='32'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'NORM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NLOCAL=NIRIG1
C
      IF(ICASEQ.EQ.'FULL')GOTO3210
      IF(ICASEQ.EQ.'SUBS')GOTO3220
      IF(ICASEQ.EQ.'FOR')GOTO3230
C
 3210 CONTINUE
      DO3215I=1,NLOCAL
      ISUB(I)=1
 3215 CONTINUE
      NQ=NLOCAL
      GOTO3250
C
 3220 CONTINUE
      NIOLD=NLOCAL
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NIOLD
      GOTO3250
C
 3230 CONTINUE
      NIOLD=NLOCAL
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NFOR
      GOTO3250
C
 3250 CONTINUE
      IF(NQ.GE.MINN2)GOTO3290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3251)
 3251 FORMAT('***** ERROR IN DPNORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3252)
 3252 FORMAT('      AFTER THE APPROPRIATE SUBSET ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3253)
 3253 FORMAT('      HAS BEEN EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3254)IHRI11,IHRI12
 3254 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3255)
 3255 FORMAT('      (FOR WHICH AN NORMAL PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3256)
 3256 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3257)MINN2
 3257 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3258)NQ
 3258 FORMAT('      SUCH WAS NOT THE CASE HERE (NQ = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3259)
 3259 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3260)(IANS(I),I=1,IWIDTH)
 3260 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3290 CONTINUE
C
C               **********************************************
C               **  STEP 33--                               **
C               **  FORM THE SUBSETTED VARIABLES            **
C               **       Y1(.)                              **
C               **       Y2(.)                              **
C               **  CONTAINING                              **
C               **       THE RESPONSE VARIABLE              **
C               **       THE CENSOR-TAG VARIABLE            **
C               **  RESPECTIVELY.                           **
C               **********************************************
C
      ISTEPN='33'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'NORM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      IMAX=NIRIG1
      IF(NQ.LT.NIRIG1)IMAX=NQ
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'NORM')
     1WRITE(ICOUT,780)N,NIRIG1,NQ,IMAX
  780 FORMAT(' N,NIRIG1,NQ,IMAX = ',4I8)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'NORM')
     1CALL DPWRST('XXX','BUG ')
      DO3300I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3300
      J=J+1
C
      IJ=MAXN*(ICOLR1-1)+I
      IF(ICOLR1.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLR1.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLR1.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLR1.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLR1.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLR1.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLR1.EQ.MAXCP6)Y1(J)=TAGPLO(I)
C
      IF(NUMVAR.LE.1)Y2(J)=1.0
      IF(NUMVAR.LE.1)GOTO3300
      IJ=MAXN*(ICOLR2-1)+I
      IF(ICOLR2.LE.MAXCOL)Y2(J)=V(IJ)
      IF(ICOLR2.EQ.MAXCP1)Y2(J)=PRED(I)
      IF(ICOLR2.EQ.MAXCP2)Y2(J)=RES(I)
      IF(ICOLR2.EQ.MAXCP3)Y2(J)=YPLOT(I)
      IF(ICOLR2.EQ.MAXCP4)Y2(J)=XPLOT(I)
      IF(ICOLR2.EQ.MAXCP5)Y2(J)=X2PLOT(I)
      IF(ICOLR2.EQ.MAXCP6)Y2(J)=TAGPLO(I)
C
 3300 CONTINUE
      NS=J
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'NORM')
     1WRITE(ICOUT,776)J,NS
  776 FORMAT('J,NS = ',2I8)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'NORM')
     1CALL DPWRST('XXX','BUG ')
C
C               *********************************************
C               **  STEP 34--                              **
C               **  CHECK TO MAKE SURE THAT THE            **
C               **  COMBINATION OF CENSORING AND           **
C               **  SUBSETTING DOES NOT RESULT IN          **
C               **  TOO FEW DATA POINTS RESULTING          **
C               **  (AT LEAST 2)                           **
C               **  WITH WHICH TO FORM A NORMAL PLOT.      **
C               *********************************************
C
      ISTEPN='34'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'NORM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOUNT=0
      IF(NS.LE.2)ICOUNT=NS
      IF(NS.LE.2)GOTO3410
      DO3400I=1,NS
CCCCC WRITE(ICOUT,777)I,ICOUNT,NS,MINN2,Y2(I)
CC777 FORMAT('I,ICOUNT,NS,MINN2,Y2(I) = ',I8,E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
      IF(Y2(I).LE.-0.0001.OR.Y2(I).GE.0.0001)ICOUNT=ICOUNT+1
 3400 CONTINUE
 3410 CONTINUE
      IF(ICOUNT.LE.MINN2)GOTO3450
      GOTO3490
C
 3450 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3451)
 3451 FORMAT('***** ERROR IN DPNORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3452)
 3452 FORMAT('      AFTER THE SPECIFIED CENSORING ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3453)
 3453 FORMAT('      AND SUBSETTING HAS BEEN DONE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3454)IHRI11,IHRI12
 3454 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3455)
 3455 FORMAT('      (FOR WHICH A NORMAL PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3456)
 3456 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3457)MINN2
 3457 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3458)ICOUNT
 3458 FORMAT('      SUCH WAS NOT THE CASE HERE (ICOUNT = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3459)
 3459 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3460)(IANS(I),I=1,IWIDTH)
 3460 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3490 CONTINUE
C
C               ****************************************************************
C               **  STEP 41--                                                  *
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS                      *
C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY) FOR THE PLOT.      *
C               **  FORM THE CURVE DESIGNATION VARIABLE D(.)  .                *
C               **  THIS WILL BE BOTH ONES FOR BOTH CASES                      *
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).              *
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).              *
C               ****************************************************************
C
      ISTEPN='41'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'NORM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPNOM2(Y1,Y2,NS,ICASPL,MAXN,
     1IX1TSC,IX2TSC,IY1TSC,IY2TSC,
     1IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1SIGMA,AMU,SDSIGM,SDAMU,
     1BPT1,BPT5,B1,B5,B10,B20,B50,B80,B90,B95,B99,B995,B999,
     1Y,X,D,NPLOTP,NPLOTV,
     1YS,TAGC2,ITAGC2,WAR,WMR,WMRT,YST,
     1IBUGG3,ISUBRO,IERROR)
C
C               ***************************************
C               **  STEP 51--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='51'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      DO5100IPASS=1,17
CCCCC THE FOLLOWING 2 LINES WERE FIXED   APRIL 1992
CCCCC IF(IPASS.EQ.1)IH='SIGMA'
CCCCC IF(IPASS.EQ.1)IH2='    '
      IF(IPASS.EQ.1)IH='SIGM'
      IF(IPASS.EQ.1)IH2='A   '
      IF(IPASS.EQ.2)IH='MU'
      IF(IPASS.EQ.2)IH2='    '
      IF(IPASS.EQ.3)IH='SDSI'
      IF(IPASS.EQ.3)IH2='GMA '
      IF(IPASS.EQ.4)IH='SDET'
      IF(IPASS.EQ.4)IH2='A   '
C
      IF(IPASS.EQ.5)IH='BPT1'
      IF(IPASS.EQ.5)IH2='    '
      IF(IPASS.EQ.6)IH='BPT5'
      IF(IPASS.EQ.6)IH2='    '
      IF(IPASS.EQ.7)IH='B1  '
      IF(IPASS.EQ.7)IH2='    '
      IF(IPASS.EQ.8)IH='B5  '
      IF(IPASS.EQ.8)IH2='    '
      IF(IPASS.EQ.9)IH='B10 '
      IF(IPASS.EQ.9)IH2='    '
      IF(IPASS.EQ.10)IH='B20 '
      IF(IPASS.EQ.10)IH2='    '
      IF(IPASS.EQ.11)IH='B50 '
      IF(IPASS.EQ.11)IH2='    '
      IF(IPASS.EQ.12)IH='B80 '
      IF(IPASS.EQ.12)IH2='    '
      IF(IPASS.EQ.13)IH='B90 '
      IF(IPASS.EQ.13)IH2='    '
      IF(IPASS.EQ.14)IH='B95 '
      IF(IPASS.EQ.14)IH2='    '
      IF(IPASS.EQ.15)IH='B99 '
      IF(IPASS.EQ.15)IH2='    '
      IF(IPASS.EQ.16)IH='B995'
      IF(IPASS.EQ.16)IH2='    '
      IF(IPASS.EQ.17)IH='B999'
      IF(IPASS.EQ.17)IH2='    '
      DO5150I=1,NUMNAM
      I2=I
      IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO5180
 5150 CONTINUE
      IF(NUMNAM.LT.MAXNAM)GOTO5170
      WRITE(ICOUT,5151)
 5151 FORMAT('***** ERROR IN DPNORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5152)
 5152 FORMAT('      THE TOTAL NUMBER OF (VARIABLE + PARAMETER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5153)MAXNAM
 5153 FORMAT('      NAMES MUST BE AT MOST ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5154)
 5154 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5155)
 5155 FORMAT('      THE MAXIMUM ALLOWABLE NUMBER OF NAMES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5156)
 5156 FORMAT('      HAS JUST EXCEEDED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5157)
 5157 FORMAT('      SUGGESTED ACTION--ENTER     STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5158)
 5158 FORMAT('      TO DETERMINE THE IMPORTANT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5159)
 5159 FORMAT('      (VERSUS UNIMPORTANT) VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5160)
 5160 FORMAT('      AND PARAMETERS, AND THEN REUSE SOME')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5161)
 5161 FORMAT('      OF THE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5162)
 5162 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,5163)(IANS(I),I=1,IWIDTH)
 5163 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 5170 CONTINUE
      NUMNAM=NUMNAM+1
      ILOC=NUMNAM
      IHNAME(ILOC)=IH
      IHNAM2(ILOC)=IH2
      IUSE(ILOC)='P'
      IF(IPASS.EQ.1)VALUE(ILOC)=SIGMA
      IF(IPASS.EQ.2)VALUE(ILOC)=AMU
      IF(IPASS.EQ.3)VALUE(ILOC)=SDSIGM
      IF(IPASS.EQ.4)VALUE(ILOC)=SDAMU
      IF(IPASS.EQ.5)VALUE(ILOC)=BPT1
      IF(IPASS.EQ.6)VALUE(ILOC)=BPT5
      IF(IPASS.EQ.7)VALUE(ILOC)=B1
      IF(IPASS.EQ.8)VALUE(ILOC)=B5
      IF(IPASS.EQ.9)VALUE(ILOC)=B10
      IF(IPASS.EQ.10)VALUE(ILOC)=B20
      IF(IPASS.EQ.11)VALUE(ILOC)=B50
      IF(IPASS.EQ.12)VALUE(ILOC)=B80
      IF(IPASS.EQ.13)VALUE(ILOC)=B90
      IF(IPASS.EQ.14)VALUE(ILOC)=B95
      IF(IPASS.EQ.15)VALUE(ILOC)=B99
      IF(IPASS.EQ.16)VALUE(ILOC)=B995
      IF(IPASS.EQ.17)VALUE(ILOC)=B999
      VAL=VALUE(ILOC)
      IF((-CUTOFF).LE.VAL.AND.VAL.LE.CUTOFF)IVAL=VAL+0.5
      IF(VAL.GT.CUTOFF)IVAL=CUTOFF
      IF(VAL.LT.(-CUTOFF))IVAL=(-CUTOFF)
      IVALUE(ILOC)=IVAL
      GOTO5100
C
 5180 CONTINUE
      IF(IPASS.EQ.1)VALUE(I2)=SIGMA
      IF(IPASS.EQ.2)VALUE(I2)=AMU
      IF(IPASS.EQ.3)VALUE(I2)=SDSIGM
      IF(IPASS.EQ.4)VALUE(I2)=SDAMU
      IF(IPASS.EQ.5)VALUE(I2)=BPT1
      IF(IPASS.EQ.6)VALUE(I2)=BPT5
      IF(IPASS.EQ.7)VALUE(I2)=B1
      IF(IPASS.EQ.8)VALUE(I2)=B5
      IF(IPASS.EQ.9)VALUE(I2)=B10
      IF(IPASS.EQ.10)VALUE(I2)=B20
      IF(IPASS.EQ.11)VALUE(I2)=B50
      IF(IPASS.EQ.12)VALUE(I2)=B80
      IF(IPASS.EQ.13)VALUE(I2)=B90
      IF(IPASS.EQ.14)VALUE(I2)=B95
      IF(IPASS.EQ.15)VALUE(I2)=B99
      IF(IPASS.EQ.16)VALUE(I2)=B995
      IF(IPASS.EQ.17)VALUE(I2)=B999
      VAL=VALUE(I2)
      IF((-CUTOFF).LE.VAL.AND.VAL.LE.CUTOFF)IVAL=VAL+0.5
      IF(VAL.GT.CUTOFF)IVAL=CUTOFF
      IF(VAL.LT.(-CUTOFF))IVAL=(-CUTOFF)
      IVALUE(I2)=IVAL
      GOTO5100
C
 5100 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'NORM')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPNORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ICASPL,MAXN,NUMVAR
 9014 FORMAT('ICASPL,MAXN,NUMVAR = ',A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NIRIG1,NIRIG2
 9015 FORMAT('NIRIG1,NIRIG2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NLOCAL,NQ,MINN2
 9016 FORMAT('NLOCAL,NQ,MINN2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9029
      DO9020I=1,NPLOTP
      WRITE(ICOUT,9021)I,Y(I),X(I),D(I)
 9021 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9029 CONTINUE
      WRITE(ICOUT,9031)ICOUNT
 9031 FORMAT('ICOUNT = ',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,9043)SIGMA,AMU,SDSIGM,SDAMU
 9043 FORMAT('SIGMA,AMU,SDSIGM,SDAMU = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9050I=1,NIRIG1
      WRITE(ICOUT,9051)I,Y1(I),Y2(I),ISUB(I)
 9051 FORMAT('I,Y1(I),Y2(I),ISUB(I) = ',I8,2E15.7,I8)
      CALL DPWRST('XXX','BUG ')
 9050 CONTINUE
      WRITE(ICOUT,9061)IHRI11,IHRI12
 9061 FORMAT('IHRI11,IHRI12 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9062)IHRI21,IHRI22
 9062 FORMAT('IHRI21,IHRI22 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPNOM2(Y,TAGC,N,ICASPL,MAXN,
     1IX1TSC,IX2TSC,IY1TSC,IY2TSC,
     1IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1SIGMA,AMU,SDSIGM,SDAMU,
     1BPT1,BPT5,B1,B5,B10,B20,B50,B80,B90,B95,B99,B995,B999,
     1Y2,X2,D2,N2,NPLOTV,
     1YS,TAGC2,ITAGC2,WAR,WMR,WMRT,YST,
     1IBUGG3,ISUBRO,IERROR)
C
CCCCC NOTE--THIS SUBROUTINE WAS BASED ON DPWEI2--ITS WEIBULL ANALOGUE.
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              A NORMAL PLOT.
C              THE PLOT WILL CONSIST OF 6 COMPONENTS--
C                  1) THE RAW DATA
C                  2) THE FITTED LINE
C                  3) THE HORIZONTAL 50% LINE
C                  4) THE VERTICAL   50% LINE
C                  5) 95% CONFIDENCE LIMITS
C                  6) 99% CONFIDENCE LIMITS
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/6
C     ORIGINAL VERSION--MAY       1990.
C      UPDATED        --DECEMBER  1996.  FIX VERTICAL 50% LINE LIMITS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
c
      CHARACTER*4 IX1TSC
      CHARACTER*4 IX2TSC
      CHARACTER*4 IY1TSC
      CHARACTER*4 IY2TSC
C
      CHARACTER*4 IX1TSV
      CHARACTER*4 IX2TSV
      CHARACTER*4 IY1TSV
      CHARACTER*4 IY2TSV
C
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y(*)
      DIMENSION TAGC(*)
C
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
CCCCC DIMENSION YS(MAXOBV)
CCCCC DIMENSION TAGC2(MAXOBV)
CCCCC DIMENSION ITAGC2(MAXOBV)
CCCCC DIMENSION WAR(MAXOBV)
CCCCC DIMENSION WMR(MAXOBV)
CCCCC DIMENSION WMRT(MAXOBV)
CCCCC DIMENSION YST(MAXOBV)
      DIMENSION YS(*)
      DIMENSION TAGC2(*)
      DIMENSION ITAGC2(*)
      DIMENSION WAR(*)
      DIMENSION WMR(*)
      DIMENSION WMRT(*)
      DIMENSION YST(*)
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='DPWE'
      ISUBN2='I2  '
C
      IERROR='NO'
C
      AN=N
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'NOM2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPNOM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3,ISUBRO
   52 FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,MAXN,N,NPLOTV
   53 FORMAT('ICASPL,MAXN,N,NPLOTV = ',A4,2X,I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
      IF(N.LE.0)GOTO62
      DO60I=1,N
      WRITE(ICOUT,61)I,Y(I),TAGC(I)
   61 FORMAT('I,Y(I),TAGC(I) = ',I8,2E12.5)
      CALL DPWRST('XXX','BUG ')
   60 CONTINUE
   62 CONTINUE
      WRITE(ICOUT,71)IX1TSC,IX2TSC,IY1TSC,IY2TSC
   71 FORMAT('IX1TSC,IX2TSC,IY1TSC,IY2TSC = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)IX1TSV,IX2TSV,IY1TSV,IY2TSV
   72 FORMAT('IX1TSV,IX2TSV,IY1TSV,IY2TSV = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)SIGMA,AMU,SDSIGM,SDAMU
   73 FORMAT('SIGMA,AMU,SDSIGM,SDAMU = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)BPT1,BPT5,B1,B5
   74 FORMAT('BPT1,BPT5,B1,B5 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)B10,B20,B50,B80,B90
   75 FORMAT(' B10,B20,B50,B80,B90 = ',5E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)B95,B99,B995,B999
   76 FORMAT('B95,B99,B995,B999 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.2)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPNOM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      MUST BE AT LEAST 2;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)N
 1114 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(N.GE.3)GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPNOM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1123)
 1123 FORMAT('      WAS EXACTLY EQUAL TO 2.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1129 CONTINUE
C
      HOLD=Y(1)
      DO1130I=1,N
      IF(Y(I).NE.HOLD)GOTO1139
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPNOM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ALL INPUT RESPONSE VARIABLE ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
      DO1140I=1,N
      IF(Y(I).NE.0.0)GOTO1149
 1140 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPNOM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      ALL INPUT TAG VARIABLE ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      ARE IDENTICALLY EQUAL TO 0.0;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      THUS THERE ARE NO RESPONSE VARIABLE VALUES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1145)
 1145 FORMAT('      REMAINING UPON WHICH TO DO A WEIBULL ANALYSIS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1149 CONTINUE
C
C               ***********************************************
C               **  STEP 21--                                **
C               **  SORT THE DATA AND CARRY ALONG THE TAG    **
C               ***********************************************
C
      CALL SORTC(Y,TAGC,N,YS,TAGC2)
C
      DO2100I=1,N
      ITAGC2(I)=TAGC2(I)+0.1
 2100 CONTINUE
C
C
C               ***********************************************
C               **  STEP 22--                                **
C               **  COMPUTE NORMAL  ADUSTED RANKS            **
C               ***********************************************
C
C               -----------------------------------------------
C               SET INITIAL VALUE FOR SAVED ADJUSTED RANK.
C               SET INITIAL VALUE FOR RANK INCREMENT.
C               -----------------------------------------------
C
      SAVEAR=0.0
C
      I=0
      ANUM=(AN+1.0)-SAVEAR
      ADENOM=1+(N-I)
      RANINC=ANUM/ADENOM
C
      NVALID=0
      DO2200I=1,N
      IF(ITAGC2(I).EQ.1)GOTO2210
      GOTO2220
C
C               -----------------------------------------------
C               TREAT THE VALID (TO BE INCLUDED) ITEM CASE.
C               COMPUTE THE ADJUSTED RANK.
C               SAVE THE ADJUSTED RANK.
C               DO NOT RECOMPUTE THE RANK INCREMENT.
C               -----------------------------------------------
C
 2210 CONTINUE
      NVALID=NVALID+1
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'NOM2')
     1WRITE(ICOUT,2211)I,YS(I),TAGC2(I),ITAGC2(I),WAR(I)
 2211 FORMAT('I,YS(I),TAGC2(I),ITAGC2(I),WAR(I) = ',I8,2E15.7,
     1I8,E15.7)
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'NOM2')
     1CALL DPWRST('XXX','BUG ')
      WAR(I)=SAVEAR+RANINC
      SAVEAR=WAR(I)
      GOTO2290
C
C               -----------------------------------------------
C               TREAT THE SUSPENDED (= CENSORED) ITEM CASE
C               RECOMPUTE THE RANK INCREMENT.
C               DO NOT RECOMPUTE THE SAVED ADJUSTED RANK.
C               -----------------------------------------------
C
 2220 CONTINUE
      ANUM=(AN+1.0)-SAVEAR
      ADENOM=1+(N-I)
      RANINC=ANUM/ADENOM
      GOTO2290
C
 2290 CONTINUE
 2200 CONTINUE
C
C               ************************************
C               **  STEP 23--                     **
C               **  DETERMINE THE NUMBER OF       **
C               **  "GOOD"                        **
C               **  = NON-CENSORED/NON-SUSPENDED  **
C               **  DATA VALUES.                  **
C               ************************************
C
      NSUB=0
      DO2300I=1,N
      IF(ITAGC2(I).EQ.0)GOTO2300
      NSUB=NSUB+1
 2300 CONTINUE
      ANSUB=NSUB
C
C               ****************************************
C               **  STEP 24--                         **
C               **  COMPUTE NORMAL  MEDIAN RANKS      **
C               **  (FOR THE GOOD DATA ONLY)          **
C               ****************************************
C
      DO2400I=1,N
      WMR(I)=(-999.0)
      IF(ITAGC2(I).EQ.0)GOTO2400
CCCCC WMR(I)=100.0*(WAR(I)-0.3)/(AN+0.4)
      IWARI=WAR(I)+0.1
      CALL UNIME2(N,IWARI,POUT)
      WMR(I)=100.0*POUT
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'NOM2')
     1WRITE(ICOUT,2411)I,WAR(I),WMR(I)
 2411 FORMAT('I,WAR(I),WMR(I) = ',I8,2E15.7)
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'NOM2')
     1CALL DPWRST('XXX','BUG ')
 2400 CONTINUE
C
C               ****************************************
C               **  STEP 30--                         **
C               **  FIT THE DATA TO ESTIMATE          **
C               **  SIGMA (= SCALE PARAMETER) AND      **
C               **  AMU  (= LOCATION PARAMETER)      **
C               ****************************************
C
C               ******************************************
C               **  STEP 31--                           **
C               **  TRANSFORM THE NORMAL  MEDIAN RANKS  **
C               ******************************************
C
      DO3100I=1,N
      WMRT(I)=(-999.0)
      IF(ITAGC2(I).EQ.0)GOTO3100
CCCCC ARG1=100.0/(100.0-WMR(I))
CCCCC ARG2=ALOG(ARG1)
CCCCC WMRT(I)=ALOG(ARG2)
      ARG1=WMR(I)/100.0
      CALL NORPPF(ARG1,WMRT(I))
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'NOM2')
     1WRITE(ICOUT,3111)I,ITAGC2(I),WMR(I),WMRT(I)
 3111 FORMAT('I,ITAGC2(I),WMR(I),WMRT(I) = ',2I8,2E15.7)
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'NOM2')
     1CALL DPWRST('XXX','BUG ')
 3100 CONTINUE
C
C               ******************************************
C               **  STEP 32--                           **
C               **  TRANSFORM THE SORTED DATA           **
C               ******************************************
C
      DO3200I=1,N
CCCCC YST(I)=(-999.0)
CCCCC IF(ITAGC2(I).EQ.0)GOTO3200
CCCCC IF(YS(I).GT.0.0)GOTO3219
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3211)
C3211 FORMAT('***** ERROR IN DPNOM2--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3212)
C3212 FORMAT('      ZERO OR NEGATIVE DATA IS NOT PERMITTED')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3213)
C3213 FORMAT('      IN A NORMAL  PLOT.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3214)
C3214 FORMAT('      THE ILLEGAL VALUE IS ',E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3215)
C3215 FORMAT('      SUGGESTION--ADD A CONSTANT SO THAT ALL DATA')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3216)
C3216 FORMAT('      IS POSITIVE, AND THEN REDO THE NORMAL  PLOT.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
CCCCC GOTO9000
C3219 CONTINUE
CCCCC YST(I)=ALOG(YS(I))
      YST(I)=YS(I)
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'NOM2')
     1WRITE(ICOUT,3221)I,ITAGC2(I),YS(I),YST(I)
 3221 FORMAT('I,ITAGC2(I),YS(I),YST(I) = ',2I8,2E15.7)
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'NOM2')
     1CALL DPWRST('XXX','BUG ')
 3200 CONTINUE
C
C               ******************************************
C               **  STEP 33--                           **
C               **  CARRY OUT THE FIT OF                **
C               **  TRANSFORMED SORTED DATA VERSUS      **
C               **  TRANSFORMED NORMAL  MEDIAN RANKS    **
C               ******************************************
C
      SUMX=0.0
      SUMY=0.0
      DO3310I=1,N
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'NOM2')
     1WRITE(ICOUT,3311)I,ITAGC2(I),YST(I),WMRT(I)
 3311 FORMAT('I,ITAGC2(I),YST(I),WMRT(I) = ',2I8,2E15.7)
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'NOM2')
     1CALL DPWRST('XXX','BUG ')
      IF(ITAGC2(I).EQ.0)GOTO3310
      SUMX=SUMX+WMRT(I)
      SUMY=SUMY+YST(I)
 3310 CONTINUE
      XBAR=SUMX/ANSUB
      YBAR=SUMY/ANSUB
C
      SUMXX=0.0
      SUMYY=0.0
      SUMXY=0.0
      DO3320I=1,N
      IF(ITAGC2(I).EQ.0)GOTO3320
      SUMXX=SUMXX+(WMRT(I)-XBAR)*(WMRT(I)-XBAR)
      SUMYY=SUMYY+(YST(I)-YBAR)*(YST(I)-YBAR)
      SUMXY=SUMXY+(WMRT(I)-XBAR)*(YST(I)-YBAR)
 3320 CONTINUE
      ASLOPE=0.0
      IF(SUMXX.GT.0.0)ASLOPE=SUMXY/SUMXX
      AINTER=YBAR-ASLOPE*XBAR
C
      SUMRR=0.0
      SUMX2=0.0
      DO3330I=1,N
      IF(ITAGC2(I).EQ.0)GOTO3330
      RES=YST(I)-(AINTER+ASLOPE*WMRT(I))
      SUMRR=SUMRR+RES*RES
      SUMX2=SUMX2+WMRT(I)*WMRT(I)
 3330 CONTINUE
      RESVAR=SUMRR/(AN-2.0)
      RESSD=0.0
      IF(RESVAR.GT.0.0)RESSD=SQRT(RESVAR)
      SDINTE=RESSD*SQRT(SUMX2/(AN*SUMXX))
      SDSLOP=RESSD*SQRT(1.0/SUMXX)
C
C               ****************************************
C               **  STEP 34--                         **
C               **  FORM ESTIMATES FOR                **
C               **  SIGMA (= SCALE PARAMETER) AND      **
C               **  AMU  (= LOCATION PARAMETER)      **
C               ****************************************
C
      IF(ASLOPE.GT.0.0)GOTO3339
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3331)
 3331 FORMAT('***** INTERNAL ERROR IN DPNOM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3332)
 3332 FORMAT('      THE FITTED SLOPE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3333)
 3333 FORMAT('      IS 0 OR NEGATIVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3334)
 3334 FORMAT('      WHICH WOULD YIELD AN IMPOSSIBLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3335)
 3335 FORMAT('      VALUE FOR SIGMA = 1/SLOPE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3336)ASLOPE,AINTER
 3336 FORMAT('      ASLOPE,AINTER = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3337)SUMX,SUMY,SUMXX,SUMYY,SUMXY
 3337 FORMAT('      SUMX,SUMY,SUMXX,SUMYY,SUMXY = ',5E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3339 CONTINUE
CCCCC SIGMA=1/ASLOPE
CCCCC MU=EXP(AINTER)
CCCCC SDSIGM=SIGMA*SIGMA*SDSLOP
CCCCC SDMU=MU*SDINTE
      SIGMA=ASLOPE
      AMU=AINTER
      SDSIGM=SDSLOP
      SDAMU=SDINTE
C
C               ************************************************
C               **  STEP 35--                                 **
C               **  FORM ESTIMATES FOR                        **
C               **     BPT1= .1%   POINT OF BEST-FIT DIST.    **
C               **     BPT5= .5%   POINT OF BEST-FIT DIST.    **
C               **     B1  =  1%   POINT OF BEST-FIT DIST.    **
C               **     B5  =  5%   POINT OF BEST-FIT DIST.    **
C               **     B10 = 10%   POINT OF BEST-FIT DIST.    **
C               **     B20 = 20%   POINT OF BEST-FIT DIST.    **
C               **     B50 = 50%   POINT OF BEST-FIT DIST.    **
C               **     B80 = 80%   POINT OF BEST-FIT DIST.    **
C               **     B90 = 90%   POINT OF BEST-FIT DIST.    **
C               **     B95 = 95%   POINT OF BEST-FIT DIST.    **
C               **     B99 = 99%   POINT OF BEST-FIT DIST.    **
C               **     B995= 99.5% POINT OF BEST-FIT DIST.    **
C               **     B999= 99.9% POINT OF BEST-FIT DIST.    **
C               ************************************************
C
      P=.001
CCCCC BPT1=MU*(ALOG(1.0/(1.0-P)))**(1.0/SIGMA)
      CALL NORPPF(P,XOUT)
      BPT1=AMU+XOUT*SIGMA
      P=.005
CCCCC BPT5=MU*(ALOG(1.0/(1.0-P)))**(1.0/SIGMA)
      CALL NORPPF(P,XOUT)
      BPT5=AMU+XOUT*SIGMA
      P=.01
CCCCC B1=MU*(ALOG(1.0/(1.0-P)))**(1.0/SIGMA)
      CALL NORPPF(P,XOUT)
      B1=AMU+XOUT*SIGMA
      P=.05
CCCCC B5=MU*(ALOG(1.0/(1.0-P)))**(1.0/SIGMA)
      CALL NORPPF(P,XOUT)
      B5=AMU+XOUT*SIGMA
      P=.10
CCCCC B10=MU*(ALOG(1.0/(1.0-P)))**(1.0/SIGMA)
      CALL NORPPF(P,XOUT)
      B10=AMU+XOUT*SIGMA
      P=.20
CCCCC B20=MU*(ALOG(1.0/(1.0-P)))**(1.0/SIGMA)
      CALL NORPPF(P,XOUT)
      B20=AMU+XOUT*SIGMA
      P=.50
CCCCC B50=MU*(ALOG(1.0/(1.0-P)))**(1.0/SIGMA)
      CALL NORPPF(P,XOUT)
      B50=AMU+XOUT*SIGMA
      P=.80
CCCCC B80=MU*(ALOG(1.0/(1.0-P)))**(1.0/SIGMA)
      CALL NORPPF(P,XOUT)
      B80=AMU+XOUT*SIGMA
      P=.90
CCCCC B90=MU*(ALOG(1.0/(1.0-P)))**(1.0/SIGMA)
      CALL NORPPF(P,XOUT)
      B90=AMU+XOUT*SIGMA
      P=.95
CCCCC B95=MU*(ALOG(1.0/(1.0-P)))**(1.0/SIGMA)
      CALL NORPPF(P,XOUT)
      B95=AMU+XOUT*SIGMA
      P=.99
CCCCC B99=MU*(ALOG(1.0/(1.0-P)))**(1.0/SIGMA)
      CALL NORPPF(P,XOUT)
      B99=AMU+XOUT*SIGMA
      P=.995
CCCCC B995=MU*(ALOG(1.0/(1.0-P)))**(1.0/SIGMA)
      CALL NORPPF(P,XOUT)
      B995=AMU+XOUT*SIGMA
      P=.999
CCCCC B999=MU*(ALOG(1.0/(1.0-P)))**(1.0/SIGMA)
      CALL NORPPF(P,XOUT)
      B999=AMU+XOUT*SIGMA
C
C               ****************************************
C               **  STEP 41--                         **
C               **  SAVE OLD SETTINGS FOR             **
C               **     HORIZONTAL AXIS PLOT SCALE     **
C               **     VERTICAL AXIS PLOT SCALE       **
C               **  CHANGE                            **
C               **     HORIZONTAL AXIS PLOT SCALE     **
C               **     TO LOG                         **
C               **  CHANGE                            **
C               **     VERTICAL AXIS PLOT SCALE       **
C               **     TO NORMAL                      **
C               ****************************************

      IX1TSV=IX1TSC
      IX2TSV=IX2TSC
      IY1TSV=IY1TSC
      IY2TSV=IY2TSC
C
CCCCC IX1TSC='LOG'
CCCCC IX2TSC='LOG'
      IX1TSC='LINE'
      IX2TSC='LINE'
      IY1TSC='NORM'
      IY2TSC='NORM'
C
C               ****************************************
C               **  STEP 42--                         **
C               **  DETERMINE PLOT LIMITS FOR         **
C               **  PREDICTED LINE                    **
C               ****************************************
C
      P2=0.1
      P=P2/100.0
CCCCC ARG1=1.0/(1.0-P)
CCCCC TERM=ALOG(ARG1)
CCCCC ARG2=1.0/SIGMA
CCCCC PPF=MU*TERM**ARG2
      CALL NORPPF(P,TERM)
      PPF=AMU+TERM*SIGMA
      XMIN=PPF
C
      P2=99.9
      P=P2/100.0
CCCCC ARG1=1.0/(1.0-P)
CCCCC TERM=ALOG(ARG1)
CCCCC ARG2=1.0/SIGMA
CCCCC PPF=MU*TERM**ARG2
      CALL NORPPF(P,TERM)
      PPF=AMU+TERM*SIGMA
      XMAX=PPF
C
      XINC=(XMAX-XMIN)/100.0
C
CCCCC XMIN2=ALOG10(XMIN)
      XMIN2=XMIN
      IF(XMIN2.GE.0.0)XMIN3=AINT(XMIN2)
      IF(XMIN2.LT.0.0)XMIN3=(-AINT(-XMIN2+1.0))
CCCCC XMIN4=10.0**XMIN3+0.001
      XMIN4=XMIN3+0.001
C
CCCCC XMAX2=ALOG10(XMAX)
      XMAX2=XMAX
      IF(XMAX2.GE.0.0)XMAX3=AINT(XMAX2)
      IF(XMAX2.LT.0.0)XMAX3=(-AINT(-XMAX2+1.0))
      XMAX3=XMAX3+1.0
CCCCC XMAX4=10.0**XMAX3-0.001
      XMAX4=XMAX3-0.001
C
      X50=AMU
C
C               ****************************************
C               **  STEP 51--                         **
C               **  FORM PLOT COORDINATES             **
C               **     RAW (GOOD) DATA                **
C               **     PREDICTED LINE                 **
C               **     HORIZONTAL 50% LINE          **
C               **     VERTICAL   50% LINE          **
C               **     95% CONFIDENCE BAND            **
C               **     99% CONFIDENCE BAND            **
C               ****************************************
C
      J=0
      DO5110I=1,N
      IF(ITAGC2(I).EQ.0)GOTO5110
      J=J+1
      Y2(J)=WMR(I)
      X2(J)=YS(I)
      D2(J)=1.0
 5110 CONTINUE
C
      X=XMIN-XINC
      DO5120I=1,10000
      X=X+XINC
      IF(X.GT.XMAX)GOTO5129
CCCCC PRED=100.0*(1.0-EXP(-((X/MU)**SIGMA)))
      ARG=(X-AMU)/SIGMA
      CALL NORCDF(ARG,POUT)
      PRED=100.0*POUT
      J=J+1
      Y2(J)=PRED
      X2(J)=X
      D2(J)=2.0
 5120 CONTINUE
 5129 CONTINUE
C
      J=J+1
      Y2(J)=50.0
      X2(J)=XMIN4
      D2(J)=3.0
      J=J+1
      Y2(J)=50.0
      X2(J)=XMAX4
      D2(J)=3.0
C
      J=J+1
CCCCC THE FOLLOWING LINE WAS CHANGED   DECEMBER 1996
CCCCC Y2(J)=99.9
      Y2(J)=99.5
      X2(J)=X50
      D2(J)=4.0
      J=J+1
CCCCC THE FOLLOWING LINE WAS CHANGED   DECEMBER 1996
CCCCC Y2(J)=0.1
      Y2(J)=0.5
      X2(J)=X50
      D2(J)=4.0
C
      N2=J
      NPLOTV=3
C
C               ****************************************
C               **  STEP 61--                         **
C               **  RESTORE OLD SETTINGS FOR          **
C               **     HORIZONTAL AXIS PLOT SCALE     **
C               **     VERTICAL AXIS PLOT SCALE       **
C               ****************************************
C
CCCCC IX1TSC=IX1TSV
CCCCC IX2TSC=IX2TSV
CCCCC IY1TSC=IY1TSV
CCCCC IY2TSC=IY2TSV
C     (THIS RESTORATION MUST BE DONE IN MAIN)
C
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPNOM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,MAXN,N2,IERROR
 9012 FORMAT('ICASPL,MAXN,N2,IERROR = ',A4,I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,N2
      WRITE(ICOUT,9016)I,Y2(I),X2(I),D2(I)
 9016 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9021)IX1TSC,IX2TSC,IY1TSC,IY2TSC
 9021 FORMAT('IX1TSC,IX2TSC,IY1TSC,IY2TSC = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IX1TSV,IX2TSV,IY1TSV,IY2TSV
 9022 FORMAT('IX1TSV,IX2TSV,IY1TSV,IY2TSV = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)AINTER,ASLOPE,SDINTE,SDSLOP
 9031 FORMAT('AINTER,ASLOPE,SDINTE,SDSLOP = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)SIGMA,AMU,SDSIGM,SDAMU
 9032 FORMAT('SIGMA,AMU,SDSIGM,SDAMU = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)BPT1,BPT5,B1,B5
 9034 FORMAT('BPT1,BPT5,B1,B5 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)B10,B20,B50,B80,B90
 9035 FORMAT(' B10,B20,B50,B80,B90 = ',5E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9036)B95,B99,B995,B999
 9036 FORMAT('B95,B99,B995,B999 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9037)RESSD
 9037 FORMAT('RESSD = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)XMIN,XMIN2,XMIN3,XMIN4
 9041 FORMAT('XMIN,XMIN2,XMIN3,XMIN4 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)XINC
 9042 FORMAT('XINC = ',E15.7)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE FIXED   APRIL 1992
CCCCC WRITE(ICOUT,9043)YMIN,YMIN2,YMIN3,YMIN4
C9043 FORMAT('YMIN,YMIN2,YMIN3,YMIN4 = ',4E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)XMIN,XMIN2,XMIN3,XMIN4
 9043 FORMAT('XMIN,XMIN2,XMIN3,XMIN4 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)AMU,X50
 9044 FORMAT('AMU,X50 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPNOR(IHARG,IARGT,ARG,NUMARG,
     1PXSTAR,PYSTAR,
     1PXEND,PYEND,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG,
     1IGRASW,IDIASW,
     1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
CCCCC ADD FOLLOWING LINE JULY 1997.
     1UNITSW,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DRAW ONE OR MORE LOGICAL NORS
C              (DEPENDING ON HOW MANY NUMBERS ARE PROVIDED).
C              THE COORDINATES ARE IN STANDARDIZED UNITS
C              OF 0 TO 100.
C     NOTE--THE INPUT COORDINATES DEFINE THE BACK CENTER AND THE FRONT CENTER
C           OF THE LOGICAL NOR.
C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 2
C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*2 = 4.
C     NOTE--IF 2 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN LOGICAL NOR WILL GO
C           FROM THE LAST CURSOR POSITION
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE 2 NUMBERS.
C     NOTE--IF 4 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN LOGICAL NOR WILL GO
C           FROM THE ABSOLUTE (X,Y) POSITION
C           AS DEFINED BY THE FIRST 2 NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS.
C     NOTE--IF 6 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN LOGICAL NOR WILL GO
C           FROM THE (X,Y) POSITION
C           AS RESULTING FROM THE THIRD AND FOURTH NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIFTH AND SIXTH NUMBERS.
C     NOTE--AND SO FORTH FOR 8, 10, 12, ... NUMBERS.
C     INPUT  ARGUMENTS--IHARG
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PXSTAR
C                     --PYSTAR
C     OUTPUT ARGUMENTS--PXEND
C                     --PYEND
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --NOVEMBER  1982.
C     UPDATED         --JANUARY   1989.  CALL LIST FOR OFFSET VAR (ALAN)
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C     UPDATED         --JULY      1997.  SUPPORT FOR "DATA" UNITS (ALAN)
C
C-----NON-COMMON VARIABLES-----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
CCCCC ADD FOLLOWING LINE JULY 1997.
      CHARACTER*4 UNITSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IFIG
      CHARACTER*4 IBELSW
      CHARACTER*4 IERASW
      CHARACTER*4 IBACCO
      CHARACTER*4 ICOPSW
      CHARACTER*4 ITYPEO
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
      IERRG4=IERROR
CCCCC IBUGG4=IBUGD2
CCCCC ISUBG4=ISUBRO
C
      ILOCFN=0
      NUMNUM=0
C
      X1=0.0
      Y1=0.0
      X2=0.0
      Y2=0.0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'NOR')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPNOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMARG
   53 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I),IARGT(I),ARG(I)
   56 FORMAT('I,IHARG(I),IARGT(I),ARG(I) = ',I8,2X,A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,57)PXSTAR,PYSTAR
   57 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)PXEND,PYEND
   58 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)IGRASW,IDIASW
   76 FORMAT('IGRASW,IDIASW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)PGRAXF,PGRAYF,PDIAXC,PDIAYC
   77 FORMAT('PGRAXF,PGRAYF,PDIAXC,PDIAYC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,78)PDIAHE,PDIAWI,PDIAVG,PDIAHG
   78 FORMAT('PDIAHE,PDIAWI,PDIAVG,PDIAHG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80)NUMDEV
   80 FORMAT('NUMDEV= ',I8)
      CALL DPWRST('XXX','BUG ')
      DO81I=1,NUMDEV
      WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
   82 FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I)
   83 FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I)
   84 FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
      WRITE(ICOUT,87)IFOUND
   87 FORMAT('IFOUND= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4
   88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGD2,IERROR
   89 FORMAT('IBUGD2,IERROR= ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFIG='NOR'
      NUMPT=2
      NUMPT2=2*NUMPT
C
C               ********************************
C               **  STEP 0--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
C  AUGUST 1988.  ADD OFFSET VARIABLE
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               ************************************
C               **  STEP 1--                      **
C               **  CARRY OUT OPENING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      CALL DPOPDE
C
      IBELSW='OFF'
      NUMRIN=0
      IERASW='OFF'
      IBACCO='JUNK'
C
      CALL DPOPPL(IGRASW,
     1IBELSW,NUMRIN,IERASW,
     1IBACCO)
C
C               *****************************************
C               **  STEP 2--                           **
C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
C               *****************************************
C
      IF(NUMARG.GE.2.AND.
     1IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1111
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ABSO'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1112
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'RELA'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1113
      GOTO1130
C
 1111 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=1
      GOTO1119
C
 1112 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=2
      GOTO1119
C
 1113 CONTINUE
      ITYPEO='RELA'
      ILOCFN=2
      GOTO1119
 1119 CONTINUE
C
      IF(ILOCFN.GT.NUMARG)GOTO1129
      DO1120I=ILOCFN,NUMARG
      IF(IARGT(I).EQ.'NUMB')GOTO1120
      GOTO1129
 1120 CONTINUE
      IFOUND='YES'
      GOTO1149
 1129 CONTINUE
      GOTO1130
C
 1130 CONTINUE
      IERRG4='YES'
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPNOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ILLEGAL FORM FOR DRAW ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1134)
 1134 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('      SUPPOSE IT IS DESIRED TO DRAW A LOGICAL NOR ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      WITH THE MIDDLE OF THE FLATTER SIDE  ',
     1'AT THE POINT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      AND WITH THE POINTED END AT THE POINT 40 60')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      LOGICAL NOR 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      LOGICAL NOR ABSOLUTE 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1149 CONTINUE
C
C               ****************************
C               **  STEP 3--              **
C               **  DRAW OUT THE LINE(S)  **
C               ****************************
C
      NUMNUM=NUMARG-ILOCFN+1
      IF(NUMNUM.LT.NUMPT2)GOTO1151
      GOTO1152
C
 1151 CONTINUE
      J=ILOCFN-1
      X1=PXSTAR
      Y1=PYSTAR
      GOTO1159
C
 1152 CONTINUE
      J=ILOCFN
      IF(J.GT.NUMARG)GOTO1190
      X1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR)
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR)
      GOTO1159
 1159 CONTINUE
C
 1160 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X2=X1+X2
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
C
 1170 CONTINUE
      CALL DPNOR2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      X1=X2
      Y1=Y2
C
      GOTO1160
 1190 CONTINUE
C
      PXEND=X2
      PYEND=Y2
C
C               ************************************
C               **  STEP 4--                      **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSW='OFF'
      NUMCOP=0
      CALL DPCLPL(ICOPSW,NUMCOP,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
 8000 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'NOR')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPNOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOCFN,NUMNUM
 9012 FORMAT('ILOCFN,NUMNUM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X1,Y1,X2,Y2
 9013 FORMAT('X1,Y1,X2,Y2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PXSTAR,PYSTAR
 9015 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PXEND,PYEND
 9016 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IFIG
 9017 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)IFOUND
 9027 FORMAT('IFOUND = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGG4,ISUBG4,IERRG4
 9028 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGD2,IERROR
 9029 FORMAT('IBUGD2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPNOR2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW A LOGICAL NOR(= A NOR BOX)
C              WITH THE MIDDLE OF THE FLATTER SIDE
C              AT THE POINT (X1,Y1),
C              AND WITH THE MIDDLE OF THE POINTED SIDE
C              AT THE POINT (X2,Y2).
C     NOTE--THE HEIGHT OF THE BOX WILL BE EQUAL TO
C           THE ABOVE-DESCRIBED WIDTH OF THE BOX
C           (THAT IS, THE HEIGHT
C           OF THE BOX WILL BE EQUAL TO
C           THE WIDTH FROM (X1,Y1) TO (X2,Y2).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT2
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IPATT
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(1000)
      DIMENSION PY(1000)
CCCCC FEBRUARY 1994.  ADD FOLLOWING SECTION
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR11),PX(1))
      EQUIVALENCE (G2RBAG(IGAR12),PY(1))
CCCCC END CHANGE
CCCCC DIMENSION PX3(1000)
CCCCC DIMENSION PY3(1000)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'NOR2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPNOR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y2
   54 FORMAT('X2,Y2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IFIG
   59 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE THE COORDINATES  **
C               **  FOR THE LOGICAL NOR       **
C               *********************************
C
C
      POWER=1.4
      FACTOR=0.2
C
      DELX=X2-X1
      DELY=Y2-Y1
      ALEN=0.0
      TERM=(X2-X1)**2+(Y2-Y1)**2
      IF(TERM.GT.0.0)ALEN=SQRT(TERM)
      R=ALEN/2.0
      IF(ABS(DELX).GE.0.00001)THETA=ATAN(DELY/DELX)
      IF(ABS(DELX).LT.0.00001.AND.DELY.GE.0.0)THETA=3.1415926/2.0
      IF(ABS(DELX).LT.0.00001.AND.DELY.LT.0.0)THETA=-3.1415926/2.0
C
      K=0
C
      X=R
      Y=-R
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      DO5310I=271,451,10
      PHI2=I-1
      PHI2=PHI2*(2.0*3.1415926)/360.0
      ABSCOS=ABS(COS(PHI2))
      ABSSIN=ABS(SIN(PHI2))
      X=R*(ABSCOS**POWER)
      Y=R*(ABSSIN**POWER)
      IF(SIN(PHI2).LT.0.0)Y=-Y
      X=X+R
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
 5310 CONTINUE
C
      X=0
      Y=R
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      DO5320I=271,451,10
      PHI2=I-1
      PHI2=360.0-PHI2
      PHI2=PHI2*(2.0*3.1415926)/360.0
      X=FACTOR*R*COS(PHI2)
      Y=R*SIN(PHI2)
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
 5320 CONTINUE
C
      X=R
      Y=-R
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      NP=K
C
C               ***********************
C               **  STEP 2--         **
C               **  FILL THE FIGURE  **
C               **  (IF CALLED FOR)  **
C               ***********************
C
      IF(IREFSW(1).EQ.'OFF')GOTO2190
      IPATT=IREPTY(1)
      IPATT2='SOLI'
      PTHICK=PREPTH(1)
      PXGAP=PREPSP(1)
      PYGAP=PREPSP(1)
      ICOLF=IREFCO(1)
      ICOLP=IREPCO(1)
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
 2190 CONTINUE
C
      IPATT=ILINPA(1)
      PTHICK=PLINTH(1)
      ICOL=ILINCO(1)
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
      K=0
C
      X=-0.2*R
      Y=R
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      DO5330I=271,451,10
      PHI2=I-1
      PHI2=360.0-PHI2
      PHI2=PHI2*(2.0*3.1415926)/360.0
      X=FACTOR*R*COS(PHI2)
      Y=R*SIN(PHI2)
      X=X-0.2*R
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
 5330 CONTINUE
C
      NP=K
C
      IPATT2='SOLI'
      IF(IREFSW(1).EQ.'ON')
     1CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
C
C
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'NOR2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPNOR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NP
 9014 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)I,PX(I),PY(I)
 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPNOSM(IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE NORMAL ORDER STATISTIC MEDIANS
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1986.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 NEWNAM
      CHARACTER*4 NEWCOL
      CHARACTER*4 ICASEQ
      CHARACTER*4 ILEFT
      CHARACTER*4 ILEFT2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPUO'
      ISUBN2='SM  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      IFOUND='YES'
C
      NS2=0
C
C               ***********************************************
C               **  TREAT THE NORMAL ORDER STATISTIC MEDIANS CASE  **
C               **       1) FOR A FULL VARIABLE, OR          **
C               **       2) FOR PART OF A VARIABLE.          **
C               ***********************************************
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPNOSM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3,IBUGQ
   52 FORMAT('IBUGA3,IBUGQ = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NEWNAM='NO'
      NEWCOL='NO'
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=3
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************************************
C               **  STEP 3--                                                   *
C               **  EXAMINE THE LEFT-HAND SIDE--                               *
C               **  IS THE PARAMETER OR VARIABLE NAME TO LEFT OF = SIGN        *
C               **  ALREADY IN THE NAME LIST?                                  *
C               **  NOTE THAT     ILEFT      IS THE NAME OF THE VARIABLE       *
C               **  ON THE LEFT.                                               *
C               **  NOTE THAT     ILISTL    IS THE LINE IN THE TABLE           *
C               **  OF THE NAME ON THE LEFT.                                   *
C               **  NOTE THAT     ICOLL    IS THE DATA COLUMN (1 TO 12)        *
C               **  FOR THE NAME OF THE LEFT.                                  *
C               ****************************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC ILEFT=IHOL(2)
CCCCC ILEFT2=IHOL2(2)
      ILEFT=IHARG(1)
      ILEFT2=IHARG2(1)
      DO310I=1,NUMNAM
      I2=I
      IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO329
      IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO380
  310 CONTINUE
      NEWNAM='YES'
      ILISTL=NUMNAM+1
      IF(ILISTL.GT.MAXNAM)GOTO320
      GOTO330
C
  320 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,321)
  321 FORMAT('***** ERROR IN DPNOSM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,322)
  322 FORMAT('      THE NUMBER OF VARIABLE AND/OR PARAMETER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,323)MAXNAM
  323 FORMAT('      NAMES HAS JUST EXCEEDED THE MAX ALLOWABLE ',
     1I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,324)
  324 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,325)
  325 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,326)
  326 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,327)
  327 FORMAT('      AND THEN REDEFINE (REUSE) SOME OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,328)
  328 FORMAT('      ALREADY-USED NAMES')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  329 CONTINUE
      ILISTL=I2
      GOTO330
C
  330 CONTINUE
      NLEFT=0
      ICOLL=NUMCOL+1
      IF(ICOLL.GT.MAXCOL)GOTO340
      GOTO390
C
  340 CONTINUE
      WRITE(ICOUT,341)
  341 FORMAT('***** ERROR IN DPNOSM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,342)
  342 FORMAT('      THE NUMBER OF DATA COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,343)MAXCOL
  343 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE ',I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,344)
  344 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,345)
  345 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,346)
  346 FORMAT('      TO FIND OUT THE FULL LIST OF USED COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,347)
  347 FORMAT('      AND THEN OVERWRITE SOME COLUMNS.   EXAMPLE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,348)
  348 FORMAT('      IF       LET X(I) = 3.14         FAILED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,349)
  349 FORMAT('      THEN ONE MIGHT ENTER     NAME X 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,350)
  350 FORMAT('      (THEREBY EQUATING THE NAME X WITH COLUMN 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,351)
  351 FORMAT('      FOLLOWED BY              LET X = 3.14')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,352)
  352 FORMAT('      (WHICH WILL ACTUALLY OVERWRITE COLUMN 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,353)
  353 FORMAT('      WITH THE NUMERIC CONSTANTS 3.14)')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  380 CONTINUE
      ILISTL=I2
      ICOLL=IVALUE(ILISTL)
      NLEFT=IN(ILISTL)
C
  390 CONTINUE
C
C               *****************************************
C               **  STEP 6--                           **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)           **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO670
      DO610J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO620
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO620
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO630
  610 CONTINUE
      GOTO680
C
  620 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO680
C
  630 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO680
C
  670 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,671)
  671 FORMAT('***** INTERNAL ERROR IN DPNOSM')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,672)
  672 FORMAT('      AT BRANCH POINT 5081--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,673)
  673 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,674)
  674 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,675)NUMARG
  675 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,676)
  676 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,677)(IANS(I),I=1,IWIDTH)
  677 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  680 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO690
      WRITE(ICOUT,681)NUMARG,ILOCQ,ICASEQ
  681 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
C
  690 CONTINUE
C
C               ******************************************************
C               **  STEP 7--                                        **
C               **  BRANCH TO THE APPROPRIATE SUBCASE               **
C               **  (BASED ON THE QUALIFIER);                       **
C               **  DETERMINE THE NUMBER (= NNOSM)                   **
C               **  OF NORMAL ORDER STATISTIC MEDIANS TO BE GENERATED.
C               **  NOTE THAT THE VARIABLE NIISUB                   **
C               **  IS THE LENGTH OF THE RESULTING                  **
C               **  VARIABLE ISUB(.).                               **
C               **  NOTE THAT DPFOR AUTOMATICALLY EXTENDS           **
C               **  THE INPUT LENGTH OF ISUB(.) IF NECESSARY.       **
C               **  (HENCE THE REDEFINITION OF NIISUB TO NINEW      **
C               **  AFTER THE CALL TO DPFOR.                        **
C               ******************************************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO710
      IF(ICASEQ.EQ.'SUBS')GOTO720
      IF(ICASEQ.EQ.'FOR')GOTO730
C
  710 CONTINUE
      IF(NEWNAM.EQ.'NO')NIISUB=NLEFT
      IF(NEWNAM.EQ.'YES')NIISUB=MAXN
      DO715I=1,NIISUB
      ISUB(I)=1
  715 CONTINUE
      NNOSM=NIISUB
      GOTO750
C
  720 CONTINUE
      NIISUB=MAXN
      CALL DPSUBS(NIISUB,ILOCS,NS,IBUGQ,IERROR)
      NNOSM=NS
      GOTO750
C
  730 CONTINUE
      IF(NEWNAM.EQ.'NO')NIISUB=NLEFT
      IF(NEWNAM.EQ.'YES')NIISUB=MAXN
      CALL DPFOR(NIISUB,NINEW,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NIISUB=NINEW
      NNOSM=NS
      GOTO750
C
  750 CONTINUE
C
C               ******************************************
C               **  STEP 8--                            **
C               **  GENERATE    NNOSM    NORMAL ORDER   **
C               **  STATISTIC MEDIANS.                  **
C               **  STORE THEM TEMPORARILY IN           **
C               **  THE VECTOR Y(.).                    **
C               ******************************************
C
      ISTEPN='8'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL UNIMED(NNOSM,Y)
C
      DO800I=1,NNOSM
      CALL NORPPF(Y(I),Y(I))
  800 CONTINUE
C
C               ***********************************************************
C               **  STEP 8--                                             **
C               **  IF CALLED FOR (THAT IS, IF IBUGA3 IS ON),      **
C               **  PRINT OUT THE INTERMEDIATE VARIABLE Y(.).            **
C               **  THIS IS USEFUL FOR DIAGNOSTIC PURPOSES               **
C               **  IN REVIEWING THE OUTPUT FROM THIS SUBROUTINE.        **
C               ***********************************************************
C
      ISTEPN='9'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'OFF')GOTO2090
      WRITE(ICOUT,2051)
 2051 FORMAT('OUTPUT FROM MIDDLE OF DPNOSM AFTER UNIMED ',
     1'HAS BEEN CALLED--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2052)NNOSM
 2052 FORMAT('NNOSM = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NNOSM.LE.0)GOTO2090
      DO2054I=1,NNOSM
      WRITE(ICOUT,2055)I,Y(I)
 2055 FORMAT('I,Y(I) = ',I8,F12.5)
      CALL DPWRST('XXX','BUG ')
 2054 CONTINUE
C
 2090 CONTINUE
C
C               ******************************************************
C               **  STEP 9--                                        **
C               **  COPY THE ORDER STATISTIC MEDIANS                **
C               **  FROM THE INTERMEDIATE VECTOR Y(.)               **
C               **  TO THE APPROPRIATE COLUMN                       **
C               **  (BASED ON THE QUALIFIER--FULL, SUBSET, OR FOR)  **
C               **  IN THE INTERNAL DATAPLOT DATA TABLE.            **
C               ******************************************************
C
      ISTEPN='10'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NS2=0
      DO2100I=1,NIISUB
      IJ=MAXN*(ICOLL-1)+I
      IF(ISUB(I).EQ.0)GOTO2100
      NS2=NS2+1
      IF(ICOLL.LE.MAXCOL)V(IJ)=Y(NS2)
      IF(ICOLL.EQ.MAXCP1)PRED(I)=Y(NS2)
      IF(ICOLL.EQ.MAXCP2)RES(I)=Y(NS2)
      IF(ICOLL.EQ.MAXCP3)YPLOT(I)=Y(NS2)
      IF(ICOLL.EQ.MAXCP4)XPLOT(I)=Y(NS2)
      IF(ICOLL.EQ.MAXCP5)X2PLOT(I)=Y(NS2)
      IF(ICOLL.EQ.MAXCP6)TAGPLO(I)=Y(NS2)
      IF(NS2.EQ.1)IROW1=I
      IROWN=I
 2100 CONTINUE
C
C               *******************************************
C               **  STEP 10--                            **
C               **  CARRY OUT THE LIST UPDATING AND      **
C               **  GENERATE THE INFORMATIVE PRINTING.   **
C               *******************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL'.AND.NEWNAM.EQ.'NO')NINEW=NLEFT
      IF(ICASEQ.EQ.'FULL'.AND.NEWNAM.EQ.'YES')NINEW=MAXN
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.GE.IROWN)NINEW=NLEFT
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.LT.IROWN)NINEW=IROWN
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'YES')NINEW=IROWN
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.GE.IROWN)NINEW=NLEFT
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.LT.IROWN)NINEW=IROWN
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'YES')NINEW=IROWN
C
      IHNAME(ILISTL)=ILEFT
      IHNAM2(ILISTL)=ILEFT2
      IUSE(ILISTL)='V'
      IVALUE(ILISTL)=ICOLL
      VALUE(ILISTL)=ICOLL
      IN(ILISTL)=NINEW
C
CCCCC IUSE(ICOLL)='V'
CCCCC IVALUE(ICOLL)=ICOLL
CCCCC VALUE(ICOLL)=ICOLL
CCCCC IN(ICOLL)=NINEW
C
      IF(NEWNAM.EQ.'YES')NUMNAM=NUMNAM+1
      IF(NEWNAM.EQ.'YES')NUMCOL=NUMCOL+1
C
      DO4100J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL)GOTO4105
      GOTO4100
 4105 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL
      VALUE(J4)=ICOLL
      IN(J4)=NINEW
 4100 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO4059
      IF(IFEEDB.EQ.'OFF')GOTO4059
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4011)ILEFT,ILEFT2,NS2
 4011 FORMAT('THE NUMBER OF VALUES GENERATED FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      IJ=MAXN*(ICOLL-1)+IROW1
      IF(ICOLL.LE.MAXCOL)WRITE(ICOUT,4021)ILEFT,ILEFT2,V(IJ),IROW1
 4021 FORMAT('THE FIRST           COMPUTED VALUE OF ',A4,A4,
     1' = ',E15.7,'   (ROW ',I6,')')
      IF(ICOLL.LE.MAXCOL)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP1)WRITE(ICOUT,4021)ILEFT,ILEFT2,PRED(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP2)WRITE(ICOUT,4021)ILEFT,ILEFT2,RES(IROW1),IROW1
      IF(ICOLL.EQ.MAXCP2)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP3)WRITE(ICOUT,4021)ILEFT,ILEFT2,YPLOT(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP3)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP4)WRITE(ICOUT,4021)ILEFT,ILEFT2,XPLOT(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP4)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP5)WRITE(ICOUT,4021)ILEFT,ILEFT2,X2PLOT(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP5)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP6)WRITE(ICOUT,4021)ILEFT,ILEFT2,TAGPLO(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP6)CALL DPWRST('XXX','BUG ')
C
      IJ=MAXN*(ICOLL-1)+IROWN
      IF(ICOLL.LE.MAXCOL.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,V(IJ),IROWN
 4031 FORMAT('THE LAST (',I5,'-TH) COMPUTED VALUE OF ',A4,A4,
     1' = ',E15.7,'   (ROW ',I6,')')
      IF(ICOLL.LE.MAXCOL.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP1.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,PRED(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP1.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP2.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,RES(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP2.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP3.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,YPLOT(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP3.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP4.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,XPLOT(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP4.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP5.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,X2PLOT(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP5.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP6.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,TAGPLO(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP6.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(NS2.NE.1)GOTO4090
      WRITE(ICOUT,4041)
 4041 FORMAT('SINCE THE GENERATED SAMPLE SIZE WAS ONLY 1,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4042)
 4042 FORMAT('THE ABOVE VALUE WAS THE SOLE VALUE COMPUTED.')
      CALL DPWRST('XXX','BUG ')
 4090 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4112)ILEFT,ILEFT2,ICOLL
 4112 FORMAT('THE CURRENT COLUMN FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4113)ILEFT,ILEFT2,NINEW
 4113 FORMAT('THE CURRENT LENGTH OF  ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 4059 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPNOSM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGA3,IBUGQ
 9013 FORMAT('IBUGA3,IBUGQ = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NS2
 9015 FORMAT('NS2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NS,NIISUB,NNOSM
 9016 FORMAT('NS,NIISUB,NNOSM = ',I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPOPAC(IHARG,IARGT,ARG,NUMARG,DEFOAC,
     1OPTACC,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE OPTIMIZATION TOLERANCE.
C              ROUGHLY SPEAKING, THIS DEFINES THE DESIRED LENGTH
C              OF THE FINAL UNCERTAINTY REGION.
C              THE SPECIFIED OPTIMIZATION TOLERANCE VALUE WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE OPTACC.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --DEFOAC (A  FLOATING POINT VARIABLE)
C     OUTPUT ARGUMENTS--OPTACC  (A  FLOATING POINT VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--94/7
C     ORIGINAL VERSION--JUNE      1994.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'=')GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'ACCU')GOTO1110
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'TOLE')GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ACCU')GOTO1150
      IF(IHARG(NUMARG).EQ.'TOLE')GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPOPAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR OPTIMIZATION TOLERANCE ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('      SUPPOSE THE THE ANALYST WILL BE CARRYING OUT  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      AN OPTIMIZATION, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      AND SUPPOSE THE ANALYST WISHES THE FINAL  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      UNCERTAINITY INTERVAL TO BE .00001 OR SMALLER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      OPTIMIZATION TOLERANCE .00001 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      HOLD=DEFOAC
      GOTO1180
C
 1160 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      OPTACC=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)OPTACC
 1181 FORMAT('THE OPTIMIZATION TOLERANCE HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPOPDE
C
C     PURPOSE--OPEN A GRAPHICS DEVICE
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     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'OPDE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPOPDE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IMANUF,IMODEL,IMODE2,IMODE3
   52 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IGUNIT,IGCODE
   53 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ISOFT,ISOFT2,ISOFT3
   54 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IGBAUD
   55 FORMAT('IGBAUD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)IBUGG4,ISUBG4,IERRG4
   56 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *****************************
C               **  STEP 1--               **
C               **  OPEN GRAPHICS DEVICES  **
C               *****************************
C
      CALL GROPDE
C
C               ******************************
C               **  STEP 2--                **
C               **  OPEN GRAPHICS SOFTWARE  **
C               ******************************
C
CCCCC CALL GROPSO
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'OPDE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPOPDE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IMANUF,IMODEL,IMODE2,IMODE3
 9012 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IGUNIT,IGCODE
 9013 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISOFT,ISOFT2,ISOFT3
 9014 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IGBAUD
 9015 FORMAT('IGBAUD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IBUGG4,ISUBG4,IERRG4
 9016 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPOPF0(IFILNU,IBUGS2,ISUBRO,IERROR)
C
C     PURPOSE--OPEN ONE OF THE GENERAL DATAPLOT FILES.
C              IN PARTICULAR, OPEN THE FILE WITH
C              NUMERIC DESIGNATION IFILNU
C              WHERE IFILNU MAY BE THE UNIT NUMBER FOR
C                 THE PLOT-1 FILE,
C                 THE PLOT-2 FILE,
C                 THE CONCLUSIONS FILE.
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     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--JANUARY   1986.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*80 IFILE
      CHARACTER*12 ISTAT
      CHARACTER*12 IFORM
      CHARACTER*12 IACCES
      CHARACTER*12 IPROT
      CHARACTER*12 ICURST
CCCCC CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOF2.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPOP'
      ISUBN2='F0  '
C
      IFOUND='YES'
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'OPF0')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPOPF0--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGS2,ISUBRO,IERROR
   52 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IFILNU
   53 FORMAT('IFILNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IPL1NU,IPL1ST
   54 FORMAT('IPL1NU,IPL1ST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IPL2NU,IPL2ST
   55 FORMAT('IPL2NU,IPL2ST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)ICONNU,ICONST
   56 FORMAT('ICONNU,ICONST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************************
C               **  STEP 11--                        **
C               **  BRANCH TO THE APPROPRIATE CASE   **
C               **  TO COPY OVER VARIABLES.          **
C               ***************************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'OPF0')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFILNU.EQ.IPL1NU)GOTO1110
      IF(IFILNU.EQ.IPL2NU)GOTO1120
      IF(IFILNU.EQ.ICONNU)GOTO1130
      GOTO1200
C
 1110 CONTINUE
      IOUNIT=IPL1NU
      IFILE=IPL1NA
      ISTAT=IPL1ST
      IFORM=IPL1FO
      IACCES=IPL1AC
      IPROT=IPL1PR
      ICURST=IPL1CS
      ISUBN0='OPF0'
      IERRFI='NO'
      GOTO1190
C
 1120 CONTINUE
      IOUNIT=IPL2NU
      IFILE=IPL2NA
      ISTAT=IPL2ST
      IFORM=IPL2FO
      IACCES=IPL2AC
      IPROT=IPL2PR
      ICURST=IPL2CS
      ISUBN0='OPF0'
      IERRFI='NO'
      GOTO1190
C
 1130 CONTINUE
      IOUNIT=ICONNU
      IFILE=ICONNA
      ISTAT=ICONST
      IFORM=ICONFO
      IACCES=ICONAC
      IPROT=ICONPR
      ICURST=ICONCS
      ISUBN0='OPF0'
      IERRFI='NO'
      GOTO1190
C
 1190 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'OPF0')GOTO1199
      WRITE(ICOUT,1193)IOUNIT
 1193 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1194)IFILE
 1194 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1195)ISTAT,IFORM,IACCES,IPROT,ICURST
 1195 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1196)ISUBN0,IERRFI
 1196 FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1199 CONTINUE
      GOTO1300
C
C               ****************************************
C               **  STEP 12--                         **
C               **  IF NO MATCH FOUND FOR CASE,       **
C               **  THEN WRITE OUT AN ERROR MESSAGE   **
C               ****************************************
C
 1200 CONTINUE
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'OPF0')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** INTERNAL ERROR IN DPOPF0--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)IFILNU
 1212 FORMAT('      THE FILE WITH LOGICAL UNIT NUMBER = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      WAS NOT OPENED BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      THIS LOGICAL UNIT NUMBER DID NOT MATCH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      THE LOGICAL UNIT NUMBER OF ANY OF')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      THE DATAPLOT GENERAL FILES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)IPL1NU,IPL2NU,ICONNU
 1217 FORMAT('      IPL1NU,IPL2NU,ICONNU = ',3I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               ****************************************
C               **  STEP 13--                         **
C               **  CHECK TO SEE IF FILE MAY EXIST    **
C               ****************************************
C
 1300 CONTINUE
      ISTEPN='13'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'OPF0')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')GOTO1310
      GOTO1390
 1310 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1311)
 1311 FORMAT('***** IMPLEMENTATION ERROR IN DPOPF0--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1312)
 1312 FORMAT('      THE DESIRED FILE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1313)
 1313 FORMAT('      WAS NOT OPENED BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1314)
 1314 FORMAT('      THE STATUS VARIABLE    ISTAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1315)
 1315 FORMAT('      (AS SET IN SUBROUTINE   INITFO)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1316)
 1316 FORMAT('      HAS THE SETTING   NONE   .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1317)IFILNU,ISTAT
 1317 FORMAT('      IFILNU,ISTAT = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1318)
 1318 FORMAT('      CONTACT THE DATAPLOT IMPLEMENTOR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1319)IFILNU
 1319 FORMAT('      AND HAVE THIS VARIABLE FOR FILE ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1320)
 1320 FORMAT('      SET TO THE PROPER VALUE (E.G.,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1321)
 1321 FORMAT('      OLD, NEW, UNKNOWN)')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1390 CONTINUE
C
C               *********************
C               **  STEP 31--      **
C               **  OPEN THE FILE  **
C               *********************
C
      ISTEPN='31'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'OPF0')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'OPF0')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPOPF0--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR
 9012 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFILNU
 9013 FORMAT('IFILNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IPL1NU,IPL1ST
 9014 FORMAT('IPL1NU,IPL1ST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IPL2NU,IPL2ST
 9015 FORMAT('IPL2NU,IPL2ST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)ICONNU,ICONST
 9016 FORMAT('ICONNU,ICONST = ',I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IOUNIT
 9021 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IFILE
 9022 FORMAT('IFILE  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)ISTAT
 9023 FORMAT('ISTAT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)IFORM
 9024 FORMAT('IFORM  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)IACCES
 9025 FORMAT('IACCES = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)IPROT
 9026 FORMAT('IPROT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)ICURST
 9027 FORMAT('ICURST = ',A12)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9028)IENDFI
C9028 FORMAT('IENDFI = ',A4)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IREWIN
 9029 FORMAT('IREWIN = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)ISUBN0
 9031 FORMAT('ISUBN0 = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IERRFI
 9032 FORMAT('IERRFI = ',A12)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPOPME(IHARG,NUMARG,
     1IDEFOM,IDEFHS,
     1IOPTME,IOPTHE,
     1IBUGS2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE OPTIMIZATION METHOD
C              CAN BE:
C                   <LINE/HOOK/DOGLEG>  <FINITE/BFGS>
C              WHERE THE FIRST ARGUMENT DEFINES THE STEP SELECTION
C              STRATEGY AND THE SECOND ARGUMENT DEFINES THE TYPE
C              OF HESSIAN APPROXIMATION.
C
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFOM (A  CHARACTER VARIABLE)
C                     --IDEFHS (A  CHARACTER VARIABLE)
C                     --IBUGS2 (A  CHARACTER VARIABLE)
C     OUTPUT ARGUMENTS--IOPTME (A CHARACTER VARIABLE)
C                     --IOPTME (A CHARACTER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--95/2
C     ORIGINAL VERSION--FEBRUARY 1995.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFOM
      CHARACTER*4 IDEFHS
      CHARACTER*4 IOPTME
      CHARACTER*4 IOPTHE
      CHARACTER*4 IBUGS2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGS2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPOPME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDEFOM,IDEFHS
   53 FORMAT('IDEFOM, IDEFHS = ',A4,1X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.1)GOTO1150
      IF(NUMARG.EQ.2)GOTO1110
      IF(NUMARG.EQ.3)GOTO1120
      IF(NUMARG.GE.4)GOTO9000
C
 1110 CONTINUE
      IHOLD1=IDEFOM
      IF(IHARG(2).EQ.'LINE')IHOLD1='LINE'
      IF(IHARG(2).EQ.'DOGL')IHOLD1='DOGL'
      IF(IHARG(2).EQ.'DOUB')IHOLD1='DOGL'
      IF(IHARG(2).EQ.'HOOK')IHOLD1='HOOK'
      GOTO1180
C
 1120 CONTINUE
      IHOLD1=IDEFOM
      IF(IHARG(2).EQ.'LINE')IHOLD1='LINE'
      IF(IHARG(2).EQ.'DOGL')IHOLD1='DOGL'
      IF(IHARG(2).EQ.'DOUB')IHOLD1='DOGL'
      IF(IHARG(2).EQ.'HOOK')IHOLD1='HOOK'
      IHOLD2=IDEFHS
      IF(IHARG(3).EQ.'FINI')IHOLD2='FINI'
      IF(IHARG(3).EQ.'DIFF')IHOLD2='FINI'
      IF(IHARG(3).EQ.'BFGS')IHOLD2='BFGS'
      GOTO1180
C
 1150 CONTINUE
      IHOLD1=IDEFOM
      IHOLD2=IDEFHS
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IOPTME=IHOLD1
      IOPTHE=IHOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IOPTME
 1181 FORMAT(
     1'THE OPTIMIZATION STEP SELECTION STRATEGY HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IOPTHE
 1182 FORMAT(
     1'THE OPTIMIZATION HESSIAN APPROXIMATION METHOD HAS JUST BEEN ',
     1'SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPOPME')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,IFOUND,IERROR
 9012 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IDEFOM,IDEFHS
 9013 FORMAT('IDEFOM, IDEFHS = ',A4,1X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IOPTME,IOPTHE
 9014 FORMAT('IOPTME, IOPTHE = ',A4,1X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPOPPL(IGRASW,
     1IBELSW,NUMRIN,IERASW,
     1IBACCO)
C
C     PURPOSE--CARRY OUT OPENING OPERATIONS
C              PRIOR TO THE GENERATION OF A PLOT.
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     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IBELSW
      CHARACTER*4 IERASW
      CHARACTER*4 IBACCO
C
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'OPPL')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPOPPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IMANUF,IMODEL,IMODE2,IMODE3
   52 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IGUNIT,IGCODE
   53 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ISOFT,ISOFT2,ISOFT3
   54 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IGBAUD
   55 FORMAT('IGBAUD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IGRASW
   61 FORMAT('IGRASW= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IBELSW,NUMRIN
   62 FORMAT('IBELSW,NUMRIN= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IERASW
   63 FORMAT('IERASW= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IBACCO
   64 FORMAT('IBACCO= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)IBUGG4,ISUBG4,IERRG4
   69 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ************************
C               **  STEP 1--          **
C               **  KILL THE PROMPT,  **
C               **  IF ONE EXISTS     **
C               ************************
C
CCCCC CALL GRKIPR
C
C               ****************************************************************
C               **  STEP 2--
C               **  EXIT OUT OF THE DIALOGUE (= MONITOR) MODE
C               **  AND MOVE TO GRAPHICS MODE.
C               **  THE GRAPHICS MODE ON VARIOUS TERMINALS
C               **  IS USUALLY OF 3 TYPES--
C               **     1. FOR TERMINALS WITH NO FORMAL GRAPHICS REGION AND
C               **        NO SEPARATE GRAPHICS PLANE
C               **        (AND THUS SUCCEDING GRAPHICS OUTPUT WILL
C               **        OVERWRITE THE NON-GRAPHICS DIALOGUE OUTPUT ON THE SCRE
C               **        THEN DO NOTHING.
C               **     2. FOR THOSE TERMINALS IN WHICH THE SCREEN
C               **        IS SHARED BETWEEN A GRAPHICS REGION AND
C               **        A DIALOGUE (= MONITOR) REGION (USUALLY AT THE BOTTOM),
C               **        THEN GO TO THE GRAPHICS REGION.
C               **     3. FOR TERMINALS WITH A FULL-SCREEN FOREGROUND
C               **        GRAPHICS PLANE THAT THE USER CAN FLIP-FLOP TO
C               **        AND WHICH IS INDEPENDENT OF THE DIALOGUE PLANE,
C               **        THEN GO TO THE GRAPHICS PLANE.
C               ****************************************************************
C
      IGRASW='ON'
      CALL GRSEMO(IGRASW,PDIAXC,PDIAYC)
C
C               ************************
C               **  STEP 3--          **
C               **  ERASE THE SCREEN  **
C               **  (IF CALLED FOR)   **
C               ************************
C
      IF(IERASW.EQ.'ON')CALL DPERSC(IBACCO)
C
C               *************************************
C               **  STEP 4--                       **
C               **  RING THE BELL (IF CALLED FOR)  **
C               **  TO SIGNAL A SCREEN ERASURE     **
C               *************************************
C
      IF(IBELSW.EQ.'OFF')GOTO1390
      IF(NUMRIN.LE.0)GOTO1390
      DO1300I=1,NUMRIN
      CALL GRRIBE
 1300 CONTINUE
 1390 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'OPPL')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPOPPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IMANUF,IMODEL,IMODE2,IMODE3
 9012 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IGUNIT,IGCODE
 9013 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISOFT,ISOFT2,ISOFT3
 9014 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IGBAUD
 9015 FORMAT('IGBAUD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IGRASW
 9021 FORMAT('IGRASW= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IBELSW,NUMRIN
 9022 FORMAT('IBELSW,NUMRIN= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)IERASW
 9023 FORMAT('IERASW= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)IBACCO
 9024 FORMAT('IBACCO= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPOPT(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IA,PARAM,IPARN,IPARN2,
CCCCC FEBRUARY 1995.  ADD IOPTME, IOPTHE TO ARGUMENT LIST.
     1OPTACC,IOPTME,IOPTHE,
     1ISUBRO,IBUGA3,IBUGCO,IBUGEV,IBUGQ,IERROR)
C
C     PURPOSE--TREAT THE LET CASE FOR
C              FINDING THE MINIMUM OF A FUNCTION.
C     EXAMPLE--UNIVARIATE CASE:
C            --LET A = OPTIMIZE X**3+2*X**2-4*X+5 WRT X FOR X = -100 200
C            --LET A = F1 WRT X FOR X = 0 B
C            --USES FMIN ROUTINE FROM "NUMERICAL METHODS AND SOFTWARE",
C              BY KAHANER, MOLER, AND NASH
C     EXAMPLE--MULTI-UNIVARIATE CASE:
C            --(START VALUE FROM X(1) AND Y(1))
C            --LET A = OPTIMIZE X**2+Y**2-X*Y WRT X Y 
C            --LET A = F1 WRT X Y
C            --USES UNCMIN PACKAGE OF ROBERT SCHNABEL AND BARRY WEISS
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--94/6
C     ORIGINAL VERSION--JUNE      1994.
C     UPDATED         --MAY       1995.  BUGS IN DECLARATIONS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ITYPEH
      CHARACTER*4 IW21HO
      CHARACTER*4 IW22HO
      CHARACTER*4 IA
      CHARACTER*4 IPARN
      CHARACTER*4 IPARN2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
      CHARACTER*4 IERROR
CCCCC ADD FOLLOWING LINE NOVEMBER 1994.
      CHARACTER*4 IANGLU
CCCCC ADD FOLLOWING LINES MAY 1995
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
C
      CHARACTER*4 NEWNAM
      CHARACTER*4 IWD1
      CHARACTER*4 IWD12
      CHARACTER*4 IWD2
      CHARACTER*4 IWD22
      CHARACTER*4 ILAB
      CHARACTER*4 IKEY
      CHARACTER*4 IKEY2
      CHARACTER*4 INCLUN
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASUP
      CHARACTER*4 IERRO2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IFOUN1
      CHARACTER*4 IFOUN2
      CHARACTER*4 IOLD
      CHARACTER*4 IOLD2
      CHARACTER*4 INEW
      CHARACTER*4 INEW2
      CHARACTER*4 IHPARN
      CHARACTER*4 IHPAR2
      CHARACTER*4 IHL
      CHARACTER*4 IHL2
      CHARACTER*4 IDUMV
      CHARACTER*4 IDUMV2
      CHARACTER*4 IHOUT
      CHARACTER*4 IHOUT2
      CHARACTER*4 IUOUT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IFOUND
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
CCCCC FEBRUARY 1995.  ADD FOLLOWING 2 LINES
      CHARACTER*4 IOPTME
      CHARACTER*4 IOPTHE
CCCCC MAY 1995.  ADD FOLLOWING LINE
      CHARACTER*4 ICASE
CCCCC MAY 1995.  ADD FOLLOWING LINE
      CHARACTER*4 ISUBN0
C
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IERRF1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
C
      CHARACTER*80 IFILE2
      CHARACTER*12 ISTAT2
      CHARACTER*12 IFORM2
      CHARACTER*12 IACCE2
      CHARACTER*12 IPROT2
      CHARACTER*12 ICURS2
      CHARACTER*4 IERRF2
      CHARACTER*4 IENDF2
      CHARACTER*4 IREWI2
C
C---------------------------------------------------------------------
C
      DIMENSION ITYPEH(*)
      DIMENSION IW21HO(*)
      DIMENSION IW22HO(*)
      DIMENSION W2HOLD(*)
C
      DIMENSION IA(*)
      DIMENSION PARAM(*)
      DIMENSION IPARN(*)
      DIMENSION IPARN2(*)
C
CCCCC FOLLOWING SECTION ADDED FEBRARY 1995 FOR OPTIMIZATION.
C
      PARAMETER (MAXOPT=100)
      DIMENSION IDUMV(MAXOPT)
      DIMENSION IDUMV2(MAXOPT)
C
      DIMENSION ILAB(10)
      DIMENSION IOLD(10)
      DIMENSION IOLD2(10)
      DIMENSION INEW(10)
      DIMENSION INEW2(10)
      DIMENSION VJUNK(1)
C
      DOUBLE PRECISION TYPSIZ(MAXOPT)
      DOUBLE PRECISION XSTART(MAXOPT)
      DOUBLE PRECISION XPLS(MAXOPT)
      DOUBLE PRECISION GPLS(MAXOPT)
      DOUBLE PRECISION A(MAXOPT,MAXOPT)
      DOUBLE PRECISION WORK(MAXOPT,8)
      REAL XVALUE(MAXOPT)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOF2.INC'
C
C-----MAKE DUMMY COMMON BLOCK FOR MULTIVARIATE MINIMIZATION-----------
C
      PARAMETER (IOPTCH=1000)
      PARAMETER (IOPTC2=100)
C
      CHARACTER*4 IBUGAZ
      CHARACTER*4 ZTYPEH
      CHARACTER*4 ZW21HO
      CHARACTER*4 ZW22HO
      CHARACTER*4 ZIPARN
      CHARACTER*4 ZPARN2
      CHARACTER*4 ZMODEL
      CHARACTER*4 ZIDUMV
      CHARACTER*4 ZDUMV2
C
      DIMENSION ZMODEL(IOPTCH)
      DIMENSION ZTYPEH(IOPTCH)
      DIMENSION ZW21HO(IOPTCH)
      DIMENSION ZW22HO(IOPTCH)
      DIMENSION Z2HOLD(IOPTCH)
C
      DIMENSION ZPARAM(IOPTC2)
      DIMENSION ZIPARN(IOPTC2)
      DIMENSION ZPARN2(IOPTC2)
      DIMENSION ZIDUMV(IOPTC2)
      DIMENSION ZDUMV2(IOPTC2)
      DIMENSION LOCDUM(IOPTC2)
C
      COMMON /OPTCMC/ IBUGAZ, ZTYPEH, ZW21HO, ZW22HO, ZIPARN, ZPARN2, 
     &                ZIDUMV, ZDUMV2, ZMODEL
      COMMON /OPTCMR/ ZPARAM, Z2HOLD, 
     &                NUMCHZ, NUMPVZ, NWHOLZ, NUMDVZ, LOCDUM
CCCCC EXTERNAL OPTFCN
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPOP'
      ISUBN2='T   '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      ILOCMX=0
      NUMLIM=0
      ILOC3=0
C
C               **************************************
C               **  TREAT THE OPTIMIZATION SUBCASE  **
C               **  OF THE LET COMMAND              **
C               **************************************
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'POPT')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPOPT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGCO,IBUGEV
   53 FORMAT('IBUGCO,IBUGEV = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IBUGQ
   54 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'POPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NEWNAM='NO'
C
      MAXN2=MAXCHF
      MAXN3=MAXCHF
C
C               *******************************************************
C               **  STEP 2--                                          *
C               **  EXAMINE THE LEFT-HAND SIDE--                      *
C               **  IS THE VARIABLE NAME TO LEFT OF = SIGN            *
C               **  ALREADY IN THE NAME LIST?                         *
C               **  NOTE THAT     ILISTL    IS THE LINE IN THE TABLE  *
C               **  OF THE NAME ON THE LEFT.                          *
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'POPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      DO2000I=1,NUMNAM
      I2=I
      IF(IHLEFT.EQ.IHNAME(I).AND.IHLEF2.EQ.IHNAM2(I))GOTO2100
 2000 CONTINUE
      NEWNAM='YES'
      ILISTL=NUMNAM+1
      IF(ILISTL.GT.MAXNAM)GOTO2200
      GOTO2900
 2200 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2201)
 2201 FORMAT('***** ERROR IN DPOPT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2202)
 2202 FORMAT('      THE NUMBER OF VARIABLE, PARAMETER, AND FUNCTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2203)MAXNAM
 2203 FORMAT('      NAMES HAS JUST EXCEEDED THE ALLOWABLE ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2204)
 2204 FORMAT('      ENTER      STATUS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2205)
 2205 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2206)
 2206 FORMAT('      AND THEN REDEFINE (REUSE) SOME OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2207)
 2207 FORMAT('      ALREADY-USED NAMES')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2100 CONTINUE
      ILISTL=I2
 2900 CONTINUE
C
C               ******************************************************
C               **  STEP 3.1--                                      **
C               **  EXTRACT THE RIGHT-SIDE FUNCTIONAL               **
C               **  EXPRESSION FROM THE INPUT COMMAND LINE          **
C               **  (STARTING WITH THE FIRST NON-BLANK LOCATION AFTER*
C               **  THE EQUAL SIGN AND ENDING WITH THE END OF THE LINE
C               **  OR WITH THE LAST NON-BLANK CHARACTER BEFORE  WRT *
C               **  PLACE THE FUNCTION IN IFUNC2(.)  .              **
C               ******************************************************
C
      ISTEPN='3.1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'POPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWD1=IHARG(3)
      IWD12=IHARG2(3)
      IWD2='WRT '
      IWD22='    '
      CALL DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
     1IFUNC2,N2,IBUGA3,IFOUND,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(IFOUND.EQ.'YES')GOTO3500
C
      IWD1=IHARG(3)
      IWD12=IHARG2(3)
      IWD2='FOR '
      IWD22='    '
      CALL DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
     1IFUNC2,N2,IBUGA3,IFOUND,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(IFOUND.EQ.'YES')GOTO3500
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3101)
 3101 FORMAT('***** ERROR IN DPOPT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3102)
 3102 FORMAT('      INVALID COMMAND FORM FOR OPTIMIZATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3103)
 3103 FORMAT('      GENERAL FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3104)
 3104 FORMAT('      LET ... = OPTIMIZATION ... WRT  ... ',
     1'FOR ... = ... TO ...')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3105)
 3105 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3106)(IANS(I),I=1,IWIDTH)
 3106 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3500 CONTINUE
C
C               *****************************************************
C               **  STEP 3.2--                                     **
C               **  DETERMINE IF THE RIGHT-HAND SIDE IS            **
C               **  IN FUNCTION FORM OR IS IN EQUATION FORM.       **
C               **  IF IN EQUATION FORM, CONVERT TO FUNCTION FORM  **
C               **  BY REPLACING THE EQUAL SIGN BY A MINUS SIGN    **
C               **  AND ENCLOSING THE REST OF THE EXPRESSION IN    **
C               **  PARENTHESES.                                   **
C               **  PLACE THE OUTPUT FUNCTION BACK IN IFUNC2(.)    **
C               *****************************************************
C
      ISTEPN='3.2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'POPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO3600I=1,N2
      I2=I
      IF(IFUNC2(I).EQ.'=')GOTO3610
 3600 CONTINUE
      GOTO3900
 3610 CONTINUE
      ILOCE2=I2
C
      IMIN=ILOCE2+1
      IF(IMIN.GT.N2)GOTO3690
      DO3650I=IMIN,N2
      IREV=N2-I+IMIN
      IREVP1=IREV+1
      IFUNC2(IREVP1)=IFUNC2(IREV)
 3650 CONTINUE
      I=ILOCE2
      IFUNC2(I)='-'
      I=ILOCE2+1
      IFUNC2(I)='('
      I=N2+2
      IFUNC2(I)=')'
      N2=I
 3690 CONTINUE
C
 3900 CONTINUE
C
C
C               *******************************************************
C               **  STEP 4--                                         **
C               **  DETERMINE IF THE EXPRESSION HAS ANY FUNCTION NAMES*
C               **  INBEDDED.  IF SO, REPLACE THE FUNCTION NAMES     **
C               **  BY EACH FUNCTION'S DEFINITION.  DO SO REPEATEDLY **
C               **  UNTIL ALL FUNCTION REFERENCES HAVE BEEN ANNIHILATED
C               **  AND THE EXPRESSION IS LEFT ONLY WITH             **
C               **  CONSTANTS, PARAMETERS, AND VARIABLES--NO FUNCTIONS.
C               **  PLACE THE RESULTING FUNCTIONAL EXPRESSION INTO   **
C               **   IFUNC3(.)                                       **
C               *******************************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'POPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPEXFU(IFUNC2,N2,IHNAME,IHNAM2,IUSE,IVSTAR,IVSTOP,
     1NUMNAM,IANS,IWIDTH,IFUNC,NUMCHF,MAXCHF,IFUNC3,N3,MAXN3,
     1IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      IF(IBUGA3.EQ.'OFF')GOTO5090
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      ILAB(1)='INPU'
      ILAB(2)='T FU'
      ILAB(3)='NCTI'
      ILAB(4)='ON  '
      ILAB(5)='    '
      ILAB(6)='  = '
      NUMWDL=6
      CALL DPPRIF(ILAB,NUMWDL,IFUNC3,N3,IBUGA3)
C
      WRITE(ICOUT,5081)IDUMV(1),IDUMV2(1)
 5081 FORMAT('OPTIMIZATION VARIABLE         = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
C
 5090 CONTINUE
C
C               *************************************
C               **  STEP 5--                       **
C               **  EXTRACT QUALIFIER INFORMATION. **
C               *************************************
C
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'POPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ******************************************************
C               **  STEP 5.1--                                      **
C               **  DETERMINE THE DUMMY VARIABLE FOR THE OPTIMIZATION*
C               ******************************************************
CCCCC FEBRUARY 1995.  AT THIS STEP, CHECK FOR UNIVARIATE OR
CCCCC MULTIVARIATE CASE.  DO THIS BY CHECKING TO SEE IF THERE IS
CCCCC A "FOR" CLAUSE.  IF YES, THEN UNIVARIATE CASE.  IF NO, THEN
CCCCC HAVE A MULTIVARIATE CASE.
C
      ISTEPN='5.1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'POPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASE='UNIV'
C
CCCCC FOLLOWING BLOCK ADDED FEBRUARY 1995.
      IKEY='FOR '
      IKEY2='    '
      ISHIFT=1
      ILOCA=1
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO5300
C
CCCCC END ADDITION.
C
      IKEY='WRT '
      IKEY2='    '
      ISHIFT=1
      ILOCA=1
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO5119
      IDUMV(1)=IHOUT
      IDUMV2(1)=IHOUT2
      NUMDV=1
      GOTO5190
 5119 CONTINUE
C
      IKEY='FOR '
      IKEY2='    '
      ISHIFT=1
      ILOCA=1
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO5129
      IDUMV(1)=IHOUT
      IDUMV2(1)=IHOUT2
      NUMDV=1
      GOTO5190
 5129 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5181)
 5181 FORMAT('***** ERROR IN DPOPT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5182)
 5182 FORMAT('      INVALID COMMAND FORM FOR OPTIMIZATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5183)
 5183 FORMAT('      NO VARIABLE FOR OPTIMIZATION DEFINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5185)
 5185 FORMAT('      GENERAL FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5186)
 5186 FORMAT('      LET ... = OPTIMIZATION ... WRT ... ',
     1'FOR ... = ... TO ...')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5187)
 5187 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,5189)(IANS(I),I=1,IWIDTH)
 5189 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 5190 CONTINUE
C
C               **************************************************
C               **  STEP 5.2--                                  **
C               **  DETERMINE THE LIMITS FOR THE OPTIMIZATION.  **
C               **************************************************
C
      ISTEPN='5.2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'POPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMLIM=0
C
      IKEY='FOR '
      IKEY2='    '
      ISHIFT=3
      ILOCA=1
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO5219
      XMIN=VOUT
      NUMLIM=NUMLIM+1
 5219 CONTINUE
C
      IKEY='FOR '
      IKEY2='    '
      ISHIFT=4
      ILOCA=1
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO5239
      IF(IHOUT.EQ.'TO  '.AND.IHOUT2.EQ.'    ')GOTO5229
      XMAX=VOUT
      ILOCMX=ILOC2
      NUMLIM=NUMLIM+1
 5229 CONTINUE
C
      IF(NUMLIM.EQ.2)GOTO5239
      IKEY='FOR '
      IKEY2='    '
      ISHIFT=5
      ILOCA=1
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO5239
      XMAX=VOUT
      ILOCMX=ILOC2
      NUMLIM=NUMLIM+1
 5239 CONTINUE
C
      IF(NUMLIM.EQ.2)GOTO5290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5281)
 5281 FORMAT('***** ERROR IN DPOPT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5282)
 5282 FORMAT('      INVALID COMMAND FORM FOR OPTIMIZATION.')
      CALL DPWRST('XXX','BUG ')
      IF(NUMLIM.EQ.0)WRITE(ICOUT,5283)
 5283 FORMAT('      NO LIMITS FOR OPTIMIZATION DEFINED.')
      IF(NUMLIM.EQ.0)CALL DPWRST('XXX','BUG ')
      IF(NUMLIM.EQ.1)WRITE(ICOUT,5284)
 5284 FORMAT('      ONLY ONE LIMIT FOR OPTIMIZATION DEFINED.')
      IF(NUMLIM.EQ.1)CALL DPWRST('XXX','BUG ')
      IF(NUMLIM.NE.0.AND.NUMLIM.NE.1)WRITE(ICOUT,5285)NUMLIM
 5285 FORMAT('      NUMBER OF LIMITS DEFINED = ',I8)
      IF(NUMLIM.NE.0.AND.NUMLIM.NE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5286)
 5286 FORMAT('      GENERAL FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5287)
 5287 FORMAT('      LET ... = OPTIMIZATION ... WRT ... ',
     1'FOR ... = ... TO ...')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5288)
 5288 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,5289)(IANS(I),I=1,IWIDTH)
 5289 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 5290 CONTINUE
      GOTO5999
C
C               ******************************************************
C               **  STEP 5.3--                                      **
C               **  MULTIVARIATE CASE-EXTRACT LIST OF VARIABLES     **
C               ******************************************************
C
 5300 CONTINUE
C
      ICASE='MULT'
C
      IKEY='WRT '
      IKEY2='    '
      ISHIFT=1
      ILOCA=1
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5311)
 5311   FORMAT('***** ERROR IN DPOPT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5312)
 5312   FORMAT('      INVALID COMMAND FORM FOR OPTIMIZATION.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5313)
 5313   FORMAT('      NO WRT CLAUSE DEFINED.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5316)
 5316   FORMAT('      GENERAL FORM--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5317)
 5317   FORMAT('      LET ... = OPTIMIZATION ... WRT ... ',
     1  'FOR ... = ... TO ...')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5318)
 5318   FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)WRITE(ICOUT,5319)(IANS(I),I=1,IWIDTH)
 5319   FORMAT('      ',100A1)
        IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
      IF(IUOUT.EQ.'V')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5411)
 5411   FORMAT('***** ERROR IN DPOPT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5412)IHOUT,IHOUT2
 5412   FORMAT('      DUMMY VARIABLE ',A4,A4,' WAS PREVIOUSLY ',
     1         'DEFINED AS A VARIABLE RATHER THAN A PARAMETER.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ELSE
        IDUMV(1)=IHOUT
        IDUMV2(1)=IHOUT2
        NUMDV=1
        XSTART(1)=VOUT
      ENDIF
C
      JMIN=ILOC1
      NUMDV=NUMARG-JMIN
      IF(NUMDV.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5511)
 5511   FORMAT('***** ERROR IN DPOPT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5512)
 5512   FORMAT('      NO FOR CLAUSE FOUND FOR 1-DIMENSIONAL CASE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5516)
 5516   FORMAT('      GENERAL FORM--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5517)
 5517   FORMAT('      LET ... = OPTIMIZATION ... WRT ... ',
     1  'FOR ... = ... TO ...')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5518)
 5518   FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)WRITE(ICOUT,5519)(IANS(I),I=1,IWIDTH)
 5519   FORMAT('      ',100A1)
        IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      ICOUNT=1
      ILOCA=JMIN
      ILOCB=NUMARG
      DO5600J=JMIN+2,NUMARG
      IKEY='WRT '
      IKEY2='    '
      ICOUNT=ICOUNT+1
      ISHIFT=ICOUNT
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(IUOUT.EQ.'V')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5611)
 5611   FORMAT('***** ERROR IN DPOPT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5612)IHOUT,IHOUT2
 5612   FORMAT('      DUMMY VARIABLE ',A4,A4,' WAS PREVIOUSLY ',
     1         'DEFINED AS A VARIABLE RATHER THAN A PARAMETER.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ELSE
        IDUMV(ICOUNT)=IHOUT
        IDUMV2(ICOUNT)=IHOUT2
        XSTART(ICOUNT)=VOUT
      ENDIF
 5600 CONTINUE
C
      GOTO6390
C
 5999 CONTINUE
C
C               **********************************************
C               **  STEP 6.3--                              **
C               **  SCAN THE QUALIFIERS FOR VARIABLE,       **
C               **  PARAMETER, FUNCTION, AND VALUE CHANGES  **
C               **  IN THE FUNCTION.                        **
C               **********************************************
C
      ISTEPN='6.3'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'POPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NCHANG=0
      DO6300IFORI=1,10
C
      IKEY='FOR '
      IKEY2='    '
      ISHIFT=1
      IF(IFORI.EQ.1)ILOCA=ILOCMX
      IF(IFORI.NE.1)ILOCA=ILOC3
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO6380
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO6350
C
      ILOC3=ILOC2+2
      IF(ILOC3.GT.NUMARG)GOTO6380
      NCHANG=NCHANG+1
      IOLD(NCHANG)=IHARG(ILOC2)
      IOLD2(NCHANG)=IHARG2(ILOC2)
      INEW(NCHANG)=IHARG(ILOC3)
      INEW2(NCHANG)=IHARG2(ILOC3)
C
 6300 CONTINUE
 6350 CONTINUE
      GOTO6390
C
 6380 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6301)
 6301 FORMAT('***** ERROR IN DPOPT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6302)
 6302 FORMAT('      INVALID COMMAND FORM FOR OPTIMIZATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6303)
 6303 FORMAT('      GENERAL FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6304)
 6304 FORMAT('      LET FUNCTION ... = OPTIMIZATION ... WRT ... ',
     1'FOR ... = ... TO ...')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6305)
 6305 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,6306)(IANS(I),I=1,IWIDTH)
 6306 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 6390 CONTINUE
C
C               **********************************************
C               **  STEP 6.4--                              **
C               **  CARRY OUT THE VARIABLE,                 **
C               **  PARAMETER, AND FUNCTION CHANGES         **
C               **  AND THEN PRINT OUT A BRIEF MESSAGE      **
C               **  INDICATING THAT THE CHANGES             **
C               **  HAVE BEEN MADE.                         **
C               **********************************************
C
      ISTEPN='6.4'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'POPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO6490
      IF(IFEEDB.EQ.'OFF')GOTO6490
      IF(NCHANG.LE.0)GOTO6490
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      ILAB(1)='PRE '
      ILAB(2)='-CHA'
      ILAB(3)='NGE '
      ILAB(4)='FUNC'
      ILAB(5)='TION'
      ILAB(6)='  = '
      NUMWDL=6
      CALL DPPRIF(ILAB,NUMWDL,IFUNC3,N3,IBUGA3)
C
      CALL COMPIC(IFUNC3,N3,IOLD,IOLD2,INEW,INEW2,NCHANG,IFUNC3,N3,
     1IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      ILAB(1)='POST'
      ILAB(2)='-CHA'
      ILAB(3)='NGE '
      ILAB(4)='FUNC'
      ILAB(5)='TION'
      ILAB(6)='  = '
      NUMWDL=6
      CALL DPPRIF(ILAB,NUMWDL,IFUNC3,N3,IBUGA3)
C
 6490 CONTINUE
C
C               *******************************************************
C               **  STEP 6.7--                                       **
C               **  MAKE A NON-CALCULATING PASS AT THE FUNCTION      **
C               **  SO AS TO EXTRACT ALL PARAMETER AND VARIABLE NAMES.*
C               *******************************************************
C
      ISTEPN='6.8'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'POPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IPASS=1
      CALL COMPIM(IFUNC3,N3,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,AJUNK,
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ***********************************************
C               **  STEP 7--                                 **
C               **  CHECK THAT ALL PARAMETERS                **
C               **  IN THE FUNCTION ARE ALREADY PRESENT      **
C               **  IN THE AVAILABLE NAME LIST IHNAME(.).    **
C               **  ALSO CHECK THAT THE VARIABLE NAME        **
C               **  THAT FOLLOWS FOR (THAT IS, THE DUMMY     **
C               **  VARIABLE IS IN THE FUNCTION.             **
C               **  NOTE--ALL PARAMETERS AND VARIABLES       **
C               **  THAT ARE NOT FOUND IN IHNAME(.)          **
C               **  WILL BE AUTOMATICALLY SET TO 0.0         **
C               **  (BUT ONLY TEMPORARILY);                  **
C               **  THIS CONVENTION ALLOWS AN AUTOMATIC      **
C               **  SOLUTION TO THE PROBLEM OF OPTIMIZING    **
C               **  EQUATIONS (AS OPPOSED TO FUNCTIONS)      **
C               **  SINCE 'Y' WILL TYPICALLY BE SET TO ZERO  **
C               **  AS ONE WOULD WANT FOR OPTIMIZING         **
C               ***********************************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'POPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IP=0
      IV=0
      IF(NUMPV.LE.0)GOTO7650
      DO7600J=1,NUMPV
      IHPARN=IPARN(J)
      IHPAR2=IPARN2(J)
      DO7602JJ=1,NUMDV
        IF(IHPARN.EQ.IDUMV(JJ).AND.IHPAR2.EQ.IDUMV2(JJ))GOTO7620
 7602 CONTINUE
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHPARN,IHPAR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
      IF(IERRO2.EQ.'YES')GOTO7605
      GOTO7610
C
 7605 CONTINUE
      IP=IP+1
      PARAM(J)=0.0
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7606)IHPARN,IHPAR2
 7606 FORMAT('NOTE--',A4,A4,' HAS BEEN TEMPORARILY SET TO ZERO')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7607)
 7607 FORMAT('             FOR THE OPTIMIZATION PROCESS.')
      CALL DPWRST('XXX','BUG ')
      GOTO7600
C
 7610 CONTINUE
      IP=IP+1
      PARAM(J)=VALUE(ILOCP)
      GOTO7600
C
 7620 CONTINUE
      IV=IV+1
      LOCDUM(IV)=J
      PARAM(J)=VALUE(LOCDUM(IV))
 7600 CONTINUE
 7650 CONTINUE
C
C               *********************************
C               **  STEP 8--                   **
C               **  DETERMINE THE OPTIMIZATION **
C               *********************************
C
      ISTEPN='8'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'POPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'POPT')GOTO7719
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7711)
 7711 FORMAT('***** FROM DPOPT, IMMEDIATELY BEFORE CALLING ',
     1'OPTIMIZATION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7712)N3,NUMPV
 7712 FORMAT('N3,NUMPV = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7713)NUMDV,XMIN,XMAX
 7713 FORMAT('NUMDV,XMIN,XMAX = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
      DO7714I=1,NUMDV
      WRITE(ICOUT,7715)I,IDUMV(I),IDUMV2(I)
 7715 FORMAT('I,IDUMV(I),IDUMV2(I) = ',I8,2X,A4,A4)
      CALL DPWRST('XXX','BUG ')
 7714 CONTINUE
      WRITE(ICOUT,7716)IBUGA3,IBUGCO,IBUGEV
 7716 FORMAT('IBUGA3,IBUGCO,IBUGEV = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 7719 CONTINUE
C
      IF(ICASE.EQ.'MULT')THEN
C
C  COPY OVER DUMMY COMMON BLOCKS FOR OPTFUN ROUTINE
C
        DO7805KK=1,MAXF3
          ZMODEL(KK)=IFUNC3(KK)
 7805   CONTINUE
        DO7810KK=1,IOPTCH
          ZTYPEH(KK)=ITYPEH(KK)
          ZW21HO(KK)=IW21HO(KK)
          ZW22HO(KK)=IW22HO(KK)
          Z2HOLD(KK)=W2HOLD(KK)
 7810   CONTINUE
        DO7820KK=1,IOPTC2
          ZPARAM(KK)=PARAM(KK)
          ZIPARN(KK)=IPARN(KK)
          ZPARN2(KK)=IPARN2(KK)
          ZIDUMV(KK)=IDUMV(KK)
          ZDUMV2(KK)=IDUMV2(KK)
 7820   CONTINUE
        NUMCHZ=N3
        NUMPVZ=NUMPV
        NWHOLZ=NWHOLD
        NUMDVZ=NUMDV
        IBUGAZ=IBUGA3
C
        IHP='OPTS'
        IHP2='CALE'
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          FSCALE=0.0
        ELSE
          FSCALE=VALUE(ILOCP)
        ENDIF
C
        IHP='OPTM'
        IHP2='SG  '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          MSG=8
        ELSE
          MSG=VALUE(ILOCP)+0.5
        ENDIF
C
        IHP='OPTI'
        IHP2='TER '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          ITNLIM=150
        ELSE
          ITNLIM=VALUE(ILOCP)+0.5
        ENDIF
C
        IHP='OPTD'
        IHP2='LT  '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          DLT=0.0
        ELSE
          DLT=VALUE(ILOCP)
        ENDIF
C
        IHP='OPTG'
        IHP2='RDTL'
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          GRADTL=0.0
        ELSE
          GRADTL=VALUE(ILOCP)
        ENDIF
C
        IHP='OPTS'
        IHP2='PMX '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          STEPMX=0.0
        ELSE
          STEPMX=VALUE(ILOCP)
        ENDIF
C
        IHP='OPTS'
        IHP2='TPTL'
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          STEPTL=0.0
        ELSE
          STEPTL=VALUE(ILOCP)
        ENDIF
C
        IOUNI2=IST2NU
        IFILE2=IST2NA
        ISTAT2=IST2ST
        IFORM2=IST2FO
        IACCE2=IST2AC
        IPROT2=IST2PR
        ICURS2=IST2CS
        ISUBN0='POPT'
        IERRF2='NO'
C
        IREWI2='ON'
        CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1  IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
        IF(IERRF2.EQ.'YES')GOTO9000
C
        CALL DPOPT3(
     1  TYPSIZ,XSTART,XPLS,GPLS,A,WORK,
     1  NUMDV,
     1  OPTACC,IOPTME,IOPTHE,
     1  ITNLIM,DLT,GRADTL,STEPMX,STEPTL,FSCALE,MSG,
     1  FPLS,
     1  ISUBRO,IBUGA3,IBUGCO,IBUGEV,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        DO7900I=1,NUMDV
          XVALUE(I)=SNGL(XPLS(I))
 7900   CONTINUE
C
        IOUNI1=IST1NU
        IFILE1=IST1NA
        ISTAT1=IST1ST
        IFORM1=IST1FO
        IACCE1=IST1AC
        IPROT1=IST1PR
        ICURS1=IST1CS
        ISUBN0='FIT3'
        IERRF1='NO'
C
        IREWI1='ON'
        CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1  IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
        DO7910I=1,NUMDV
          WRITE(IOUNI1,7911)SNGL(GPLS(I))
 7910   CONTINUE
 7911   FORMAT(1X,E15.7)
        IF(IFEEDB.EQ.'OFF')GOTO7919
        WRITE(ICOUT,7914)
 7914   FORMAT(6X,'GRADIENTS WRITTEN OUT TO FILE DPST1F.DAT')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7916)
 7916   FORMAT(6X,'HESSIAN MATRIX WRITTEN OUT TO FILE DPST2F.DAT')
        CALL DPWRST('XXX','WRIT')
 7919   CONTINUE
C
        IENDF1='OFF'
        IREWI1='ON'
        CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1  IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
        IENDF2='OFF'
        IREWI2='ON'
        CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1  IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
        IF(IERRF2.EQ.'YES')GOTO9000
C
      ELSE
        CALL DPOPT2(IFUNC3,N3,PARAM,IPARN,IPARN2,NUMPV,
     1  ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1  IDUMV,IDUMV2,NUMDV,XMIN,XMAX,OPTVAL,
     1  OPTACC,
     1  ISUBRO,IBUGA3,IBUGCO,IBUGEV,IERROR)
      ENDIF
C
C               *****************************************
C               **  STEP 9--                           **
C               **  ENTER THE OPTIMIZED VALUE  INTO THE**
C               **  DATAPLOT PARAMETER TABLE.          **
C               **  FOR UNIVARIATE CASE, SAVE SINGLE   **
C               **  PARAMETER VALUE.  FOR MULTIVARIATE,**
C               **  SAVE INDIVIDUAL PARAMETERS AND ALSO**
C               **  A VARIABLE CONTAINING THESE VALUES **
C               *****************************************
C
      ISTEPN='9'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'POPT')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASE.EQ.'MULT')THEN
        NJUNK=NUMDV
        IHL=IHLEFT
        IHL2=IHLEF2
        ICASUP='V'
        CALL DPINVP(IHL,IHL2,ICASUP,XVALUE,NUMDV,FPLS,NJUNK,
     1  ISUBN1,ISUBN2,IBUGA3,IERROR)
        IHL='OPTV'
        IHL2='ALUE'
        ICASUP='P'
        VJUNK(1)=REAL(XPLS(1))
        CALL DPINVP(IHL,IHL2,ICASUP,VJUNK,NUMDV,FPLS,NJUNK,
     1  ISUBN1,ISUBN2,IBUGA3,IERROR)
        DO8000I=1,NUMDV
          IHL=IDUMV(I)
          IHL2=IDUMV2(I)
          ICASUP='P'
          VALTMP=REAL(XPLS(I))
          VJUNK(1)=VALTMP
          CALL DPINVP(IHL,IHL2,ICASUP,VJUNK,NUMDV,VALTMP,NJUNK,
     1    ISUBN1,ISUBN2,IBUGA3,IERROR)
 8000   CONTINUE
C
      ELSE
        IHL=IHLEFT
        IHL2=IHLEF2
        ICASUP='P'
        NJUNK=1
        VJUNK(1)=OPTVAL
        CALL DPINVP(IHL,IHL2,ICASUP,VJUNK,NJUNK,OPTVAL,NJUNK,
     1  ISUBN1,ISUBN2,IBUGA3,IERROR)
      ENDIF
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT      **
C               ****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'POPT')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END OF DPOPT--')
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NUMNAM
      WRITE(ICOUT,9016)I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I)
 9016 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I)=',
     1I8,2X,A4,A4,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9017)NUMCHF,MAXCHF,IWIDTH,N2
 9017 FORMAT('NUMCHF,MAXCHF,IWIDTH,N2 = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)(IFUNC(I),I=1,IWIDTH)
 9018 FORMAT('IFUNC(.) = ',115A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)(IFUNC2(I),I=1,N2)
 9019 FORMAT('IFUNC2(.) = ',115A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)N3
 9020 FORMAT('N3 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)(IFUNC3(I),I=1,N3)
 9021 FORMAT('IFUNC3(.) = ',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)NUMPV
 9022 FORMAT('NUMPV = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)IHLEFT,IHLEF2
 9023 FORMAT('IHLEFT, IHLEF2 = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      DO9120I=1,NUMDV
      WRITE(ICOUT,9123)I,IDUMV(I),IDUMV2(I)
 9123 FORMAT('I,IDUMV(I),IDUMV2(I) = ',I3,2X,A4,A4)
      CALL DPWRST('XXX','BUG ')
 9120 CONTINUE
      WRITE(ICOUT,9024)ICASUP,IFOUND,IERROR
 9024 FORMAT('ICASUP,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)XMIN,XMAX
 9025 FORMAT('XMIN,XMAX = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPOPT2(MODEL,NUMCHA,PARAM,IPARN,IPARN2,NUMPV,
     1ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IVARN,IVARN2,NUMVAR,XMIN,XMAX,FMIN,
     1OPTACC,
     1ISUBRO,IBUGA3,IBUGCO,IBUGEV,IERROR)
C
C     PURPOSE--COMPUTE THE MINIMUM OF A FUNCTION
C              BETWEEN THE LIMITS XMIN AND XMAX.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     NOTE--THIS ROUTINE USES THE FMIN ALGORITHM FOR THE BOOK
C           "NUMERICAL METHODS AND SOFTWARE" BY KAHANER, MOLER, NASH.
C           THE CODE IS "ILINED" INTO THIS ROUTINE RATHER THAN BEING
C           CALLED AS A SEPARATE FUNCTION.  THE FOLLOWING IS THE
C           PROLOGUE OF THE FMIN ROUTINE, WHICH DOCUMENTS THE METHOD.
C
C***BEGIN PROLOGUE  FMIN
C***DATE WRITTEN   730101  (YYMMDD)
C***REVISION DATE  730101  (YYMMDD) 
C***CATEGORY NO.  G1A2
C***KEYWORDS  ONE-DIMENSIONAL MINIMIZATION, UNIMODAL FUNCTION
C***AUTHOR  BRENT, R.
C***PURPOSE  An approximation to the point where F attains a minimum on
C            the interval (AX,BX) is determined as the value of the 
C            function FMIN.
C***DESCRIPTION
C
C     From the book, "Numerical Methods and Software" by
C                D. Kahaner, C. Moler, S. Nash
C                Prentice Hall, 1988
C
C     The method used is a combination of golden section search and
C     successive parabolic interpolation.  Convergence is never much 
C     slower than that for a Fibonacci search.  If F has a continuous 
C     second derivative which is positive at the minimum (which is not
C     at AX or BX), then convergence is superlinear, and usually of the 
C     order of about 1.324....
C
C     The function F is never evaluated at two points closer together
C     than EPS*ABS(FMIN) + (TOL/3), where EPS is approximately the 
C     square root of the relative machine precision.  If F is a unimodal
C     function and the computed values of F are always unimodal when
C     separated by at least EPS*ABS(XSTAR) + (TOL/3), then FMIN 
C     approximates the abcissa of the global minimum of F on the 
C     interval AX,BX with an error less than 3*EPS*ABS(FMIN) + TOL.  
C     If F is not unimodal, then FMIN may approximate a local, but 
C     perhaps non-global, minimum to the same accuracy.
C
C     This function subprogram is a slightly modified version of the
C     ALGOL 60 procedure LOCALMIN given in Richard Brent, Algorithms for
C     Minimization Without Derivatives, Prentice-Hall, Inc. (1973).
C
C INPUT PARAMETERS
C
C  AX    (real)  left endpoint of initial interval
C  BX    (real) right endpoint of initial interval
C  F     Real function of the form REAL FUNCTION F(X) which evaluates 
C          F(X)  for any  X in the interval  (AX,BX)
C        Must be declared EXTERNAL in calling routine.
C  TOL   (real) desired length of the interval of uncertainty of the 
C        final result ( .ge. 0.0)
C
C
C OUTPUT PARAMETERS
C
C FMIN   abcissa approximating the minimizer of F
C AX     lower bound for minimizer
C BX     upper bound for minimizer
C
C***REFERENCES  RICHARD BRENT, ALGORITHMS FOR MINIMIZATION WITHOUT 
C                 DERIVATIVES, PRENTICE-HALL, INC. (1973).
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  FMIN
      REAL  TOL
      REAL  A,B,C,D,E,EPS,XM,P,Q,R,TOL1,TOL2,U,V,W
      REAL  FU,FV,FW,FX,X
      REAL  ABS,SQRT,SIGN
C
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--94/6
C     ORIGINAL VERSION--JUNE      1994.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 MODEL
      CHARACTER*4 IPARN
      CHARACTER*4 IPARN2
      CHARACTER*4 IANGLU
      CHARACTER*4 ITYPEH
      CHARACTER*4 IW21HO
      CHARACTER*4 IW22HO
      CHARACTER*4 IVARN
      CHARACTER*4 IVARN2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IERROR
C
      CHARACTER*4 ILAB
      CHARACTER*4 IH
      CHARACTER*4 IH2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
CCCCC OCTOBER 1994.  ADD FOLLOWING LINE
      CHARACTER*4 ISUBRO
C
C---------------------------------------------------------------------
C
      DIMENSION MODEL(*)
      DIMENSION PARAM(*)
      DIMENSION IPARN(*)
      DIMENSION IPARN2(*)
      DIMENSION IVARN(*)
      DIMENSION IVARN2(*)
C
      DIMENSION ITYPEH(*)
      DIMENSION IW21HO(*)
      DIMENSION IW22HO(*)
      DIMENSION W2HOLD(*)
C
      DIMENSION ILOCV(10)
      DIMENSION ILAB(10)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPOP'
      ISUBN2='T2  '
C
      IERROR='NO'
      IPASS=2
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'OPT2')GOTO99
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('AT THE BEGINNING OF DPOPT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3,IBUGCO,IBUGEV
   52 FORMAT('IBUGA3,IBUGCO,IBUGEV = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMCHA,NUMPV,NUMVAR
   53 FORMAT('NUMCHA,NUMPV,NUMVAR = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)(MODEL(J),J=1,NUMCHA)
   54 FORMAT('MODEL(I) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMPV
      WRITE(ICOUT,56)I,PARAM(I),IPARN(I),IPARN2(I)
   56 FORMAT('I,PARAM(I),IPARN(I),IPARN2(I) = ',I8,E15.7,A4,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      DO59I=1,NUMVAR
      WRITE(ICOUT,61)I,IVARN(I),IVARN2(I)
   61 FORMAT('I, IVARN(I),IVARN2(I) = ',I8,2X,A4,A4)
      CALL DPWRST('XXX','BUG ')
   59 CONTINUE
      WRITE(ICOUT,62)XMIN,XMAX
   62 FORMAT('XMIN, XMAX = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
   99 CONTINUE
C
C               ***************************************************
C               **  STEP 1--                                     **
C               **  DETERMINE THE LOCATIONS (IN THE LIST IPARN)  **
C               **  OF THE VARIABLES OF THE FUNCTION.            **
C               ***************************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'OPT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO100I=1,NUMVAR
      IH=IVARN(I)
      IH2=IVARN2(I)
      DO200J=1,NUMPV
      J2=J
      IF(IPARN(J).EQ.IH.AND.IPARN2(J).EQ.IH2)GOTO210
  200 CONTINUE
  210 CONTINUE
      ILOCV(I)=J2
  100 CONTINUE
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  WRITE OUT PRELIMINARY SUMMARY INFORMATION  **
C               *************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'OPT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO409
      IF(IFEEDB.EQ.'OFF')GOTO409
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,401)
  401 FORMAT('MINIMUM OF A FUNCTION')
      CALL DPWRST('XXX','BUG ')
      ILAB(1)='    '
      ILAB(2)='  FU'
      ILAB(3)='NCTI'
      ILAB(4)='ON--'
      NUMWDL=4
      CALL DPPRIF(ILAB,NUMWDL,MODEL,NUMCHA,IBUGA3)
C
      WRITE(ICOUT,402)IVARN(1),IVARN2(1)
  402 FORMAT('      OPTIMIZATION VARIABLE             = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,403)XMIN
  403 FORMAT('      SPECIFIED LOWER LIMIT OF INTERVAL = ',F20.10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,404)XMAX
  404 FORMAT('      SPECIFIED UPPER LIMIT OF INTERVAL = ',F20.10)
      CALL DPWRST('XXX','BUG ')
  409 CONTINUE
C
C               ***************************
C               **  STEP 3--             **
C               **  FMIN CODE TO FIND    **
C               **  THE MINIMUM          **
C               ***************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'OPT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(OPTACC.GT.0.0)THEN
        TOL = OPTACC
      ELSE
        TOL = 1.0E-5
      ENDIF
      C = 0.5*(3. - SQRT(5.0))
C
C  C is the squared inverse of the golden ratio
C
C  EPS is approximately the square root of the relative machine
C  precision.
C
      EPS = 1.0
   10 EPS = EPS/2.0
      TOL1 = 1.0 + EPS
      IF (TOL1 .GT. 1.0) GO TO 10
      EPS = SQRT(EPS)
C
C  initialization
C
CCCCC A = AX
CCCCC B = BX
      A = AMIN1(XMIN,XMAX)
      B = AMAX1(XMIN,XMAX)
      V = A + C*(B - A)
      W = V
      X = V
      E = 0.0
CCCCC FX = F(X)
C
      DO9100K=1,NUMVAR
      JLOC=ILOCV(K)
      PARAM(JLOC)=X
 9100 CONTINUE
C
      CALL COMPIM(MODEL,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,FX,
     1IBUGCO,IBUGEV,IERROR)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'OPT2')WRITE(ICOUT,9103)X,FX
 9103 FORMAT('X,FX = ',2E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'OPT2')CALL DPWRST('XXX','BUG ')
C
      FV = FX
      FW = FX
C
C  main loop starts here
C
   20 XM = 0.5*(A + B)
      TOL1 = EPS*ABS(X) + TOL/3.0
      TOL2 = 2.0*TOL1
C
C  check stopping criterion
C
      IF (ABS(X - XM) .LE. (TOL2 - 0.5*(B - A))) GO TO 90
C
C is golden-section necessary
C
      IF (ABS(E) .LE. TOL1) GO TO 40
C
C  fit parabola
C
      R = (X - W)*(FX - FV)
      Q = (X - V)*(FX - FW)
      P = (X - V)*Q - (X - W)*R
      Q = 2.0*(Q - R)
      IF (Q .GT. 0.0) P = -P
      Q = ABS(Q)
      R = E
      E = D
C
C  is parabola acceptable
C
   30 IF (ABS(P) .GE. ABS(0.5*Q*R)) GO TO 40
      IF (P .LE. Q*(A - X)) GO TO 40
      IF (P .GE. Q*(B - X)) GO TO 40
C
C  a parabolic interpolation step
C
      D = P/Q
      U = X + D
C
C  F must not be evaluated too close to AX or BX
C
      IF ((U - A) .LT. TOL2) D = SIGN(TOL1, XM - X)
      IF ((B - U) .LT. TOL2) D = SIGN(TOL1, XM - X)
      GO TO 50
C
C  a golden-section step
C
   40 IF (X .GE. XM) E = A - X
      IF (X .LT. XM) E = B - X
      D = C*E
C
C  F must not be evaluated too close to X
C
   50 IF (ABS(D) .GE. TOL1) U = X + D
      IF (ABS(D) .LT. TOL1) U = X + SIGN(TOL1, D)
CCCCC FU = F(U)
C
      DO9200K=1,NUMVAR
      JLOC=ILOCV(K)
      PARAM(JLOC)=U
 9200 CONTINUE
C
      CALL COMPIM(MODEL,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,FU,
     1IBUGCO,IBUGEV,IERROR)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'OPT2')WRITE(ICOUT,9203)U,FU
 9203 FORMAT('U,FU = ',2E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'OPT2')CALL DPWRST('XXX','BUG ')
C
C
C  update  A, B, V, W, and X
C
      IF (FU .GT. FX) GO TO 60
      IF (U .GE. X) A = X
      IF (U .LT. X) B = X
      V = W
      FV = FW
      W = X
      FW = FX
      X = U
      FX = FU
      GO TO 20
   60 IF (U .LT. X) A = U
      IF (U .GE. X) B = U
      IF (FU .LE. FW) GO TO 70
      IF (W .EQ. X) GO TO 70
      IF (FU .LE. FV) GO TO 80
      IF (V .EQ. X) GO TO 80
      IF (V .EQ. W) GO TO 80
      GO TO 20
   70 V = W
      FV = FW
      W = U
      FW = FU
      GO TO 20
   80 V = U
      FV = FU
      GO TO 20
C
C  end of main loop
C
   90 CONTINUE
      FMIN = X
C
C               ***************************
C               **  STEP 5--             **
C               **  WRITE OUT THE MINIMUM**
C               ***************************
C
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'OPT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO1490
      IF(IFEEDB.EQ.'OFF')GOTO1490
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1405)FMIN
 1405 FORMAT('      THE MINIMUM VALUE OCCURS AT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 1490 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'OPT2')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END      OF DPOPT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IERROR
 9021 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPOPT3(
     1TYPSIZ,XSTART,XPLS,GPLS,A,WORK,
     1NUMDV,
     1OPTACC,IOPTME,IOPTHE,
     1ITNLIM,ADLT,AGRDTL,ASTPMX,ASTPTL,AFSCLE,MSG,
     1AFPLS,
     1ISUBRO,IBUGA3,IBUGCO,IBUGEV,IERROR)
C
C     PURPOSE--COMPUTE THE MINIMUM OF A FUNCTION
C              BETWEEN THE LIMITS XMIN AND XMAX.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     NOTE--THIS ROUTINE USES THE UNCMIN PACKAGE DESCIRBED IN THE 
C           ARTICLE "A MODULAR SYSTEM OF ALGORITHMS FOR UNCONSTRAINED
C           MINIMIZATION" BY SCHNABEL, KOONTZ, AND WEISS.  THIS CODE
C           IS DESIGNED IN A MODULAR FASHION TO SUPPORT A LARGE 
C           NUMBER OF POTENTIAL OPTIMIZATION METHODS.  IN PARTICULAR,
C           THE 3 MAIN CHOICES ARE:
C             1) STEP SELECTION - LINE, DOGLEG, HOOK STEP
C             2) GRADIENTS      - NUMERIC OR ANALYTIC
C             3) HESSIAN        - ANALYTIC, BFGS UPDATE, OR FINITE
C                                 DIFFERENCES
C           THESE MAY BE COMBINED FOR A TOTAL OF 18 ALGORITHMS
C           (ACTUALLY 15 SINCE ANALYTIC HESSIANS WITH A NUMERICAL
C           FIRST DERIVATIVE IS NOT REALISTIC).  AT THIS TIME, 
C           DATAPLOT DOES NOT SUPPORT ANALYTIC GRADIENTS OR HESSIANS.
C           IN ADDITION, THE FUNCTION TO BE OPTIMIZED MUST BE 
C           WRITTEN IN DATAPLOT'S FUNCTIONAL FORM.  THAT IS, THERE
C           IS CURRENTLY NO PROVISION FOR A USER WRITTEN FUNCTION.
C
C     NOTE--THIS FUNCTION DOES MINIMIZATION.  TO MAXIMIZE, FIND THE
C           MINIMUM OF THE NEGATIVE OF THE FUNCTION.
C
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--94/6
C     ORIGINAL VERSION--JUNE      1994.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBRO
C
CCCCC MAY 1995.  ADD FOLLOWING LINES
      CHARACTER*4 IOPTME
      CHARACTER*4 IOPTHE
C
C---------------------------------------------------------------------
C
      PARAMETER (MAXOPT=100)
C
      DOUBLE PRECISION TYPSIZ(MAXOPT)
      DOUBLE PRECISION XSTART(MAXOPT)
      DOUBLE PRECISION XPLS(MAXOPT)
      DOUBLE PRECISION GPLS(MAXOPT)
      DOUBLE PRECISION A(MAXOPT,MAXOPT)
      DOUBLE PRECISION WORK(MAXOPT,8)
      DOUBLE PRECISION DLT
      DOUBLE PRECISION GRADTL
      DOUBLE PRECISION STEPMX
      DOUBLE PRECISION STEPTL
      DOUBLE PRECISION FPLS
      DOUBLE PRECISION EPSM
      DOUBLE PRECISION FSCALE
C
      INCLUDE 'DPCOMC.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='DPOP'
      ISUBN2='T3  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'OPT3')GOTO99
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('AT THE BEGINNING OF DPOPT3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3,IBUGCO,IBUGEV
   52 FORMAT('IBUGA3,IBUGCO,IBUGEV = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   99 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  DEFINE DEFAULT VALUES**
C               ***************************
C
C PARAMETERS
C ----------
C N            --> DIMENSION OF PROBLEM
C XSTART(N)    --> INITIAL GUESS TO SOLUTION (TO COMPUTE MAX STEP SIZE)
C TYPSIZ(N)   <--  TYPICAL SIZE FOR EACH COMPONENT OF X
C FSCALE      <--  ESTIMATE OF SCALE OF MINIMIZATION FUNCTION
C METHOD      <--  ALGORITHM TO USE TO SOLVE MINIMIZATION PROBLEM
C IEXP        <--  =0 IF MINIMIZATION FUNCTION NOT EXPENSIVE TO EVALUATE
C MSG         <--  MESSAGE TO INHIBIT CERTAIN AUTOMATIC CHECKS + OUTPUT
C NDIGIT      <--  NUMBER OF GOOD DIGITS IN MINIMIZATION FUNCTION
C ITNLIM      <--  MAXIMUM NUMBER OF ALLOWABLE ITERATIONS
C IAGFLG      <--  =0 IF ANALYTIC GRADIENT NOT SUPPLIED
C IAHFLG      <--  =0 IF ANALYTIC HESSIAN NOT SUPPLIED
C IPR         <--  DEVICE TO WHICH TO SEND OUTPUT
C DLT         <--  TRUST REGION RADIUS
C GRADTL      <--  TOLERANCE AT WHICH GRADIENT CONSIDERED CLOSE ENOUGH
C                  TO ZERO TO TERMINATE ALGORITHM
C STEPMX      <--  VALUE OF ZERO TO TRIP DEFAULT MAXIMUM IN OPTCHK
C STEPTL      <--  TOLERANCE AT WHICH SUCCESSIVE ITERATES CONSIDERED
C                  CLOSE ENOUGH TO TERMINATE ALGORITHM
C
C SET TYPICAL SIZE OF X AND MINIMIZATION FUNCTION
CCCCC APRIL 1996.  CHANGE FOLLOWiNG LINE
CCCCC DO 10 I=1,N
      DO 10 I=1,MAXOPT
        TYPSIZ(I)=1.0D0
   10 CONTINUE
      IF(AFSCLE.NE.0.0)THEN
        FSCALE=DBLE(AFSCLE)
      ELSE
        FSCALE=1.0D0
      ENDIF
C
C SET TOLERANCES
C
      IF(ADLT.NE.0.0)THEN
        DLT=DBLE(ADLT)
      ELSE
        DLT=-1.0D0
      ENDIF
      IF(AGRDTL.NE.0.0)THEN
        GRADTL=DBLE(AGRDTL)
      ELSE
        EPSM=DBLE(R1MACH(4))
CCCCC   EPSM=D1MACH(4)
        GRADTL=EPSM**(1.0D0/3.0D0)
      ENDIF
      IF(ASTPMX.NE.0.0)THEN
        STEPMX=DBLE(ASTPMX)
      ELSE
        STEPMX=0.0D0
      ENDIF
      IF(ASTPTL.NE.0.0)THEN
        STEPTL=DBLE(ASTPTL)
      ELSE
        STEPTL=DSQRT(EPSM)
      ENDIF
C
C SET FLAGS
      METHOD=1
      IF(IOPTME.EQ.'DOGL')METHOD=2
      IF(IOPTME.EQ.'HOOK')METHOD=3
      IEXP=0
      IF(IOPTHE.EQ.'FINI')IEXP=0
      IF(IOPTHE.EQ.'BFGS')IEXP=1
CCCCC DATAPLOT NOTE.  THE UNCMIN ROUTINE IS DOUBLE PRECISION.
CCCCC HOWEVER, DATAPLOT'S FUNCTION EVALUATION IS ONLY SINGLE
CCCCC PRECISION.  USE THE DEFAULT METHOD FROM OPTCHK, BUT USE
CCCCC SINGLE PRECISION VALUE RATHER THAN DOUBLE PRECISION.
CCCCC NDIGIT=-1
CCCCC NDIGIT=-LOG10(R1MACH(4))
CCCCC NDIGIT=-LOG10(D1MACH(4))
      NDIGIT=-99
C
      ITNLIM=150
      IAGFLG=0
      IAHFLG=0
      IPR2=IPR
C
      CALL OPTIF9(
CCCCC1MAXOPT,NUMDV,XSTART,OPTFCN,TYPSIZ,FSCALE,
     1MAXOPT,NUMDV,XSTART,TYPSIZ,FSCALE,
     1METHOD,IEXP,MSG,NDIGIT,ITNLIM,IAGFLG,IAHFLG,IPR2,
     1DLT,GRADTL,STEPMX,STEPTL,
     1XPLS,FPLS,GPLS,ITRMCD,A,WORK)
      AFPLS=SNGL(FPLS)
      IF(ITRMCD.EQ.4)THEN
        IERROR='YES'
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,1001)ITNLIM
 1001   FORMAT('**** ERROR FROM OPTIMIZATION ROUTINE.  MAXIMUM ',
     *  'NUMBER OF ITERATIONS (',I5,') EXCEEDED.')
        CALL DPWRST('XXX','BUG')
      ELSEIF(ITRMCD.EQ.0)THEN
        IERROR='YES'
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,1011)
 1011   FORMAT('**** ERROR FROM OPTIMIZATION ROUTINE.  ERRONEOUS ',
     *  'INPUT DATA DETECTED BY OPTIF9 ROUTINE.')
        CALL DPWRST('XXX','BUG')
      ELSEIF(ITRMCD.EQ.5)THEN
        IERROR='YES'
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,1021)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,1022)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,1023)
        CALL DPWRST('XXX','BUG')
 1021   FORMAT(
     &'**** ERROR FROM OPTIMIZATION ROUTINE.  MAXIMUM STEP SIZE (',
     &E15.7,') EXCEEDED ')
 1022   FORMAT(
     &'     5 CONSECUTIVE TIMES.  EITHER THE FUNCTION IS UNBOUNDED ',
     &'FROM BELOW, BECOMES ASYMPTOTIC')
 1023   FORMAT(
     &'     TO A FINIT LIMIT FROM ABOVE, OR THE MAXIMIM STEP SIZE IS ',
     &'TOO SMALL (LET OPTSTMX = <VALUE> TO CHANGE).')
      ELSEIF(ITRMCD.EQ.1)THEN
        IERROR='NO'
        IF(IPRINT.EQ.'OFF')GOTO1039
        IF(IFEEDB.EQ.'OFF')GOTO1039
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,1031)
 1031   FORMAT('**** RELATIVE GRADIENT IS CLOSE TO ZERO.  THE ',
     *  'CURRENT ITERATE IS PROBABLY A SOLUTION.')
        CALL DPWRST('XXX','BUG')
 1039   CONTINUE
      ELSEIF(ITRMCD.EQ.2)THEN
        IERROR='NO'
        IF(IPRINT.EQ.'OFF')GOTO1049
        IF(IFEEDB.EQ.'OFF')GOTO1049
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,1041)
 1041   FORMAT('**** SUCCESSIVE ITERATES WITHIN TOLERANCE.  THE ',
     *  'CURRENT ITERATE IS PROBABLY A SOLUTION.')
        CALL DPWRST('XXX','BUG')
 1049   CONTINUE
      ELSEIF(ITRMCD.EQ.3)THEN
        IERROR='NO'
        IF(IPRINT.EQ.'OFF')GOTO1059
        IF(IFEEDB.EQ.'OFF')GOTO1059
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,1051)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,1052)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,1053)STEPTL
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,1054)
        CALL DPWRST('XXX','BUG')
 1059   CONTINUE
 1051   FORMAT('**** LAST GLOBAL STEP FAILED TO LOCATE A POINT LOWER',
     *  ' THAN CURRENT ITERATE.  EITHER IT IS A ')
 1052   FORMAT('     APPROXIMATE LOCAL MINIMUM OF THE FUNCTION, THE ',
     *  ' FUNCTION IS TOO NON-LINEAR FOR')
 1053   FORMAT('     THIS ALGORITHM, OR THE STEP TOLERANCE (',E15.7,
     *  ') IS TOO LARGE (CAN ')
 1054   FORMAT('     CHANGE WITH: LET OPTSTPTL = <VALUE>')
      ENDIF
C
C               ***************************
C               **  STEP 5--             **
C               **  WRITE OUT THE MINIMUM**
C               ***************************
C
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'OPT3')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO1490
      IF(IFEEDB.EQ.'OFF')GOTO1490
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1401KK=1,NUMDV
      WRITE(ICOUT,1405)KK,XPLS(KK)
 1405 FORMAT('      THE MINIMUM VALUE OCCURS AT = ',I5,1X,E15.7)
      CALL DPWRST('XXX','BUG ')
 1401 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 1490 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'OPT3')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END      OF DPOPT3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IERROR
 9021 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPOR(IHARG,IARGT,ARG,NUMARG,
     1PXSTAR,PYSTAR,
     1PXEND,PYEND,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG,
     1IGRASW,IDIASW,
     1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
CCCCC ADD FOLLOWING LINE JULY 1997.
     1UNITSW,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DRAW ONE OR MORE LOGICAL ORS
C              (DEPENDING ON HOW MANY NUMBERS ARE PROVIDED).
C              THE COORDINATES ARE IN STANDARDIZED UNITS
C              OF 0 TO 100.
C     NOTE--THE INPUT COORDINATES DEFINE THE BACK CENTER AND THE FRONT CENTER
C           OF THE LOGICAL OR.
C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 2
C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*2 = 4.
C     NOTE--IF 2 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN LOGICAL OR WILL GO
C           FROM THE LAST CURSOR POSITION
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE 2 NUMBERS.
C     NOTE--IF 4 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN LOGICAL OR WILL GO
C           FROM THE ABSOLUTE (X,Y) POSITION
C           AS DEFINED BY THE FIRST 2 NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS.
C     NOTE--IF 6 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN LOGICAL OR WILL GO
C           FROM THE (X,Y) POSITION
C           AS RESULTING FROM THE THIRD AND FOURTH NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIFTH AND SIXTH NUMBERS.
C     NOTE--AND SO FORTH FOR 8, 10, 12, ... NUMBERS.
C     INPUT  ARGUMENTS--IHARG
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PXSTAR
C                     --PYSTAR
C     OUTPUT ARGUMENTS--PXEND
C                     --PYEND
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --NOVEMBER  1982.
C     UPDATED         --JANUARY   1989.  CALL LIST FOR OFFSET VAR (ALAN)
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C     UPDATED         --JULY      1997.  SUPPORT FOR "DATA" UNITS (ALAN)
C
C-----NON-COMMON VARIABLES-----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
CCCCC ADD FOLLOWING LINE JULY 1997.
      CHARACTER*4 UNITSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IFIG
      CHARACTER*4 IBELSW
      CHARACTER*4 IERASW
      CHARACTER*4 IBACCO
      CHARACTER*4 ICOPSW
      CHARACTER*4 ITYPEO
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
      IERRG4=IERROR
CCCCC IBUGG4=IBUGD2
CCCCC ISUBG4=ISUBRO
C
      ILOCFN=0
      NUMNUM=0
C
      X1=0.0
      Y1=0.0
      X2=0.0
      Y2=0.0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'OR')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMARG
   53 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I),IARGT(I),ARG(I)
   56 FORMAT('I,IHARG(I),IARGT(I),ARG(I) = ',I8,2X,A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,57)PXSTAR,PYSTAR
   57 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)PXEND,PYEND
   58 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)IGRASW,IDIASW
   76 FORMAT('IGRASW,IDIASW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)PGRAXF,PGRAYF,PDIAXC,PDIAYC
   77 FORMAT('PGRAXF,PGRAYF,PDIAXC,PDIAYC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,78)PDIAHE,PDIAWI,PDIAVG,PDIAHG
   78 FORMAT('PDIAHE,PDIAWI,PDIAVG,PDIAHG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80)NUMDEV
   80 FORMAT('NUMDEV= ',I8)
      CALL DPWRST('XXX','BUG ')
      DO81I=1,NUMDEV
      WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
   82 FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I)
   83 FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I)
   84 FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
      WRITE(ICOUT,87)IFOUND
   87 FORMAT('IFOUND= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4
   88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGD2,IERROR
   89 FORMAT('IBUGD2,IERROR= ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFIG='OR'
      NUMPT=2
      NUMPT2=2*NUMPT
C
C               ********************************
C               **  STEP 0--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
C  AUGUST 1988.  ADD OFFSET VARIABLE
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               ************************************
C               **  STEP 1--                      **
C               **  CARRY OUT OPENING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      CALL DPOPDE
C
      IBELSW='OFF'
      NUMRIN=0
      IERASW='OFF'
      IBACCO='JUNK'
C
      CALL DPOPPL(IGRASW,
     1IBELSW,NUMRIN,IERASW,
     1IBACCO)
C
C               *****************************************
C               **  STEP 2--                           **
C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
C               *****************************************
C
      IF(NUMARG.GE.2.AND.
     1IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1111
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ABSO'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1112
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'RELA'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1113
      GOTO1130
C
 1111 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=1
      GOTO1119
C
 1112 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=2
      GOTO1119
C
 1113 CONTINUE
      ITYPEO='RELA'
      ILOCFN=2
      GOTO1119
 1119 CONTINUE
C
      IF(ILOCFN.GT.NUMARG)GOTO1129
      DO1120I=ILOCFN,NUMARG
      IF(IARGT(I).EQ.'NUMB')GOTO1120
      GOTO1129
 1120 CONTINUE
      IFOUND='YES'
      GOTO1149
 1129 CONTINUE
      GOTO1130
C
 1130 CONTINUE
      IERRG4='YES'
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ILLEGAL FORM FOR DRAW ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1134)
 1134 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('      SUPPOSE IT IS DESIRED TO DRAW A LOGICAL OR ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      WITH THE MIDDLE OF THE FLATTER SIDE  ',
     1'AT THE POINT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      AND WITH THE POINTED END AT THE POINT 40 60')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      LOGICAL OR 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      LOGICAL OR ABSOLUTE 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1149 CONTINUE
C
C               ****************************
C               **  STEP 3--              **
C               **  DRAW OUT THE LINE(S)  **
C               ****************************
C
      NUMNUM=NUMARG-ILOCFN+1
      IF(NUMNUM.LT.NUMPT2)GOTO1151
      GOTO1152
C
 1151 CONTINUE
      J=ILOCFN-1
      X1=PXSTAR
      Y1=PYSTAR
      GOTO1159
C
 1152 CONTINUE
      J=ILOCFN
      IF(J.GT.NUMARG)GOTO1190
      X1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR)
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR)
      GOTO1159
 1159 CONTINUE
C
 1160 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X2=X1+X2
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
C
 1170 CONTINUE
      CALL DPOR2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      X1=X2
      Y1=Y2
C
      GOTO1160
 1190 CONTINUE
C
      PXEND=X2
      PYEND=Y2
C
C               ************************************
C               **  STEP 4--                      **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSW='OFF'
      NUMCOP=0
      CALL DPCLPL(ICOPSW,NUMCOP,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
 8000 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'OR')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOCFN,NUMNUM
 9012 FORMAT('ILOCFN,NUMNUM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X1,Y1,X2,Y2
 9013 FORMAT('X1,Y1,X2,Y2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PXSTAR,PYSTAR
 9015 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PXEND,PYEND
 9016 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IFIG
 9017 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)IFOUND
 9027 FORMAT('IFOUND = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGG4,ISUBG4,IERRG4
 9028 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGD2,IERROR
 9029 FORMAT('IBUGD2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPOR2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW A LOGICAL OR (= AN OR BOX)
C              WITH THE MIDDLE OF THE FLATTER SIDE
C              AT THE POINT (X1,Y1),
C              AND WITH THE MIDDLE OF THE POINTED SIDE
C              AT THE POINT (X2,Y2).
C     NOTE--THE HEIGHT OF THE BOX WILL BE EQUAL TO
C           THE ABOVE-DESCRIBED WIDTH OF THE BOX
C           (THAT IS, THE HEIGHT
C           OF THE BOX WILL BE EQUAL TO
C           THE WIDTH FROM (X1,Y1) TO (X2,Y2).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT2
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IPATT
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(1000)
      DIMENSION PY(1000)
CCCCC FEBRUARY 1994.  ADD FOLLOWING SECTION
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR11),PX(1))
      EQUIVALENCE (G2RBAG(IGAR12),PY(1))
CCCCC END CHANGE
CCCCC DIMENSION PX3(1000)
CCCCC DIMENSION PY3(1000)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'OR2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPOR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y2
   54 FORMAT('X2,Y2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IFIG
   59 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE THE COORDINATES  **
C               **  FOR THE LOGICAL OR        **
C               *********************************
C
      POWER=1.4
      FACTOR=0.2
C
      DELX=X2-X1
      DELY=Y2-Y1
      ALEN=0.0
      TERM=(X2-X1)**2+(Y2-Y1)**2
      IF(TERM.GT.0.0)ALEN=SQRT(TERM)
      R=ALEN/2.0
      IF(ABS(DELX).GE.0.00001)THETA=ATAN(DELY/DELX)
      IF(ABS(DELX).LT.0.00001.AND.DELY.GE.0.0)THETA=3.1415926/2.0
      IF(ABS(DELX).LT.0.00001.AND.DELY.LT.0.0)THETA=-3.1415926/2.0
C
      K=0
C
      X=R
      Y=-R
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      DO5210I=271,451,5
      PHI2=I-1
      PHI2=PHI2*(2.0*3.1415926)/360.0
      ABSCOS=ABS(COS(PHI2))
      ABSSIN=ABS(SIN(PHI2))
      X=R*(ABSCOS**POWER)
      Y=R*(ABSSIN**POWER)
      IF(SIN(PHI2).LT.0.0)Y=-Y
      X=X+R
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
 5210 CONTINUE
C
      X=0
      X=X-FACTOR*R
      Y=R
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      DO5220I=271,451,5
      PHI2=I-1
      PHI2=360.0-PHI2
      PHI2=PHI2*(2.0*3.1415926)/360.0
      X=FACTOR*R*COS(PHI2)
      X=X-FACTOR*R
      Y=R*SIN(PHI2)
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
 5220 CONTINUE
C
      X=R
      Y=-R
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      NP=K
C
C               ***********************
C               **  STEP 2--         **
C               **  FILL THE FIGURE  **
C               **  (IF CALLED FOR)  **
C               ***********************
C
      IF(IREFSW(1).EQ.'OFF')GOTO2190
      IPATT=IREPTY(1)
      IPATT2='SOLI'
      PTHICK=PREPTH(1)
      PXGAP=PREPSP(1)
      PYGAP=PREPSP(1)
      ICOLF=IREFCO(1)
      ICOLP=IREPCO(1)
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
 2190 CONTINUE
C
C               *********************************
C               **  STEP 3--                   **
C               **  DRAW OUT THE FIGURE  OR   **
C               *********************************
C
      IPATT=ILINPA(1)
      PTHICK=PLINTH(1)
      ICOL=ILINCO(1)
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'OR2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPOR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NP
 9014 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)I,PX(I),PY(I)
 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPORCO(IHARG,IARGT,ARG,NUMARG,
     1AORIXC,AORIYC,AORIZC,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE (X,Y,Z) ORIGIN COORDINATES CONTAINED IN THE
C              3 VARAIBLES AORIXC,AORIYC,AORIZC
C              SUCH ORIGIN COORDINATES ARE USED IN 3-DIMENSIONAL PLOTS.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--AORIXC  = X-COORDINATE OF ORIGIN
C                     --AORIYC  = Y-COORDINATE OF ORIGIN
C                     --AORIZC  = Z-COORDINATE OF ORIGIN
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1978.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1199
      IF(IHARG(1).NE.'COOR')GOTO1199
      IF(NUMARG.EQ.1)GOTO1150
      IF(IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB'.AND.
     1IARGT(4).EQ.'NUMB')GOTO1160
      GOTO1110
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
C
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPEYCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR ORIGIN COORDINATES ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('      SUPPOSE IT IS DESIRED TO POSITION ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      THE AXES ORIGIN FOR A 3 DIMENSIONAL PLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      AT (IN UNITS OF THE PLOTTED DATA)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      (X=500, Y=25000, Z=.03)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1129)
 1129 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      ORIGIN COORDINATES 500 2500 .03')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      AORIXC=CPUMIN
      AORIYC=CPUMIN
      AORIZC=CPUMIN
      GOTO1180
C
 1160 CONTINUE
      AORIXC=ARG(2)
      AORIYC=ARG(3)
      AORIZC=ARG(4)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1185)
 1185 FORMAT('THE (X,Y,Z) ORIGIN COORDINATES HAVE JUST BEEN SET TO')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)AORIXC
 1186 FORMAT('            --X = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1187)AORIYC
 1187 FORMAT('            --Y = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1188)AORIZC
 1188 FORMAT('            --Z = ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPORDE(IHARG,IHARG2,NUMARG,
     1IODRD1,IODRD2,IODRD3,IODRD4,IWEIN1,IWEIN2,
     1ICASOD,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE USER VARIABLE NAMES THAT DEFINE THE
C              DELTAS FOR ORTHOGONAL DISTANCE FITS.  NOTE THAT THERE
C              ARE THREE SETS OF VARIABLES FOR THE DELTAS:
C              1) YOU CAN DEFINE FROM 1 TO 20 VARIABLE NAMES
C                 THAT SPECIFY THE WEIGHTS FOR THE DELTAS.
C              2) YOU CAN DEFINE FROM 1 TO 20 VARIABLE NAMES
C                 THAT SPECIFY STARTING VALUES FOR THE DELTAS.
C                 NOTE THAT FOR MANY PROBLEMS, IT IS NOT NECESSARY
C                 TO SPECIFY STARTING VALUES.
C              IF IODRD1(1) = 'OFF', ALL DELTA WEIGHTS ARE
C              SET TO ZERO.  ONE VARIABLE CAN BE DEFINED TO SET
C              A UNIQUE DELTA WEIGHT FOR EACH COLUMN OR A SEPARATE
C              WEIGHT DELTA WEIGHT VARIABLE CAN BE DEFINED FOR EACH
C              COLUMN.  MULTIPLE VARIABLE NAMES IMPLIES EACH ELEMENT
C              OF THE DESIGN MATRIX HAS ITS OWN DELTA WEIGHT
C              VARIABLE DEFINED.  STARTING VALUES FOR THE DELTAS
C              THEMSELVES CAN ONLY BE SPECIFIED AS VARIABLE
C              NAMES (I.E., ONE VARIABLE FOR EACH COLUMN OF THE
C              DESIGN MATRIX).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IHARG2 (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--IODRD1 (A  HOLLERITH VARIABLE)
C                     --IODRD2 (A  HOLLERITH VARIABLE)
C                     --IODRD3 (A  HOLLERITH VARIABLE)
C                     --IODRD4 (A  HOLLERITH VARIABLE)
C                     --IWEIN1 (A  HOLLERITH VARIABLE)
C                     --IWEIN2 (A  HOLLERITH VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2001/4
C     ORIGINAL VERSION--APRIL     2001.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      PARAMETER (MAXDEL=20)
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IODRD1(MAXDEL)
      CHARACTER*4 IODRD2(MAXDEL)
      CHARACTER*4 IODRD3(MAXDEL)
      CHARACTER*4 IODRD4(MAXDEL)
      CHARACTER*4 IWEIN1(MAXDEL)
      CHARACTER*4 IWEIN2(MAXDEL)
      CHARACTER*4 ICASOD
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
C
C  TWO CASES:
C  1) DELTA WEIGHT VARIABLES
C  2) DELTA STARTING POINT VARIABLES
C
      IF(ICASOD.EQ.'DELT'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'WEIG')THEN
C
        DO1010I=1,MAXDEL
          IODRD1(I)='OFF'
          IODRD2(I)='   '
 1010   CONTINUE
C
        IF(IHARG(2).EQ.'OFF')GOTO1040
        IF(NUMARG.GT.1)GOTO1110
        IF(NUMARG.LE.1)GOTO1040
        GOTO1060
C
 1040   CONTINUE
        IODRD1(1)='OFF '
        IODRD2(1)='    '
        DO1045I=2,MAXDEL
          IODRD1(1)='OFF '
          IODRD2(1)='    '
 1045   CONTINUE
        GOTO1080
C
 1060   CONTINUE
        IODRD1(1)=IHARG(NUMARG)
        IODRD2(1)=IHARG2(NUMARG)
        GOTO1080
C
 1080   CONTINUE
        IFOUND='YES'
C
        IF(IFEEDB.EQ.'OFF')GOTO1089
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1081)IODRD1(1),IODRD2(2)
 1081   FORMAT('THE ORTHOGONAL DISTANCE DELTA WEIGHT VARIABLE(S) HAS ',
     1         'JUST BEEN DESIGNATED AS ', A4,A4)
        CALL DPWRST('XXX','BUG ')
 1089   CONTINUE
        GOTO1199
C
 1110   CONTINUE
        IFOUND='YES'
        IF(NUMARG.LT.2)GOTO1199
        DO1115J=2,MIN(NUMARG,MAXDEL+1)
          JM1=J-1
          IODRD1(JM1)=IHARG(J)
          IODRD2(JM1)=IHARG2(J)
C
          IF(IFEEDB.EQ.'OFF')GOTO1115
          WRITE(ICOUT,999)
  999     FORMAT(1X)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1181)JM1,IODRD1(JM1),IODRD2(JM1)
 1181     FORMAT('THE ORTHOGONAL DISTANCE DELTA WEIGHT VARIABLE ',I4,
     1           ' HAS JUST BEEN DESIGNATED AS ', A4,A4)
          CALL DPWRST('XXX','BUG ')
 1115   CONTINUE
        GOTO1199
C
 1199   CONTINUE
C
      ELSEIF(ICASOD.EQ.'DELT')THEN
C
        DO2010I=1,MAXDEL
          IODRD3(I)='OFF '
          IODRD4(I)='    '
 2010   CONTINUE
C
        IF(IHARG(1).EQ.'OFF')GOTO2040
        GOTO2110
C
 2040   CONTINUE
        DO2045I=1,MAXDEL
          IODRD3(1)='OFF '
          IODRD4(1)='    '
 2045   CONTINUE
        IFOUND='YES'
C
        IF(IFEEDB.EQ.'OFF')GOTO2089
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2081)IODRD3(1),IODRD4(2)
 2081   FORMAT('THE ORTHOGONAL DISTANCE DELTA STARTING VALUE ',
     1         'VARIABLE(S) HAS ',
     1         'JUST BEEN DESIGNATED AS ', A4,A4)
        CALL DPWRST('XXX','BUG ')
 2089   CONTINUE
        GOTO2199
C
 2110   CONTINUE
        IFOUND='YES'
        IF(NUMARG.LT.1)GOTO2199
        DO2115J=1,MIN(MAXDEL,NUMARG)
          IODRD3(J)=IHARG(J)
          IODRD4(J)=IHARG2(J)
C
          IF(IFEEDB.EQ.'OFF')GOTO2115
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2181)J,IODRD3(J),IODRD4(J)
 2181     FORMAT('THE ORTHOGONAL DISTANCE DELTA STARTING VALUES ',
     1           'VARIABLE ',I4,' HAS JUST BEEN DESIGNATED AS ', A4,A4)
          CALL DPWRST('XXX','BUG ')
 2115   CONTINUE
        GOTO2199
C
 2199   CONTINUE
      ELSEIF(ICASOD.EQ.'Y')THEN
C
        DO4010I=1,MAXDEL
          IWEIN1(I)='OFF '
          IWEIN2(I)='    '
 4010   CONTINUE
C
        IF(IHARG(2).EQ.'OFF')GOTO4040
        IF(NUMARG.GT.1)GOTO4110
        IF(NUMARG.LE.1)GOTO4040
        GOTO4060
C
 4040   CONTINUE
        IWEIN1(1)='OFF '
        IWEIN2(1)='    '
        DO4045I=2,MAXDEL
          IWEIN1(1)='OFF '
          IWEIN2(1)='    '
 4045   CONTINUE
        GOTO4080
C
 4060   CONTINUE
        IWEIN1(1)=IHARG(NUMARG)
        IWEIN2(1)=IHARG2(NUMARG)
        GOTO4080
C
 4080   CONTINUE
        IFOUND='YES'
C
        IF(IFEEDB.EQ.'OFF')GOTO4089
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4081)IWEIN1(1),IWEIN2(2)
 4081   FORMAT('THE ORTHOGONAL DISTANCE Y WIEGHTS VARIABLE(S) HAS ',
     1         'JUST BEEN DESIGNATED AS ', A4,A4)
        CALL DPWRST('XXX','BUG ')
 4089   CONTINUE
        GOTO4199
C
 4110   CONTINUE
        IFOUND='YES'
        IF(NUMARG.LT.2)GOTO4199
        DO4115J=2,MIN(NUMARG,MAXDEL+1)
          JM1=J-1
          IWEIN1(JM1)=IHARG(J)
          IWEIN2(JM1)=IHARG2(J)
C
          IF(IFEEDB.EQ.'OFF')GOTO4115
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4181)JM1,IWEIN1(JM1),IWEIN2(JM1)
 4181     FORMAT('THE ORTHOGONAL DISTANCE Y WEIGHTS VARIABLE ',I4,
     1           ' HAS JUST BEEN DESIGNATED AS ', A4,A4)
          CALL DPWRST('XXX','BUG ')
 4115   CONTINUE
        GOTO4199
C
 4199   CONTINUE
      ENDIF
      RETURN
      END
      SUBROUTINE DPORER(IHARG,IHARG2,NUMARG,
     1IODRE1,IODRE2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE USER VARIABLE NAME THAT DETERMINES WHICH
C              COLUMNS OF THE DESIGN MATRIX ARE TREATED AS
C              FIXED (I.E., NO ERRORS) OR HAVE ERRORS.  THE
C              CHOICES ARE:
C                 IODRE1 = 'ON':  ALL COLUMNS HAVE ERRORS
C                 IODRE1 = 'OFF': NO COLUMNS HAVE ERRORS (I.E.,
C                                 STANDARD LEAST SQUARES WILL BE USED)
C              OTHERWISE, IODRE1 AND IODRE2 DEFINE A VARIABLE
C              THAT CONTAINS 0 (FOR NO ERRORS) OR 1 (FOR ERRORS).
C              THAT IS, THE FIRST ROW OF THE VARIABLE APPLIES TO
C              THE FIRST VARIABLE IN THE FIT, THE SECOND ROW OF THE
C              VARIABLE APPLLIES TO THE SECOND VARIABLE IN THE FIT,
C              ETC.  NOTE THAT ODRPACK ACTUALLY ALLOWS EACH ELEMENT,
C              NOT JUST COLUMN, OF THE DESIGN MATRIX TO BE SET.
C              HOWEVER, DATAPLOT LIMITS THE CHOICE ON A COLUMN
C              BASIS.
C              NOTE: UPDATED TO ALLOW A LIST OF VARIABLE NAMES.
C                    THIS ALLOWS THE DELTAS TO VE FIXED OR UNFIXED
C                    AT THE OBSERVATION LEVEL AS OPPOSED TO THE
C                    COLUMN LEVEL.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IHARG2 (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--IODRE1 (A  HOLLERITH VARIABLE)
C                     --IODRE2 (A  HOLLERITH VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2001/4
C     ORIGINAL VERSION--APRIL     2001.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      PARAMETER (MAXDEL=20)
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IODRE1(MAXDEL)
      CHARACTER*4 IODRE2(MAXDEL)
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
 1110 CONTINUE
      IF(NUMARG.LE.1)THEN
        IF(NUMARG.EQ.0)THEN 
          DO1140I=1,MAXDEL
            IODRE1(I)='ON  '
            IODRE2(I)='    '
 1140     CONTINUE
          IF(IFEEDB.EQ.'ON')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1141)
 1141       FORMAT('THE ORTHOGONAL DISTANCE FIT WILL ASSUME ALL ',
     1             'INDEPENDENT VARIABLES HAVE ERRORS.')
            CALL DPWRST('XXX','BUG ')
          ENDIF
        ELSEIF(IHARG(1).EQ.'ON' .OR. IHARG(1).EQ.'YES' .OR.
     1    IHARG(1).EQ.'AUTO' .OR. IHARG(1).EQ.'DEFA')THEN
          IFOUND='YES'
          DO1150I=1,MAXDEL
            IODRE1(I)='ON  '
            IODRE2(I)='    '
 1150     CONTINUE
          IF(IFEEDB.EQ.'ON')THEN
            WRITE(ICOUT,999)
  999       FORMAT(1X)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1151)
 1151       FORMAT('THE ORTHOGONAL DISTANCE FIT WILL ASSUME ALL ',
     1             'INDEPENDENT VARIABLES HAVE ERRORS.')
            CALL DPWRST('XXX','BUG ')
          ENDIF
        ELSEIF(IHARG(1).EQ.'OFF' .OR. IHARG(1).EQ.'NO' .OR.
     1    IHARG(1).EQ.'NONE')THEN
          IFOUND='YES'
          DO1170I=1,MAXDEL
            IODRE1(I)='OFF '
            IODRE2(I)='    '
 1170     CONTINUE
          IF(IFEEDB.EQ.'ON')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1171)
 1171       FORMAT('THE ORTHOGONAL DISTANCE FIT WILL ASSUME ALL ',
     1             'INDEPENDENT VARIABLES ARE FIXED.')
            CALL DPWRST('XXX','BUG ')
          ENDIF
        ELSE
          IFOUND='YES'
          IODRE1(1)=IHARG(1)
          IODRE2(1)=IHARG2(1)
          IF(IFEEDB.EQ.'ON')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1181)IODRE1(1),IODRE2(2)
 1181       FORMAT('THE VARIABLE ',A4,A4,' WILL DEFINE WHICH ',
     1             'INDEPENDENT VARIABLES ARE FIXED')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1183)
 1183       FORMAT('AND WHICH ARE ASSUMED TO HAVE ERRORS IN ',
     1             'ORTHOGONAL DISTANCE FITS.')
            CALL DPWRST('XXX','BUG ')
          ENDIF
        ENDIF
      ELSEIF(NUMARG.GT.1)THEN
        IFOUND='YES'
C
        DO3010I=1,MAXDEL
          IODRE1(I)='OFF '
          IODRE2(I)='    '
 3010   CONTINUE
C
        DO3115J=1,MIN(NUMARG,MAXDEL)
          IODRE1(J)=IHARG(J)
          IODRE2(J)=IHARG2(J)
C
          IF(IFEEDB.EQ.'OFF')GOTO3115
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,3181)J,IODRE1(J),IODRE2(J)
 3181     FORMAT('THE ORTHOGONAL DISTANCE FIXED VARIABLE ',I4,
     1           ' HAS JUST BEEN DESIGNATED AS ', A4,A4)
          CALL DPWRST('XXX','BUG ')
 3115   CONTINUE
        GOTO3199
C
 3199   CONTINUE
      ENDIF
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPORSW(IHARG,NUMARG,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE ORIENTATION SWITCH IORNSW
C              (DETERMINES PAGE ORIENTATION.  FOR EXAMPLE,
C              POSTSCRIPT, QUIC AND OTHER LASER PRINTERS TYPICALLY
C              SUPPORT A "PORTRAIT" AND "LANDSCAPE" MODE.  ALSO INCLUDE
C              "POSTER" MODE FOR CALCOMP TYPE PLOTTERS THAT CAN SUPPORT
C              A "LARGE" PAPER SIZE.
C              FOR POSTSCRIPT, ADD "LANDSCAPE WORDPERFECT" OPTION.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C     UPADATED        --MARCH     1990. (ADDED SQUARE OPTION, ALAN)
C     UPADATED        --NOVEMBER  1996. ADD "LANDSCAPE WORDPERFECT"
C     UPADATED        --MARCH     2006. BUG FIX: GRSEPP AUTOMATICALLY
C                                       TURNS DEVICE ON, SO DON'T
C                                       CALL GRSEPP IF DEVICE IS OFF.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IFOUND
      CHARACTER*4 IFOUN2
      CHARACTER*4 IERROR
CCCCC CHARACTER*4 IPOWER
      CHARACTER*4 IBUGO2
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOF2.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
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
      IBUGO2='OFF'
C
      IF(NUMARG.LT.1)GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'SQUA')GOTO1140
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'FULL')GOTO1150
      IF(IHARG(NUMARG).EQ.'MAXI')GOTO1150
      IF(IHARG(NUMARG).EQ.'LAND')GOTO1160
      IF(IHARG(NUMARG).EQ.'HORI')GOTO1160
      IF(IHARG(NUMARG).EQ.'VERT')GOTO1170
      IF(IHARG(NUMARG).EQ.'PORT')GOTO1170
      IF(IHARG(NUMARG).EQ.'POST')GOTO1175
CCCCC ADD FOLLOWING LINE FOR LANDSCAPE WORDPERFECT, NOVEMBER 1996.
      IF(IHARG(NUMARG).EQ.'WORD')GOTO1178
      GOTO1199
C
 1140 CONTINUE
      IORNSW='SQUA'
      GOTO1180
C
 1150 CONTINUE
      IORNSW='FULL'
      GOTO1180
C
 1160 CONTINUE
      IORNSW='LAND'
      GOTO1180
C
 1170 CONTINUE
      IORNSW='PORT'
      GOTO1180
C
 1175 CONTINUE
      IORNSW='POST'
      GOTO1180
C
 1178 CONTINUE
      IORNSW='LAN2'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
C               ********************************************
C               **  STEP 20--                             **
C               **  CALL GRSEPP FOR EACH DEVICE           **
C               ********************************************
C
      DO2000IDEV=1,NUMDEV
C
C     MARCH 2006 BUG FIX:  ONLY CALL GRSEPP IF DEVICE IS ON.
C
      IF(IDPOWE(IDEV).NE.'ON')GOTO2000
C
      IFOUN2='NO'
      CALL GRSEPP(IDEV,
     1IPL1NU,
     1IPL2NU,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDFONT,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1IBUGO2,IFOUN2,IERROR)
 2000 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IORNSW
 1181 FORMAT('THE ORIENTATION SWITCH HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)
 1182 FORMAT('NOTE: THE EFFECT OF THIS COMMAND IS DEVICE DEPENDENT')
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPORTH(IBUGA2,IBUGA3,IBUGCO,IBUGEV,IBUGQ,ISUBRO,
     1IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT AN ORTHOGONAL DISTANCE (ERROR IN VARIABLES)
C              FIT (BASED ON ODRPACK CODE) 
C              FOR LINEAR AND NON-LINEAR MODELS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2001/4
C     ORIGINAL VERSION--APRIL    2001.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      PARAMETER (MAXDEL=20)
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASFI
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 ICASEQ
      CHARACTER*4 IKEY
      CHARACTER*4 IWD1
      CHARACTER*4 IWD2
      CHARACTER*4 IWD12
      CHARACTER*4 IWD22
      CHARACTER*4 IHPARN
      CHARACTER*4 IHPAR2
      CHARACTER*4 IREPU
      CHARACTER*4 IRESU
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IHRESP(MAXDEL)
      CHARACTER*4 IHRES2(MAXDEL)
      CHARACTER*4 IREP
      CHARACTER*4 IMPFLG
      CHARACTER*4 CTEMP1
      CHARACTER*4 CTEMP2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IPART1
      CHARACTER*4 IPART2
C
      DIMENSION IPART1(100)
      DIMENSION IPART2(100)
      DIMENSION PARTMP(100)
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHO.INC'
C
      PARAMETER (MAXFAC=20)
      PARAMETER (MAXOB2=MAXOBV/2)
C
      DIMENSION IPAROC(100)
C
      REAL RES2(MAXOB2)
      REAL PRED2(MAXOB2)
      DOUBLE PRECISION W(MAXOB2)
      DOUBLE PRECISION YTEMP(MAXOB2)
C
      DOUBLE PRECISION XMAT(10*MAXOBV)
      DOUBLE PRECISION RHO(20*MAXOBV/2)
      DOUBLE PRECISION WORK(46*MAXOBV/2)
C
      DIMENSION PARAM3(100)
      DIMENSION ICOLV3(100)
      DIMENSION NIV(100)
C
      INTEGER IFIX(MAXOB2*MAXDEL)
      INTEGER IWORK(MAXOBV)
      DIMENSION ILOCD(MAXDEL)
      DIMENSION ICOLD(MAXDEL)
      DIMENSION NDELTA(MAXDEL)
      DIMENSION ILOCD2(MAXDEL)
      DIMENSION ICOLD2(MAXDEL)
      DIMENSION NDELT2(MAXDEL)
      DIMENSION ILOCRV(MAXDEL)
      DIMENSION ICOLRV(MAXDEL)
      DIMENSION ILOCWR(MAXDEL)
      DIMENSION ICOLWR(MAXDEL)
      DIMENSION NRWEIG(MAXDEL)
      DIMENSION ILOCE(MAXDEL)
      DIMENSION ICOLE(MAXDEL)
      DIMENSION NERROR(MAXDEL)
      CHARACTER*4 IDLFLG
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      EQUIVALENCE (W(1),X3D(1))
      EQUIVALENCE (PRED2(1),X(1))
      EQUIVALENCE (RES2(1),D(1))
      EQUIVALENCE (YTEMP(1),Y(1))
C
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOZ2.INC'
      INCLUDE 'DPCOZD.INC'
      INCLUDE 'DPCOZI.INC'
      EQUIVALENCE (GARBAG(IGARB1),RHO(1))
      EQUIVALENCE (G2RBAG(IGAR11),WORK(1))
      EQUIVALENCE (DGARBG(IDGAR1),XMAT(1))
      EQUIVALENCE (IGARBG(IIGAR1),IFIX(1))
      EQUIVALENCE (IGARBG(IIGR17),IWORK(1))
C
      PARAMETER (IODRCH=1000)
      PARAMETER (IODRC2=100)
      PARAMETER (MAXNQ=5)
C
      CHARACTER*4 IBUGAZ
      CHARACTER*4 ZTYPEH
      CHARACTER*4 ZW21HO
      CHARACTER*4 ZW22HO
      CHARACTER*4 ZIPARN
      CHARACTER*4 ZPARN2
      CHARACTER*4 ZMODEL
      CHARACTER*4 ZIDUMV
      CHARACTER*4 ZDUMV2
C
      DIMENSION ZPARAM(IODRC2,MAXNQ)
      DIMENSION ZIPARN(IODRC2,MAXNQ)
      DIMENSION ZPARN2(IODRC2,MAXNQ)
      DIMENSION ZIDUMV(IODRC2,MAXNQ)
      DIMENSION ZDUMV2(IODRC2,MAXNQ)
      DIMENSION LOCDUM(IODRC2,MAXNQ)
C
      DIMENSION ZMODEL(IODRCH,MAXNQ)
      DIMENSION ZTYPEH(IODRCH,MAXNQ)
      DIMENSION ZW21HO(IODRCH,MAXNQ)
      DIMENSION ZW22HO(IODRCH,MAXNQ)
      DIMENSION Z2HOLD(IODRCH,MAXNQ)
C
      INTEGER NUMCHZ(MAXNQ)
      INTEGER NUMPAZ(MAXNQ)
      INTEGER NWHOLZ(MAXNQ)
      INTEGER NUMVAZ(MAXNQ)
C
      COMMON /ODRCMC/ IBUGAZ, ZTYPEH, ZW21HO, ZW22HO, ZIPARN, ZPARN2, 
     &                ZIDUMV, ZDUMV2, ZMODEL
      COMMON /ODRCMR/ ZPARAM, Z2HOLD,
     &                NUMCHZ, NUMPAZ, NWHOLZ, NUMVAZ, LOCDUM
C
      CHARACTER*4 IPAROC
      CHARACTER*4 IPARO3
      CHARACTER*4 IPARN3
      CHARACTER*4 IPARN4
      CHARACTER*4 IVARN3
      CHARACTER*4 IVARN4
      DIMENSION IPARN3(100)
      DIMENSION IPARN4(100)
      DIMENSION ICON3(100)
      DIMENSION IPARO3(100)
      DIMENSION PARLI3(100)
      DIMENSION IVARN3(100)
      DIMENSION IVARN4(100)
C
      COMMON /ODRCM2/ IPAROC, IPARO3, IPARN3, IPARN4, IVARN3, IVARN4
      COMMON /ODRCR2/ ICON3, PARLI3, NUMPAR, NUMVAR
C
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='DPOR'
      ISUBN2='TH  '
C
      IERROR='NO'
      IMPFLG='OFF'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IPAROC(1)='NONE'
C
      MAXV2=MAXDEL
      MAXYV2=5
      MINN2=2
      NQ=1
C
      MAXITS=IFITIT
C
      MAXN2=MAXCHF
      MAXN3=MAXCHF
      MAXN4=MAXCHF
C
      NUMPV=(-999)
      IP=(-999)
      IV=(-999)
C
      IWIDMO=(-999)
C
      NUMIND=(-999)
C
C               **************************
C               **  TREAT THE FIT CASE  **
C               **************************
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'ORTH')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPORTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGA2,IBUGA3
   53 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IBUGCO,IBUGEV,IBUGQ
   54 FORMAT('IBUGCO,IBUGEV,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)NUMNAM
   56 FORMAT('NUMNAM = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO57I=1,NUMNAM
      WRITE(ICOUT,58)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I),
     1VALUE(I)
   58 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I)',
     1'VALUE(I) = ',I8,2X,A4,A4,2X,A4,I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   57 CONTINUE
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICOM.EQ.'ORTH'.AND.IHARG(1).EQ.'DIST'.AND.
     1   IHARG(2).EQ.'FIT ')GOTO112
      IF(ICOM.EQ.'ORTH'.AND.IHARG(1).EQ.'DIST'.AND.
     1   IHARG(2).EQ.'REGR')GOTO112
      IF(ICOM.EQ.'ERRO'.AND.IHARG(1).EQ.'IN  '.AND.
     1   IHARG(2).EQ.'VARI'.AND.IHARG(3).EQ.'FIT ')GOTO113
      IF(ICOM.EQ.'ERRO'.AND.IHARG(1).EQ.'IN  '.AND.
     1   IHARG(2).EQ.'VARI'.AND.IHARG(3).EQ.'REGR')GOTO113
      IFOUND='NO'
      GOTO9000
C
  112 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  113 CONTINUE
      ILASTC=3
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      ICASFI='ORTF'
C
      IF(ICASFI.EQ.'    '.OR.IFOUND.EQ.'NO')GOTO9000
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=0
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ******************************************************
C               **  STEP 3--                                        **
C               **  FOR THE CASES WHEN HAVE FIT Y = SOME EXPRESSION **
C               **  DETERMINE IF WE HAVE A VALID FUNCTIONAL         **
C               **  EXPRESSION--IN PARTICULAR, CHECK THAT THE NUMBER**
C               **  OF ARGUMENTS IS AT LEAST 1, AND ALSO CHECK      **
C               **  THAT THERE IS EXACTLY 1 EQUAL SIGN AND THAT     **
C               **  THIS EQUAL SIGN OCCURS AS THE SECOND ARGUMENT.  **
C               ******************************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.1)GOTO2090
      WRITE(ICOUT,2001)
 2001 FORMAT('***** ERROR IN DPORTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2002)
 2002 FORMAT('      NUMBER OF ARGUMENTS DETECTED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2003)NUMARG
 2003 FORMAT('      IN ORTHOGONAL DISTANCE FIT COMMAND = 0.  ',
     1       'NUMARG = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2007)IWIDTH
 2007 FORMAT('      NUMBER OF CHARACTERS IN COMMAND LINE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,2008)(IANS(J),J=1,MIN(100,IWIDTH))
 2008   FORMAT('      COMMAND LINE--',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
 2090 CONTINUE
C
      DO2100J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO2110
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO2110
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO2110
 2100 CONTINUE
      ILOCQ=NUMARG+1
      GOTO2120
 2110 CONTINUE
      ILOCQ=J1
      GOTO2120
 2120 CONTINUE
C
      IF(ICASFI.EQ.'ORTF')GOTO2125
      GOTO2190
 2125 CONTINUE
      NUMEQ=0
      IMAX=ILOCQ-1
      DO2130I=1,IMAX
      IF(IHARG(I).EQ.'=   '.AND.IHARG2(I).EQ.'    ')THEN
        NUMEQ=NUMEQ+1
        NQ=I-1
        ILOCE2=I
      ENDIF
 2130 CONTINUE
      IF(NUMEQ.GT.1)THEN
        WRITE(ICOUT,2131)
 2131   FORMAT('***** ERROR IN DPORTH--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2132)
 2132   FORMAT('      NUMBER OF EQUAL SIGNS DETECTED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2133)NUMEQ
 2133   FORMAT('      IN MODEL GREATER THAN 1.  NUMEQ = ',I6)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2134)NUMARG,IMAX
 2134   FORMAT('      NUMARG, IMAX = ',2I10)
        CALL DPWRST('XXX','BUG ')
        DO2135I=1,NUMARG
        WRITE(ICOUT,2136)I,IHARG(I),IHARG2(I)
 2136   FORMAT('I,IHARG(I),IHARG2(I) = ',I8,A4,A4)
        CALL DPWRST('XXX','BUG ')
 2135   CONTINUE
        WRITE(ICOUT,2137)IWIDTH
 2137   FORMAT('      NUMBER OF CHARACTERS IN COMMAND LINE = ',I8)
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2138)(IANS(J),J=1,IWIDTH)
 2138     FORMAT('      COMMAND LINE--',100A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ELSEIF(NUMEQ.EQ.0)THEN
        IMPFLG='ON'
      ENDIF
      IF(NQ.GT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2141)
 2141   FORMAT('FOR ORTHOGONAL DISTANCE FIT, MULTIPLE RESPONSE ',
     1         'VARIABLES CASE DETECTED.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2143)NQ
 2143   FORMAT('NUMBER OF RESPONSE VARIABLES = ',I5)
        CALL DPWRST('XXX','BUG ')
        IF(NQ.GT.MAXDEL)THEN
          WRITE(ICOUT,2145)MAXDEL
 2145   FORMAT('**** ERROR: MAXIMIUM NUMBER OF RESPONSE VARIABLES,',
     1         I5,', EXCEEDED.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
      ENDIF
C
 2190 CONTINUE
C
      IF(ICASFI.EQ.'ORTF'.AND.IHARG(2).NE.'='.AND.
     1   NQ.EQ.1.AND.IMPFLG.EQ.'OFF')GOTO2200
      GOTO2290
C
 2200 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2201)
 2201 FORMAT('***** ERROR IN DPORTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2202)
 2202 FORMAT('      WHEN FITTING GENERAL EXPRESSIONS,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2203)
 2203 FORMAT('      THE SECOND ARGUMENT AFTER THE WORD     FIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2204)
 2204 FORMAT('      SHOULD BE (BUT WAS NOT) AN EQUAL SIGN.')
      CALL DPWRST('XXX','BUG ')
      IF(ICASFI.EQ.'ORTF')THEN
        WRITE(ICOUT,2205)IHARG(2),IHARG2(2)
 2205   FORMAT('     THE ARGUMENT WAS ',A4,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      WRITE(ICOUT,2207)IWIDTH
 2207 FORMAT('      NUMBER OF CHARACTERS IN COMMAND LINE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,2208)(IANS(J),J=1,MIN(100,IWIDTH))
 2208   FORMAT('      COMMAND LINE--',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
C
 2290 CONTINUE
C
C               ****************************************************
C               **  STEP 4--                                      **
C               **  FOR ALL VARIATIONS OF THE COMMAND,            **
C               **  THE WORD AFTER  FIT  SHOULD BE THE RESPONSE   **
C               **  VARIABLE (= THE DEPENDENT VARIABLE).          **
C               **  EXTRACT THE RESPONSE VARIABLE AND DETERMINE   **
C               **  IF IT IS ALREADY IN THE NAME LIST AND IS, IN  **
C               **  FACT, A VARIABLE (AS OPPOSED TO A PARAMETER). **
C               **  NOTE: FOR IMPLICIT MODEL, NO RESPONSE         **
C               **        VARIABLE.                               **
C               ****************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IMPFLG.EQ.'ON')THEN
        I2=0
        NLEFT=-1
        IHLEFT='    '
        IHLEF2='    '
        GOTO2390
      ENDIF
C
      I2=0
C
      ILOCFI=I2
C
      DO2310J=1,NQ
        ILOCF1=ILOCFI+1
        IF(J.EQ.1)THEN
          IHLEFT=IHARG(ILOCF1)
          IHLEF2=IHARG2(ILOCF1)
        ENDIF
        IHRESP(J)=IHARG(ILOCF1)
        IHRES2(J)=IHARG2(ILOCF1)
        DO2350I=1,NUMNAM
          I2=I
          IF(IHRESP(J).EQ.IHNAME(I2).AND.IHRES2(J).EQ.IHNAM2(I2).AND.
     1       IUSE(I2).EQ.'V')GOTO2379
 2350   CONTINUE
        WRITE(ICOUT,2361)
 2361   FORMAT('***** ERROR IN DPORTH--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2362)
 2362   FORMAT('      A NAME BETWEEN THE WORD FIT AND THE "=" SIGN')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2363)
 2363   FORMAT('      (WHICH SHOULD BE A RESPONSE VARIABLE)')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2364)
 2364   FORMAT('      EITHER DOES NOT EXIST OR IS A PARAMETER ',
     1         '(AS OPPOSED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2366)
 2366   FORMAT('      TO A VARIABLE) IN THE CURRENT LIST OF')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2367)
 2367   FORMAT('      AVAILABLE VARIABLE AND PARAMETER NAMES.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2369)IHRESP(J),IHRES2(J)
 2369   FORMAT('      NAME AFTER THE WORD FIT = ',A4,A4)
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2378)(IANS(JJ),JJ=1,MIN(100,IWIDTH))
 2378     FORMAT('      COMMAND LINE--',100A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
 2379   CONTINUE
        IF(J.EQ.1)THEN
          ILOCV=I2
          ICOLL=IVALUE(ILOCV)
          NLEFT=IN(ILOCV)
        ELSE
          ILOCRV(J)=I2
          ICOLRV(J)=IVALUE(ILOCV)
          NTEMP=IN(ILOCV)
          IF(NTEMP.NE.NLEFT)THEN
            WRITE(ICOUT,2381)
 2381       FORMAT('***** ERROR IN DPORTH--FOR THE MULTI-RESPONSE',
     1             'VARIABLE CASE,')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2383)
 2383       FORMAT('      ALL RESPONSE VARIABLES MUST HAVE THE SAME',
     1             'NUMBER OF OBSERVATIONS.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2385)IHRESP(J),IHRES2(J),NTEMP
 2385       FORMAT('      RESPONSE VARIABLE ',A4,A4,' HAS ',I8,
     1             'OBSERVATIONS.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2387)NLEFT
 2387       FORMAT('      NUMBER OF OBSEVATIONS EXPECTED: ',I8)
            CALL DPWRST('XXX','BUG ')
            IF(IWIDTH.GE.1)THEN
              WRITE(ICOUT,2378)(IANS(JJ),JJ=1,MIN(100,IWIDTH))
              CALL DPWRST('XXX','BUG ')
            ENDIF
            IERROR='YES'
            GOTO9000
          ENDIF
        ENDIF
 2310 CONTINUE
C
 2390 CONTINUE
C
C               ****************************************************
C               **  STEP 5--                                      **
C               **  FOR ALL VARIATIONS OF THE COMMAND, CHECK THAT **
C               **  THE INPUT NUMBER OF OBSERVATIONS (NLEFT)      **
C               **  FOR THE RESPONSE VARIABLE IS 2 OR LARGER AND  **
C               **  LESS THAN MAXOB2.                             **
C               ****************************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IMPFLG.EQ.'ON')GOTO390
      IF(NLEFT.GE.MINN2.AND.NLEFT.LE.MAXOB2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPORTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)IHLEFT,IHLEF2
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS (FOR WHICH AN ',
     1'(IN VARIABLE ',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      ORTHOGONAL DISTANCE FIT WAS TO HAVE BEEN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      PERFORMED MUST BE AT LEAST ',I8,' AND NO MORE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      THAN ',I8,';  SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)NLEFT
  317 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,318)
  318 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,319)(IANS(I),I=1,MIN(100,IWIDTH))
  319 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  390 CONTINUE
C
C               ************************************************
C               **  STEP 5.1--                                **
C               **  CHECK TO SEE IF HAVE A WEIGHTS VARIABLE.  **
C               **  IF DO HAVE, CHECK TO SEE IF A VARIABLE    **
C               **  (AS OPPOSED TO A PARAMETER).              **
C               **  NOTE: TWO WAYS TO DEFINE WEIGHT VARIABLES:**
C               **  1) WEIGHTS COMMAND   - FOR SINGLE         **
C               **     RESPONSE CASE ONLY.                    **
C               **  2) ORTOGONAL DISTANCE Y WEIGHTS - FOR     **
C               **     EITHER SINGLE RESPONSE OR              **
C               **     MULTI-RESPONSE CASES.                  **
C               **  NOTE THAT IF BOTH SPECIFIED FOR SINGLE    **
C               **  RESPONSE CASE, THEN METHOD 2 OVERRIDES.   **
C               ************************************************
C
      ISTEPN='5.1'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ILOCW=-99
      ICOLW=-99
      NWEIGH=-99
      DO2405I=1,MAXDEL
        ILOCWR(I)=-99
        ICOLWR(I)=-99
        NRWEIG(I)=-99
 2405 CONTINUE
C
      IF(IMPFLG.EQ.'ON')GOTO2490
      IF(IWEIGH.EQ.'OFF'.AND.IWEIN1(1).EQ.'OFF')GOTO2490
C
      IF(NQ.EQ.1.AND.J.EQ.1 .AND. IWEIN1(1).EQ.'OFF')THEN
        CTEMP1=IWEIG1
        CTEMP2=IWEIG2
        DO2420I=1,NUMNAM
          I2=I
          IF(IWEIG1.EQ.IHNAME(I2).AND.IWEIG2.EQ.IHNAM2(I2).AND.
     1       IUSE(I2).EQ.'V')THEN
             ILOCW=I2
             ICOLW=IVALUE(ILOCW)
             NWEIGH=IN(ILOCW)
             ILOCWR(1)=ILOCW
             ICOLWR(1)=ICOLW
             NRWEIG(1)=NWEIGH
             IF(NWEIGH.NE.NLEFT)GOTO2481
             GOTO2490
          ENDIF
 2420   CONTINUE
        GOTO2460
      ENDIF
C
      DO2410J=1,NQ
C
        CTEMP1=IWEIN1(J)
        CTEMP2=IWEIN2(J)
        DO2450I=1,NUMNAM
          I2=I
          IF(IWEIN1(J).EQ.IHNAME(I2).AND.IWEIN2(J).EQ.IHNAM2(I2).AND.
     1         IUSE(I2).EQ.'V')THEN
            ILOCWR(J)=I2
            ICOLWR(J)=IVALUE(ILOCWR(J))
            NRWEIG(J)=IN(ILOCWR(J))
            IF(NRWEIG(J).NE.NLEFT)GOTO2481
            GOTO2490
          ENDIF
 2450   CONTINUE
C 
 2410 CONTINUE
C
 2460 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2461)
 2461 FORMAT('***** ERROR IN DPORTH--A WEIGHT VARIABLE FOR THE',
     1       ' RESPONSE VARIABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2463)
 2463 FORMAT('      (AS SPECIFIED VIA THE WEIGHTS COMMAND OR THE ',
     1       'ORTHOGONAL DISTANCE Y WEIGHTS COMMAND)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2465)
 2465 FORMAT('      EITHER DOES NOT EXIST OR IS A PARAMETER (AS ',
     1       'OPPOSED TO A VARIABLE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2466)
 2466 FORMAT('      IN THE CURRENT LIST OF AVAILABLE VARIABLE AND ',
     1       'PARAMETER NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2469)CTEMP1,CTEMP2
 2469 FORMAT('      NAME OF SPECIFIED WEIGHTS VARIABLE = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,2478)(IANS(JJ),JJ=1,MIN(100,IWIDTH))
 2478   FORMAT('      COMMAND LINE--',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
C
 2481 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2483)
 2483 FORMAT('***** ERROR IN DPORTH--A WEIGHT VARIABLE FOR THE',
     1       ' RESPONSE VARIABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2485)
 2485 FORMAT('      DOES NOT HAVE THE SAME NUMBER OF OBSERVATIONS ',
     1       'AS THE RESPONSE VARIABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2487)CTEMP1,CTEMP2,NRWEIG(J)
 2487 FORMAT('      WEIGHT VARIABLE, ',A4,A4,' HAS ',I8,
     1       'OBSEVATIONS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2489)NLEFT
 2489 FORMAT('      NUMBER OF OBSEVATIONS EXPECTED: ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,2478)(IANS(JJ),JJ=1,MIN(100,IWIDTH))
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
C
 2490 CONTINUE
C
C               ************************************************
C               **  STEP 5.2--                                **
C               **  CHECK TO SEE IF HAVE A "ERROR" VARIABLE.  **
C               **  IF DO HAVE, CHECK TO SEE IF A VARIABLE    **
C               **  (AS OPPOSED TO A PARAMETER).              **
C               ************************************************
C
      ISTEPN='5.2'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO2510I=1,MAXDEL
        ILOCE(I)=-99
        ICOLE(I)=-99
        NERROR(I)=-99
 2510 CONTINUE
      NUMERR=0
C
      IF(IODRE1(1).EQ.'ON')THEN
        CONTINUE
      ELSEIF(IODRE1(1).NE.'OFF')THEN
        DO2540J=1,MAXDEL
          IF(IODRE1(J).EQ.'OFF' .OR. IODRE1(J).EQ.'ON')GOTO2549
          DO2550I=1,NUMNAM
            I2=I
            IF(IODRE1(J).EQ.IHNAME(I2).AND.IODRE2(J).EQ.IHNAM2(I2).AND.
     1         IUSE(I2).EQ.'V')GOTO2579
 2550     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2561)
 2561     FORMAT('***** ERROR IN DPORTH--ONE OF THE ERRORS VARIABLE ',
     1           '(AS SPECIFIED')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2563)
 2563     FORMAT('      VIA THE ORTHOGONAL DISTANCE ERROR COMMAND) ',
     1           'EITHER DOES NOT')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2565)
 2565     FORMAT('      EXIST OR IS A PARAMETER (AS OPPOSED TO A',
     1           ' VARIABLE) IN')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2566)
 2566     FORMAT('      THE CURRENT LIST OF AVAILABLE ',
     1           'VARIABLE AND PARAMETER NAMES.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2569)IODRE1(J),IODRE2(J)
 2569     FORMAT('      NAME OF SPECIFIED ERRORS VARIABLE = ',A4,A4)
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,2578)(IANS(JJ),JJ=1,MIN(100,IWIDTH))
 2578       FORMAT('      COMMAND LINE--',100A1)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
 2579     CONTINUE
          NUMERR=NUMERR+1
          ILOCE(J)=I2
          ICOLE(J)=IVALUE(ILOCE(J))
          NERROR(J)=IN(ILOCE(J))
C
 2540   CONTINUE
 2549   CONTINUE
      ENDIF
C
 2599 CONTINUE
C
C               ************************************************
C               **  STEP 5.3--                                **
C               **  CHECK TO SEE IF HAVE ONE OR MORE  DELTA   **
C               **  WEIGHT VARIABLE(S).                       **
C               **  IF DO HAVE, CHECK TO SEE IF A VARIABLE    **
C               **  (AS OPPOSED TO A PARAMETER).              **
C               ************************************************
C
      ISTEPN='5.3'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IDLFLG='OFF'
      NUMDEL=0
C
      DO2610I=1,MAXDEL
        ILOCD(I)=-99
        ICOLD(I)=-99
        NDELTA(I)=-99
 2610 CONTINUE
C
      IF(IODRD1(1).EQ.'OFF')GOTO2699
      IF(IODRD1(1).EQ.'ON')THEN
        IDLFLG='DEFA'
      ELSEIF(IODRD1(1).NE.'OFF')THEN
        DO2640J=1,MAXDEL
          IF(IODRD1(J).EQ.'OFF')GOTO2649
          DO2650I=1,NUMNAM
            I2=I
            IF(IODRD1(J).EQ.IHNAME(I2).AND.IODRD2(J).EQ.IHNAM2(I2).AND.
     1      IUSE(I2).EQ.'V')GOTO2679
 2650     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2661)
 2661 FORMAT('***** ERROR IN DPORTH--ONE OF THE DELTA WEIGHT VARIABLES',
     1       ' (AS SPECIFIED')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2663)
 2663 FORMAT('      VIA THE ORTHOGONAL DISTANCE DELTA COMMAND) EITHER')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2665)
 2665 FORMAT('      DOES NOT EXIST OR IS A PARAMETER (AS OPPOSED TO A')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2666)
 2666 FORMAT('      VARIABLE) IN THE CURRENT LIST OF AVAILABLE ',
     1       'VARIABLE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2667)
 2667 FORMAT('      AND PARAMETER NAMES.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2669)IODRD1(J),IODRD2(J)
 2669 FORMAT('      NAME OF SPECIFIED ERRORS VARIABLE = ',A4,A4)
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,2678)(IANS(JJ),JJ=1,MIN(100,IWIDTH))
 2678 FORMAT('      COMMAND LINE--',100A1)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
 2679     CONTINUE
          NUMDEL=NUMDEL+1
          ILOCD(J)=I2
          ICOLD(J)=IVALUE(ILOCD(J))
          NDELTA(J)=IN(ILOCD(J))
 2640   CONTINUE
 2649   CONTINUE
      ENDIF
C
 2699 CONTINUE
C
C               ************************************************
C               **  STEP 5.4--                                **
C               **  CHECK TO SEE IF HAVE ONE OR MORE DELTA    **
C               **  STARTING VALUE VARIABLE(S).               **
C               **  IF DO HAVE, CHECK TO SEE IF A VARIABLE    **
C               **  (AS OPPOSED TO A PARAMETER).              **
C               ************************************************
C
      ISTEPN='5.4'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C
      DO2710I=1,MAXDEL
        ILOCD2(I)=-99
        ICOLD2(I)=-99
        NDELT2(I)=-99
 2710 CONTINUE
      NUMDE2=0
C
      IF(IODRD3(1).EQ.'OFF')GOTO2799
      IF(IODRD3(1).EQ.'ON')GOTO2799
      DO2740J=1,MAXDEL
        IF(IODRD3(J).EQ.'OFF')GOTO2749
        DO2750I=1,NUMNAM
          I2=I
          IF(IODRD3(J).EQ.IHNAME(I2).AND.IODRD4(J).EQ.IHNAM2(I2).AND.
     1    IUSE(I2).EQ.'V')GOTO2779
 2750   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2761)
 2761 FORMAT('***** ERROR IN DPORTH--ONE OF THE DELTA STARTING VALUE',
     1       'VARIABLES (AS SPECIFIED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2763)
 2763 FORMAT('      VIA THE ORTHOGONAL DISTANCE DELTA COMMAND) EITHER')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2765)
 2765 FORMAT('      DOES NOT EXIST OR IS A PARAMETER (AS OPPOSED TO A')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2766)
 2766 FORMAT('      VARIABLE) IN THE CURRENT LIST OF AVAILABLE ',
     1     'VARIABLE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2767)
 2767 FORMAT('      AND PARAMETER NAMES.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2769)IODRD3(J),IODRD4(J)
 2769 FORMAT('      NAME OF SPECIFIED ERRORS VARIABLE = ',A4,A4)
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2778)(IANS(JJ),JJ=1,MIN(100,IWIDTH))
 2778 FORMAT('      COMMAND LINE--',100A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
 2779   CONTINUE
        NUMDE2=NUMDE2+1
        ILOCD2(J)=I2
        ICOLD2(J)=IVALUE(ILOCD2(J))
        NDELT2(J)=IN(ILOCD2(J))
 2740 CONTINUE
 2749 CONTINUE
C
 2799 CONTINUE
C
C               ******************************************************
C               **  STEP 6.1--                                      **
C               **  FOR THE CASES WHEN HAVE FIT Y = SOME EXPRESSION **
C               **  EXTRACT THE ENTIRE (LEFT AND RIGHT SIDE) FUNCTIONAL
C               **  EXPRESSION FROM THE INPUT COMMAND LINE.         **
C               **  COPY OUT TO IWIDTH, OR OUT TO 'SUBS' (EXCLUSIVE),*
C               **  OR OUT THE 'EXCE' (EXCLUSIVE)                   **
C               **  FIRST, FOR MULTI-RESPONSE CASE, CHECK THAT      **
C               **  HAVE A LIST OF NQ FUNCTION NAMES ON RHS.        **
C               ******************************************************
C
      ISTEPN='6.1'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NQ.GT.1)THEN
        ISTRT=ILOCE2+1
        ILAST=ILOCQ-1
        NUMF=0
        DO3010I=ISTRT,ILAST
          DO3020J=1,NUMNAM
            IF(IHARG(I).EQ.IHNAME(J).AND.IHARG2(I).EQ.IHNAM2(J))THEN
              IF(IUSE(J).EQ.'F')THEN
                NUMF=NUMF+1
                GOTO3010
              ELSE
                WRITE(ICOUT,999)
                CALL DPWRST('XXX','BUG ')
                WRITE(ICOUT,3021)IHARG(I),IHARG2(I)
                CALL DPWRST('XXX','BUG ')
                WRITE(ICOUT,3023)
                CALL DPWRST('XXX','BUG ')
                WRITE(ICOUT,3023)
                CALL DPWRST('XXX','BUG ')
                IF(IWIDTH.GE.1)THEN
                  WRITE(ICOUT,2378)(IANS(JJ),JJ=1,MIN(100,IWIDTH))
                  CALL DPWRST('XXX','BUG ')
                ENDIF
                IERROR='YES'
                GOTO9000
              ENDIF
            ENDIF
 3020     CONTINUE
C
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,3011)IHARG(I),IHARG2(I)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,3013)
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,2378)(IANS(JJ),JJ=1,MIN(100,IWIDTH))
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
 3010   CONTINUE
C
        IF(NQ.NE.NUMF)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,3031)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,3033)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,3035)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,3037)NUMF
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,3039)NQ
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,2378)(IANS(JJ),JJ=1,MIN(100,IWIDTH))
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
        ENDIF
C
        DO3040L=1,NQ
C
          ISTRT=ILOCE2+1
          LL=L+ISTRT-1
          DO3041II=1,4
            IFUNC2(II)=IHARG(LL)(II:II)
            IFUNC2(II+4)=IHARG2(LL)(II:II)
 3041     CONTINUE
          N2=8
C
          CALL DPEXFU(IFUNC2,N2,IHNAME,IHNAM2,IUSE,IVSTAR,IVSTOP,
     1    NUMNAM,IANS,IWIDTH,IFUNC,NUMCHF,MAXCHF,IFUNC3,N3,MAXN3,
     1    IBUGA3,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          J=0
          DO3050I=1,N3
            J=J+1
            ZMODEL(I,L)=IFUNC3(I)
 3050     CONTINUE
          NUMCHZ(L)=J
 3040   CONTINUE
        GOTO4190
      ENDIF
C
 3011 FORMAT('***** ERROR IN DPORTH--FOR THE MULTI-RESPONSE CASE, ',
     1       'ARGUMENT ',A4,A4)
 3013 FORMAT('      WAS NOT FOUND IN THE CURRENT LIST OF AVAILABLE ',
     1       'NAMES.')
C
 3021 FORMAT('***** ERROR IN DPORTH--FOR THE MULTI-RESPONSE CASE, ',
     1       'ARGUMENT ',A4,A4)
 3023 FORMAT('      WAS FOUND IN THE CURRENT LIST OF AVAILABLE ',
     1       'NAMES.   HOWEVER, IT WAS EXPECTED')
 3025 FORMAT('      TO BE THE NAME OF A FUNTCION AND IT IS NOT.')
C
 3031 FORMAT('***** ERROR IN DPORTH--FOR THE MULTI-RESPONSE CASE, ',
     1       'THE NUMBER OF FUNCTION')
 3033 FORMAT('      NAMES ON THE RIGHT OF THE EQUAL SIGN MUST EQUAL ',
     1       'THE NUMBER OF RESPONSE')
 3035 FORMAT('      VARIABLES ON THE LEFT OF THE EQUAL SIGN.')
 3037 FORMAT('      NUMBER OF FUNCTION NAMES       = ',I5)
 3039 FORMAT('      NUMBER OF RESPONSE VARIABLES   = ',I5)
C
      IF(ICASFI.EQ.'ORTF')GOTO4100
      GOTO4190
 4100 CONTINUE
      IF(NUMARG.EQ.0)GOTO4160
      IF(IHARG(1).EQ.'SUBS'.AND.IHARG2(1).EQ.'ET  ')GOTO4160
      IF(IHARG(1).EQ.'EXCE'.AND.IHARG2(1).EQ.'PT  ')GOTO4160
      IF(IHARG(1).EQ.'FOR '.AND.IHARG2(1).EQ.'    ')GOTO4160
      ISTART=-99
      ISTOP=-99
      DO4110I=1,IWIDTH
        IP1=I+1
        IP2=I+2
        IP3=I+3
        IP4=I+4
        IP5=I+5
        IP6=I+6
        IP7=I+7
        IP8=I+8
        IP9=I+9
        IP10=I+10
C
        IF(IP2.GT.IWIDTH)GOTO4120
        IF(IANS(I).EQ.'F'.AND.IANS(IP1).EQ.'I'
     1    .AND.IANS(IP2).EQ.'T')THEN
          ISTART=IP3
          IWD1='FIT '
          IWD12='    '
          GOTO4101
        ENDIF
C
        IF(IP9.GT.IWIDTH)GOTO4102
        IF(IANS(I).EQ.'R'.AND.IANS(IP1).EQ.'E'.AND.IANS(IP2).EQ.'G'.AND.
     1     IANS(IP3).EQ.'R'.AND.IANS(IP4).EQ.'E'.AND.
     1     IANS(IP5).EQ.'S'.AND.IANS(IP6).EQ.'S'.AND.
     1     IANS(IP7).EQ.'I'.AND.IANS(IP8).EQ.'O'.AND.
     1     IANS(IP9).EQ.' ')THEN
           ISTART=IP9
           IWD1='REGR'
           IWD12='ESSI'
           GOTO4101
        ENDIF
 4102   CONTINUE
        IF(IP8.GT.IWIDTH)GOTO4103
        IF(IANS(I).EQ.'R'.AND.IANS(IP1).EQ.'E'.AND.IANS(IP2).EQ.'G'.AND.
     1     IANS(IP3).EQ.'R'.AND.IANS(IP4).EQ.'E'.AND.
     1     IANS(IP5).EQ.'S'.AND.IANS(IP6).EQ.'S'.AND.
     1     IANS(IP7).EQ.'I'.AND.IANS(IP8).EQ.' ')THEN
           ISTART=IP8
           IWD1='REGR'
           IWD12='ESS '
           GOTO4101
        ENDIF
 4103   CONTINUE
        IF(IP7.GT.IWIDTH)GOTO4104
        IF(IANS(I).EQ.'R'.AND.IANS(IP1).EQ.'E'.AND.IANS(IP2).EQ.'G'.AND.
     1     IANS(IP3).EQ.'R'.AND.IANS(IP4).EQ.'E'.AND.
     1     IANS(IP5).EQ.'S'.AND.IANS(IP6).EQ.'S'.AND.
     1     IANS(IP7).EQ.' ')THEN
           ISTART=IP7
           IWD1='REGR'
           IWD12='ES  '
           GOTO4101
        ENDIF
 4104   CONTINUE
        IF(IP6.GT.IWIDTH)GOTO4105
        IF(IANS(I).EQ.'R'.AND.IANS(IP1).EQ.'E'.AND.IANS(IP2).EQ.'G'.AND.
     1     IANS(IP3).EQ.'R'.AND.IANS(IP4).EQ.'E'.AND.
     1     IANS(IP5).EQ.'S'.AND.IANS(IP6).EQ.' ')THEN
           ISTART=IP6
           IWD1='REGR'
           IWD12='E   '
           GOTO4101
        ENDIF
 4105   CONTINUE
        IF(IP5.GT.IWIDTH)GOTO4106
        IF(IANS(I).EQ.'R'.AND.IANS(IP1).EQ.'E'.AND.IANS(IP2).EQ.'G'.AND.
     1     IANS(IP3).EQ.'R'.AND.IANS(IP4).EQ.'E'.AND.
     1     IANS(IP5).EQ.' ')THEN
           ISTART=IP5
           IWD1='REGR'
           IWD12='    '
           GOTO4101
        ENDIF
 4106   CONTINUE
        IF(IP4.GT.IWIDTH)GOTO4107
        IF(IANS(I).EQ.'R'.AND.IANS(IP1).EQ.'E'.AND.IANS(IP2).EQ.'G'.AND.
     1     IANS(IP3).EQ.'R'.AND.IANS(IP4).EQ.' ')THEN
           ISTART=IP4
           GOTO4101
        ENDIF
 4107   CONTINUE
C
 4101   CONTINUE
C
        IF(IP4.GT.IWIDTH)GOTO4108
        IF(IANS(I).EQ.' '.AND.IANS(IP1).EQ.'F'.
     1  AND.IANS(IP2).EQ.'O'.AND.IANS(IP3).EQ.'R'.
     1  AND.IANS(IP4).EQ.' ')ISTOP=I
 4108   CONTINUE
C
        IF(IP7.GT.IWIDTH)GOTO4110
        IF(IANS(I).EQ.' '.AND.IANS(IP1).EQ.'S'.
     1  AND.IANS(IP2).EQ.'U'.AND.IANS(IP3).EQ.'B'.
     1  AND.IANS(IP4).EQ.'S'.AND.IANS(IP5).EQ.'E'.
     1  AND.IANS(IP6).EQ.'T'.AND.IANS(IP7).EQ.' ')ISTOP=I
C
 4110 CONTINUE
 4120 CONTINUE
C
      IF(ISTART.GE.1)GOTO4129
      IBRAN=4120
      WRITE(ICOUT,4121)IBRAN
 4121 FORMAT('*****INTERNAL ERROR IN DPORTH--',
     1'IMPOSSIBLE CONDITION AT BRANCH POINT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4122)
 4122 FORMAT('THE STRING    FIT  (OR REGRESSION)  NOT FOUND FOR ',
     1       'MODEL EXTRACTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4123)
 4123 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,4124)(IANS(I),I=1,MIN(100,IWIDTH))
 4124   FORMAT('      ',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
 4129 CONTINUE
C
 4130 CONTINUE
      IF(ISTOP.EQ.-99)ISTOP=IWIDTH
      IF(ISTART.LE.ISTOP)GOTO4139
      IBRAN=4130
      WRITE(ICOUT,4131)IBRAN
 4131 FORMAT('INTERNAL ERROR IN DPORTH--AT BRANCH POINT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4133)
 4133 FORMAT('ISTART GREATER THAN ISTOP FOR MODEL EXTRACTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4134)ISTART,ISTOP
 4134 FORMAT('ISTART, ISTOP = ',2I8)
      CALL DPWRST('XXX','BUG ')
       WRITE(ICOUT,4135)
 4135 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,4136)(IANS(I),I=1,MIN(100,IWIDTH))
 4136   FORMAT('      ',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
 4139 CONTINUE
C
      J=0
      DO4150I=ISTART,ISTOP
        J=J+1
        ZMODEL(J,1)=IANS(I)
 4150 CONTINUE
      NUMCHZ(1)=ISTOP-ISTART+1
 4160 CONTINUE
 4190 CONTINUE
C
C               **********************************************
C               **  STEP 6.3--                              **
C               **  FOR ALL VARIATIONS OF THE FIT COMMAND,  **
C               **  CHECK TO SEE THE TYPE CASE--            **
C               **    1) UNQUALIFIED (THAT IS, FULL);       **
C               **    2) SUBSET/EXCEPT; OR                  **
C               **    3) FOR.                               **
C               **********************************************
C
      ISTEPN='6.3'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO490
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      IKEY='SUBS'
      IF(IHARG(J1).EQ.'EXCE')IKEY='EXCE'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'ORTH')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ
  491 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               **********************************************
C               **  STEP 6.4--                              **
C               **  FOR SOME VARIATIONS OF THE FIT COMMAND, **
C               **  EXTRACT THE UNDERLYING FUNCTION         **
C               **  FROM FUNCTION DEFINITIONS.              **
C               **********************************************
C
C
      ISTEPN='6.4'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NQ.GT.1)GOTO5189
      IF(ICASFI.EQ.'ORTF')GOTO5160
      GOTO5189
C
 5160 CONTINUE
      IF(IMPFLG.EQ.'ON')THEN
        ILOCEQ=0
        GOTO5176
      ENDIF
C
      DO5170I=1,NUMCHZ(1)
      I2=I
      IF(ZMODEL(I,1).EQ.'=')GOTO5175
 5170 CONTINUE
      IBRAN=5170
      WRITE(ICOUT,5171)IBRAN
 5171 FORMAT('*****INTERNAL ERROR IN DPORTH--',
     1'IMPOSSIBLE CONDITION AT BRANCH POINT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5172)
 5172 FORMAT('NO EQUAL SIGN FOUND FOR MODEL EXTRACTION')
      CALL DPWRST('XXX','BUG ')
       WRITE(ICOUT,5173)
 5173 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,5174)(IANS(I),I=1,MIN(100,IWIDTH))
 5174   FORMAT('      ',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
 5175 CONTINUE
      ILOCEQ=I2
C
      IWD1='=   '
      IWD12='    '
C
 5176 CONTINUE
      IF(ICASEQ.EQ.'FULL')IWD2='    '
      IF(ICASEQ.EQ.'FULL')IWD22='    '
      IF(ICASEQ.EQ.'SUBS'.AND.IKEY.EQ.'SUBS')IWD2='SUBS'
      IF(ICASEQ.EQ.'SUBS'.AND.IKEY.EQ.'SUBS')IWD22='ET  '
      IF(ICASEQ.EQ.'SUBS'.AND.IKEY.EQ.'EXCE')IWD2='EXCE'
      IF(ICASEQ.EQ.'SUBS'.AND.IKEY.EQ.'EXCE')IWD22='PT  '
      IF(ICASEQ.EQ.'FOR')IWD2='FOR '
      IF(ICASEQ.EQ.'FOR')IWD22='    '
C
      IF(ICASFI.EQ.'ORTF')
     1CALL DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
     1IFUNC2,N2,IBUGA3,IFOUND,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(IFOUND.EQ.'YES')GOTO3379
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3371)
 3371 FORMAT('***** ERROR IN DPORTH--INVALID COMMAND FORM FOR',
     1       'FITTING.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3373)
 3373 FORMAT('      GENERAL FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3374)
 3374 FORMAT('      ORTHOGONAL DISTANCE FIT ... = ...  ',
     1'SUBSET ... ... ...')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3375)
 3375 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,3376)(IANS(I),I=1,MIN(100,IWIDTH))
 3376   FORMAT('      ',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
 3379 CONTINUE
C
      CALL DPEXFU(IFUNC2,N2,IHNAME,IHNAM2,IUSE,IVSTAR,IVSTOP,
     1NUMNAM,IANS,IWIDTH,IFUNC,NUMCHF,MAXCHF,IFUNC3,N3,MAXN3,
     1IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      J=ILOCEQ
      DO5180I=1,N3
        J=J+1
        ZMODEL(J,1)=IFUNC3(I)
 5180 CONTINUE
      NUMCHZ(1)=J
C
 5189 CONTINUE
C
C               *****************************************************
C               **  STEP 7--                                       **
C               **  MAKE A NON-CALCULATING PASS AT THE MODEL       **
C               **  SO AS TO EXTRACT ALL PARAMETER AND VARIABLE    **
C               **  NAMES.                                         **
C               *****************************************************
C
      ISTEPN='7'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMF=1
      IF(NQ.GT.1)NUMF=NQ
      DO4499L=1,NUMF
        IPASS=1
        CALL COMPIM(ZMODEL(1,L),NUMCHZ(L),IPASS,
     1              PARTMP,IPART1,IPART2,NUMPV,
     1              IANGLU,ZTYPEH(1,L),ZW21HO(1,L),ZW22HO(1,L),
     1              Z2HOLD(1,L),NWHOLZ(L),AJUNK,
     1              IBUGCO,IBUGEV,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 8--                              **
C               **  CHECK TO MAKE SURE THAT THE COMBINED  **
C               **  NUMBER OF PARAMETERS AND VARIABLES    **
C               **  IN THE MODEL IS AT LEAST 1.           **
C               ********************************************
C
        ISTEPN='8'
        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        IF(NUMPV.GE.1)GOTO4400
        WRITE(ICOUT,4401)
 4401 FORMAT('***** ERROR IN DPORTH--COMBINED NUMBER OF PARAMETERS',
     1       ' AND VARIABLES')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4403)NUMPV
 4403 FORMAT('      DETECTED IN THE MODEL FOR FUNCTION ',I5,' IS 0.',
     1       '  NUMPV = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4407)NUMCHZ(L)
 4407 FORMAT('      NUMBER OF CHARACTERS IN MODEL = ',I8)
        CALL DPWRST('XXX','BUG ')
        IF(NUMCHZ(L).GE.1)THEN
          WRITE(ICOUT,4408)(ZMODEL(J,L),J=1,MIN(100,NUMCHZ(L)))
 4408     FORMAT('      MODEL--',100A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
 4400   CONTINUE
C
C               ******************************************************
C               **  STEP 9--                                        **
C               **  CHECK THAT ALL VARIABLES                        **
C               **  IN THE MODEL ARE ALREADY PRESENT                **
C               **  IN THE AVAILABLE NAME LIST IHNAME(.) AND        **
C               **  IHNAM2(.).  CHECK THAT ALL PARAMETERS           **
C               **  IN THE MODEL ARE ALREADY PRESENT IN THE         **
C               **  AVAILABLE NAME LIST IHNAME(.) AND IHNAM2(.).    **
C               **  ALL NAMES IN THE MODEL THAT ARE NOT             **
C               **  IN THE NAME LIST AT ALL WILL BE ADDED           **
C               **  TO THE LIST, DEFINED AS PARAMETERS,             **
C               **  AND GIVEN A VALUE OF 1.0.                       **
C               **  THIS ALLOWS US TO MAKE AN INITIAL FIT           **
C               **  WITHOUT HAVING TO DEFINE STARTING VALUES AT ALL **
C               **  (THEY WILL BE AUTOMATICALLY SET TO 1.0).  ALSO, **
C               **  FORM A NEW VECTOR WHICH HAS ONLY PARAMETER NAMES**
C               **  AND ANOTHER VECTOR WHICH HAS ONLY VARIABLE NAMES.*
C               ******************************************************
C
        ISTEPN='9'
        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        IP=0
        IV=0
        DO7965J=1,NUMPV
          IHPARN=IPART1(J)
          IHPAR2=IPART2(J)
          DO7966I=1,NUMNAM
            I2=I
            IF(IHPARN.EQ.IHNAME(I).AND.IHPAR2.EQ.IHNAM2(I).AND.
     1         IUSE(I).EQ.'V')GOTO7980
            IF(IHPARN.EQ.IHNAME(I).AND.IHPAR2.EQ.IHNAM2(I).AND.
     1         IUSE(I).EQ.'P')GOTO7970
 7966     CONTINUE
          IP=IP+1
          ZIPARN(IP,L)=IHPARN
          ZPARN2(IP,L)=IHPAR2
          ZPARAM(IP,L)=1.0
C
          IF(NUMNAM.LT.MAXNAM)GOTO7769
          WRITE(ICOUT,7751)
 7751     FORMAT('***** ERROR IN DPORTH--THE TOTAL NUMBER OF')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7752)
 7752     FORMAT('      (VARIABLE + PARAMETER) NAMES MUST BE AT')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7753)MAXNAM
 7753     FORMAT('      MOST ',I8,'.  SUCH WAS NOT THE CASE HERE--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7755)
 7755     FORMAT('      THE MAXIMUM ALLOWABLE NUMBER OF NAMES WAS ',
     1           'JUST')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7757)
 7757     FORMAT('      EXCEEDED.  SUGGESTED ACTION--ENTER     STATUS')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7758)
 7758     FORMAT('      TO DETERMINE THE IMPORTANT (VERSUS ',
     1           'UNIMPORTANT) VARIABLES')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7760)
 7760     FORMAT('      AND PARAMETERS, AND THEN REUSE SOME OF THE ',
     1           'NAMES.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7762)
 7762     FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,7763)(IANS(I),I=1,MIN(100,IWIDTH))
 7763       FORMAT('      ',80A1)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
 7769   CONTINUE
C
        I2=NUMNAM+1
        IHNAME(I2)=IHPARN
        IHNAM2(I2)=IHPAR2
        IUSE(I2)='P'
        IVALUE(I2)=1
        VALUE(I2)=1.0
        IN(I2)=1
        NUMNAM=I2
        IF(IFEEDB.EQ.'OFF')GOTO7859
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7852)
 7852   FORMAT('      NOTE--A NAME USED IN AN EXPRESSION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7853)ZIPARN(J,L),ZPARN2(J,L)
 7853   FORMAT('      HAS NOT YET BEEN DEFINED.  NAME = ',A4,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7855)
 7855   FORMAT('      THIS NAME HAS BEEN ADDED TO THE LIST, SPECIFIED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7857)
 7857   FORMAT('      AS A PARAMETER AND GIVEN THE VALUE 1.0 .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7858)(ZMODEL(I,L),I=1,MIN(100,NUMCHZ(L)))
 7858   FORMAT('      FUNCTION EXPRESSION--',100A1)
        CALL DPWRST('XXX','BUG ')
 7859   CONTINUE
        GOTO7965
 7970   CONTINUE
        IP=IP+1
        ZIPARN(IP,L)=IHPARN
        ZPARN2(IP,L)=IHPAR2
        ZPARAM(IP,L)=VALUE(I2)
        GOTO7965
 7980   CONTINUE
        IV=IV+1
        ZIDUMV(IV,L)=IHPARN
        ZDUMV2(IV,L)=IHPAR2
        LOCDUM(IV,L)=IVALUE(I2)
        NIV(IV)=IN(I2)
        GOTO7965
 7965   CONTINUE
        NUMPAZ(L)=IP
        NUMVAZ(L)=IV
C
C               *******************************************
C               **  STEP 10--                            **
C               **  CHECK FOR A VALID NUMBER             **
C               **  OF INDEPENDENT VARIABLES (1 TO 20).  **
C               **  CHECK THE VALIDITY OF EACH           **
C               **  OF THE INDEPENDENT VARIABLES.        **
C               **  DOES THE NAME EXIST IN THE TABLE?    **
C               **  DOES THE NUMBER OF ELEMENTS          **
C               **  AGREE WITH THE NUMBER OF ELEMENTS    **
C               **  IN THE RESPONSE VARIABLE?            **
C               *******************************************
C
        ISTEPN='10'
        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        IF(NUMVAZ(L).GE.1.AND.NUMVAZ(L).LE.MAXV2)GOTO520
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4251)
 4251   FORMAT('***** ERROR IN DPORTH--FOR AN ORTHOGONAL DISTANCE FIT')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4253)
 4253   FORMAT('      THE NUMBER OF INDEPENDENT VARIABLES MUST BE AT')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4254)MAXV2
 4254   FORMAT('      LEAST 1 AND AT MOST ',I8,'  ;  SUCH WAS NOT THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4256)L
 4256   FORMAT('      THE CASE HERE.  FOR FUNCTION ',I5,' THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4257)NUMVAZ(L)
 4257   FORMAT('        SPECIFIED NUMBER OF INDEPENDENT VARIABLES WAS ',
     1       I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4258)
 4258   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,4259)(IANS(I),I=1,MIN(100,IWIDTH))
 4259     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4267)NUMCHZ(L)
 4267   FORMAT('      NUMBER OF CHARACTERS IN MODEL = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4268)(ZMODEL(JJ,L),JJ=1,MIN(100,NUMCHZ(L)))
 4268   FORMAT('      MODEL--',100A1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4264)
 4264   FORMAT('      VARIABLES EXTRACTED FROM MODEL--')
        CALL DPWRST('XXX','BUG ')
        DO4265JJ=1,NUMVAZ(L)
        WRITE(ICOUT,4266)JJ,ZIDUMV(JJ,L),ZDUMV2(JJ,L),LOCDUM(JJ,L)
 4266   FORMAT('I,IVARN3(I),IVARN4(I),ICOLV3(I) = ',I8,2X,A4,A4,2X,I8)
        CALL DPWRST('XXX','BUG ')
 4265   CONTINUE
        IERROR='YES'
        GOTO9000
C
  520   CONTINUE
        IF(IMPFLG.EQ.'ON')THEN
          NTEMP=NIV(1)
          DO542JJ=1,NUMVAZ(L)
            IF(NIV(JJ).NE.NTEMP)GOTO545
  542     CONTINUE
          GOTO590
        ELSE
          NTEMP=NLEFT
          DO540JJ=1,NUMVAZ(L)
            IF(NIV(JJ).NE.NTEMP)GOTO560
  540     CONTINUE
          GOTO590
        ENDIF
C
  545   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,546)
  546   FORMAT('***** ERROR IN DPORTH--FOR AN IMPLICIT ORTHOGONAL ',
     1         'DISTANCE FIT, THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,547)
  547   FORMAT('      NUMBER OF ELEMENTS IN EACH INDEPENDENT ',
     1       'VARIABLE SHOULD BE THE SAME.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,548)NTEMP
  548   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,549)
  549   FORMAT('      INDEPENDENT VARIABLES           --')
        CALL DPWRST('XXX','BUG ')
        DO550JJ=1,NUMVAZ(L)
          WRITE(ICOUT,552)ZIDUMV(JJ,L),ZDUMV2(JJ,L),NIV(JJ)
  552   FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
        CALL DPWRST('XXX','BUG ')
  550   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,554)
  554   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,556)(IANS(I),I=1,MIN(100,IWIDTH))
  556     FORMAT(100A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
C
  560   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,561)
  561   FORMAT('***** ERROR IN DPORTH--FOR AN ORTHOGONAL DISTANCE ',
     1       'FIT, THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,564)
  564   FORMAT('      NUMBER OF ELEMENTS IN EACH INDEPENDENT VARIABLE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,565)
  565   FORMAT('      SHOULD BE THE SAME AS THE NUMBER OF ELEMENTS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,566)
  566   FORMAT('      IN THE DEPENDENT VARIABLE (RESPONSE);  SUCH WAS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,571)
  571   FORMAT('      NOT THE CASE HERE.  DEPENDENT VARIABLE ',
     1         '(RESPONSE)--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,572)IHLEFT,IHLEF2,NLEFT
  572   FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,576)
  576   FORMAT('      INDEPENDENT VARIABLES           --')
        CALL DPWRST('XXX','BUG ')
        DO580JJ=1,NUMVAZ(L)
        WRITE(ICOUT,578)ZIDUMV(JJ,L),ZDUMV2(JJ,L),NIV(JJ)
  578   FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
        CALL DPWRST('XXX','BUG ')
  580   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,587)
  587   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,588)(IANS(I),I=1,MIN(100,IWIDTH))
  588     FORMAT(100A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
C
  590   CONTINUE
C
C  UPDATE PARAMETER AND VARIABLE NAME LIST
C
        IF(L.EQ.1)THEN
          DO4481JJ=1,NUMPAZ(1)
            IPARN3(JJ)=ZIPARN(JJ,1)
            IPARN4(JJ)=ZPARN2(JJ,1)
            PARAM3(JJ)=ZPARAM(JJ,1)
 4481     CONTINUE
C
          DO4483JJ=1,NUMVAZ(1)
            IVARN3(JJ)=ZIDUMV(JJ,1)
            IVARN4(JJ)=ZDUMV2(JJ,1)
            ICOLV3(JJ)=LOCDUM(JJ,1)
 4483     CONTINUE
          NUMPAR=NUMPAZ(1)
          NUMVAR=NUMVAZ(1)
        ELSE
          DO4491JJ=1,NUMPAZ(L)
            DO4493KK=1,NUMPAR
              IF(ZIPARN(KK,L).EQ.IPARN3(KK).AND.
     1           ZPARN2(KK,L).EQ.IPARN4(KK))GOTO4494
 4493       CONTINUE
            NUMPAR=NUMPAR+1
            IPARN3(NUMPAR)=ZIPARN(JJ,L)
            IPARN4(NUMPAR)=ZPARN2(JJ,L)
            PARAM3(NUMPAR)=ZPARAM(JJ,L)
 4494     CONTINUE
 4491     CONTINUE
C
          DO4495JJ=1,NUMVAZ(L)
            DO4496KK=1,NUMVAR
              IF(ZIDUMV(KK,L).EQ.IVARN3(KK).AND.
     1           ZDUMV2(KK,L).EQ.IVARN4(KK))GOTO4497
 4496       CONTINUE
            NUMVAR=NUMVAR+1
            IVARN3(NUMVAR)=ZIDUMV(JJ,L)
            IVARN4(NUMVAR)=ZDUMV2(JJ,L)
            ICOLV3(NUMVAR)=LOCDUM(JJ,L)
 4497     CONTINUE
 4495     CONTINUE
        ENDIF
C
 4499 CONTINUE
C
      DO4498JJ=1,NUMVAR
        IPARN3(NUMPAR+JJ)=IVARN3(JJ)
        IPARN4(NUMPAR+JJ)=IVARN4(JJ)
 4498 CONTINUE
C
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  CHECK FOR ADEQUATE AMOUNT OF SCRATCH SPACE      **
C               ******************************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      M=NUMVAR
      NP=NUMPAR
      N=NLEFT
      IF(IMPFLG.EQ.'ON')THEN
        N=NIV(1)
      ENDIF
C
      IREQ=18 + 11*NP + NP**2 + M + M**2 + 4*N*NQ + 6*N*M +
     1     2*N*NQ*M + 2*N*NQ*NP + NQ**2 + 5*NQ + NQ*(NP+M) + (N*1)*NQ
      LWORK=46*MAXOBV/2
      IF(IREQ.GT.LWORK)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,591)
  591   FORMAT('***** ERROR FROM DPORTH--NOT ENOUGH SCRATCH STORAGE',
     1         ' AVAILABLE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,593)IREQ,LWORK
  593   FORMAT('      AVAILABLE STORAGE = ',I8,' AND REQUIRED ',
     1         'STORAGE = ',I8,'.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,595)
  595   FORMAT('      REMEDY: REDUCE EITHER THE NUMBER OF VARIABLES')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,597)
  597   FORMAT('      OR THE NUMBER OF OBSERVATIONS IN THE MODEL.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ******************************************************
C               **  STEP 11B--                                      **
C               **  CHECK DELTA WEIGHT VARIABLES FOR APPROPRIATE    **
C               **  SIZES.  (IF NOT EQUAL 'OFF').  CASES:           **
C               **  1) IF MORE THAN ONE VARIABLE, THEN SIZE OF EACH **
C               **     VARIABLE MUST EQUAL SIZE OF RESPONSE VARIABLE**
C               **  2) IF EXACTLY ONE VARIABLE, THEN CHECK          **
C               **     VARIABLE MUST EQUAL SIZE OF RESPONSE VARIABLE**
C               **     OR EQUAL NUMBER OF INDEPENDENT VARIABLES     **
C               ******************************************************
C
      ISTEPN='11B'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IDLFLG.EQ.'OFF' .OR. IDLFLG.EQ.'DEFA')GOTO729
C
      IF(NUMDEL.EQ.1)THEN
        IF(NDELTA(1).EQ.N .OR. NDELTA(1).EQ.M)GOTO729
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,711)
  711   FORMAT('***** ERROR FROM DPORTH--IF EXACTLY ONE DELTA ',
     1         'VARIABLE SPECIFIED,')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,713)
  713   FORMAT('      THE NUMBER OF ELEMENTS MUST EQUAL EITHER THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,715)N
  715   FORMAT('      NUMBER OF ELEMENTS IN THE RESPONSE VARIABLE (',
     1         I8,')')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,717)M
  717   FORMAT('      OR THE NUMBER OF RESPONSE VARIABLES (',I8,').')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,719)IODRD1(1),IODRD2(1),NDELTA(1)
  719   FORMAT('      DELTA VARIABLE ',A4,A4,' HAS ',I8,' ELEMENTS.')
        IERROR='YES'
        GOTO9000
      ELSEIF(NUMDEL.GT.1)THEN
        DO720JJ=1,NUMDEL
          NTEMP=NLEFT
          IF(IMPFLG.EQ.'ON')NTEMP=NIV(1)
          IF(NDELTA(JJ).NE.NTEMP)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,721)IODRD1(JJ),IODRD2(JJ),NDELTA(JJ)
  721       FORMAT('***** ERROR IN DPORTH--DELTA VARIABLE ',A4,A4,
     1             ' HAS ',I8,' ELEMENTS.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,722)
  722       FORMAT('      HOWEVER, IT SHOULD HAVE THE SAME NUMBER OF ',
     1             'ELEMENTS AS THE')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,723)N
  723       FORMAT('      INDEPENDENT VARIABLE(S).')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,725)IVARN3(1),IVARN4(1),NTEMP
  725       FORMAT('      FIRST INDEPENDENT VARIABLE ',
     1             A4,A4,'  HAS ',I8,' ELEMENTS')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,727)
  727       FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
            CALL DPWRST('XXX','BUG ')
            IF(IWIDTH.GE.1)THEN
              WRITE(ICOUT,728)(IANS(I),I=1,MIN(100,IWIDTH))
  728         FORMAT(100A1)
              CALL DPWRST('XXX','BUG ')
            ENDIF
            IERROR='YES'
            GOTO9000
          ENDIF
  720   CONTINUE
      ELSE
        GOTO729
      ENDIF
C
  729 CONTINUE
C
C               ******************************************************
C               **  STEP 11C--                                      **
C               **  CHECK DELTA FIXED  VARIABLES FOR APPROPRIATE    **
C               **  SIZES.  (IF NOT EQUAL 'OFF').  CASES:           **
C               **  1) IF MORE THAN ONE VARIABLE, THEN SIZE OF EACH **
C               **     VARIABLE MUST EQUAL SIZE OF RESPONSE VARIABLE**
C               **  2) IF EXACTLY ONE VARIABLE, THEN CHECK          **
C               **     VARIABLE MUST EQUAL SIZE OF RESPONSE VARIABLE**
C               **     OR EQUAL NUMBER OF INDEPENDENT VARIABLES     **
C               ******************************************************
C
      ISTEPN='11C'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IODRE1(1).EQ.'OFF' .OR. NUMERR.EQ.0)GOTO749
C
      IF(NUMERR.EQ.1)THEN
        IF(NERROR(1).EQ.N .OR. NERROR(1).EQ.M)GOTO749
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,731)
  731   FORMAT('***** ERROR FROM DPORTH--IF EXACTLY ONE ERROR ',
     1         'VARIABLE SPECIFIED,')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,733)
  733   FORMAT('      THE NUMBER OF ELEMENTS MUST EQUAL EITHER THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,735)N
  735   FORMAT('      NUMBER OF ELEMENTS IN THE RESPONSE VARIABLE (',
     1         I8,')')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,737)M
  737   FORMAT('      OR THE NUMBER OF RESPONSE VARIABLES (',I8,').')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,739)IODRE1(1),IODRE2(1),NERROR(1)
  739   FORMAT('      ERROR VARIABLE ',A4,A4,' HAS ',I8,' ELEMENTS.')
        IERROR='YES'
        GOTO9000
      ELSEIF(NUMERR.GT.1)THEN
        DO740JJ=1,NUMERR
          NTEMP=NLEFT
          IF(IMPFLG.EQ.'ON')NTEMP=NIV(1)
          IF(NERROR(JJ).NE.NTEMP)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,741)IODRE1(JJ),IODRE2(JJ),NDELTA(JJ)
  741       FORMAT('***** ERROR IN DPORTH--ERROR VARIABLE ',A4,A4,
     1             ' HAS ',I8,' ELEMENTS.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,742)
  742       FORMAT('      HOWEVER, IT SHOULD HAVE THE SAME NUMBER OF ',
     1             'ELEMENTS AS THE')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,743)N
  743       FORMAT('      INDEPENDENT VARIABLE(S).')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,745)IVARN3(1),IVARN4(1),NTEMP
  745       FORMAT('      FIRST INDEPENDENT VARIABLE ',
     1             A4,A4,'  HAS ',I8,' ELEMENTS')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,747)
  747       FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
            CALL DPWRST('XXX','BUG ')
            IF(IWIDTH.GE.1)THEN
              WRITE(ICOUT,748)(IANS(I),I=1,MIN(100,IWIDTH))
  748         FORMAT(100A1)
              CALL DPWRST('XXX','BUG ')
            ENDIF
            IERROR='YES'
            GOTO9000
          ENDIF
  740   CONTINUE
      ELSE
        GOTO749
      ENDIF
C
  749 CONTINUE
C
C               ******************************************************
C               **  STEP 11D--                                      **
C               **  CHECK DELTA STARTING VALUE VARIABLES FOR        **
C               **  APPROPRIATE SIZES.  (IF NOT EQUAL 'OFF').       **
C               ******************************************************
C
      ISTEPN='11D'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IODRD3(3).EQ.'OFF')GOTO779
      IF(IODRD3(3).EQ.'ON')GOTO779
      IF(NUMDE2.LT.1)GOTO779
C
      NTEMP=NLEFT
      IF(IMPFLG.EQ.'ON')NTEMP=NIV(1)
      DO770J=1,NUMDE2
        IF(NDELT2(J).NE.NTEMP)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,771)
  771     FORMAT('***** ERROR IN DPORTH--DELTA STARTING VALUE ',
     1             'VARIABLE ',A4,A4,' HAS ',I8,' ELEMENTS.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,772)
  772     FORMAT('      HOWEVER, IT SHOULD HAVE THE SAME NUMBER OF ',
     1           'ELEMENTS AS THE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,773)N
  773     FORMAT('      INDEPENDENT VARIABLE(S).')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,775)IVARN3(1),IVARN4(1),NTEMP
  775     FORMAT('      FIRST INDEPENDENT VARIABLE ',
     1           A4,A4,'  HAS ',I8,' ELEMENTS')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,777)
  777     FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,778)(IANS(I),I=1,MIN(100,IWIDTH))
  778       FORMAT(100A1)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
        ENDIF
  770 CONTINUE
C
  779 CONTINUE
C
C               *****************************************************
C               **  STEP 12--                                      **
C               **  BRANCH TO THE APPROPRIATE SUBCASE; THEN        **
C               **  COPY OVER THE RESPONSE VECTOR TO BE USED IN    **
C               **  THE MODEL INTO THE VECTOR Y; AND               **
C               **  COPY OVER THE WEIGHTS INTO THE VECTOR W; COPY  **
C               **  OVER THE VECTORS THAT WERE USED IN THE MODEL   **
C               **  INTO XMAT, COPY OVER THE DELTAS INTO RHO, AND  **
C               **  THE ERROR VARIABLE INTO IFIX.                  **
C               *****************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')WRITE(ICOUT,601)N,NUMVAR
  601 FORMAT('N,NUMVAR = ',2I8)
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')CALL DPWRST('XXX','BUG ')
C
      NTEMP=NLEFT
      IF(IMPFLG.EQ.'ON')NTEMP=NIV(1)
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NTEMP
      ISUB(I)=1
  615 CONTINUE
      NQZ=NTEMP
      GOTO650
C
  620 CONTINUE
      NIOLD=NTEMP
      CALL DPSUB2(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQZ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NTEMP
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQZ=NFOR
      GOTO650
C
  650 CONTINUE
      IF(IMPFLG.NE.'ON')THEN
        K=ICOLL
        J=0
        LDX=0
        DO4500I=1,NTEMP
          IF(ISUB(I).EQ.0)GOTO4500
          LDX=LDX+1
          J=J+1
          IJ=MAXN*(K-1)+I
          IF(K.LE.MAXCOL)YTEMP(J)=V(IJ)
          IF(K.EQ.MAXCP1)YTEMP(J)=PRED(I)
          IF(K.EQ.MAXCP2)YTEMP(J)=RES(I)
          IF(K.EQ.MAXCP3)YTEMP(J)=YPLOT(I)
          IF(K.EQ.MAXCP4)YTEMP(J)=XPLOT(I)
          IF(K.EQ.MAXCP5)YTEMP(J)=X2PLOT(I)
          IF(K.EQ.MAXCP6)YTEMP(J)=TAGPLO(I)
 4500   CONTINUE
        IF(NQ.GT.1)THEN
          IF(NQ*LDX.GT.MAXOB2)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4511)NQ*LDX
 4511       FORMAT('***** ERROR IN DPORTH--TOTAL NUMBER OF RESPONSE ',
     1             'VALUES (= ',I8,')')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4513)MAXOB2
 4513       FORMAT('      EXCEEDS THE MAXIMUM ALLOWED OF (',I8,').')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
          DO4505JJ=2,NQ
            J=(JJ-1)*LDX
            K=ICOLRV(JJ)
            DO4508I=1,NTEMP
              IF(ISUB(I).EQ.0)GOTO4508
              J=J+1
              IJ=MAXN*(K-1)+I
              IF(K.LE.MAXCOL)YTEMP(J)=V(IJ)
              IF(K.EQ.MAXCP1)YTEMP(J)=PRED(I)
              IF(K.EQ.MAXCP2)YTEMP(J)=RES(I)
              IF(K.EQ.MAXCP3)YTEMP(J)=YPLOT(I)
              IF(K.EQ.MAXCP4)YTEMP(J)=XPLOT(I)
              IF(K.EQ.MAXCP5)YTEMP(J)=X2PLOT(I)
              IF(K.EQ.MAXCP6)YTEMP(J)=TAGPLO(I)
 4508       CONTINUE
 4505     CONTINUE
        ENDIF
      ELSE
        LDX=0
        DO4501I=1,NTEMP
          IF(ISUB(I).EQ.0)GOTO4501
          LDX=LDX+1
          J=J+1
          YTEMP(J)=0.0D0
 4501   CONTINUE
      ENDIF
C
      IF(IMPFLG.NE.'ON')THEN
        W(1)=-1.0D0
        K=ICOLWR(1)
        J=0
        DO4580I=1,NTEMP
          IF(ISUB(I).EQ.0)GOTO4580
          J=J+1
          IF(K.LE.0)THEN
            W(J)=-1.0D0
          ELSE
            IJ=MAXN*(K-1)+I
            IF(K.LE.MAXCOL)W(J)=V(IJ)
            IF(K.EQ.MAXCP1)W(J)=PRED(I)
            IF(K.EQ.MAXCP2)W(J)=RES(I)
            IF(K.EQ.MAXCP3)W(J)=YPLOT(I)
            IF(K.EQ.MAXCP4)W(J)=XPLOT(I)
            IF(K.EQ.MAXCP5)W(J)=X2PLOT(I)
            IF(K.EQ.MAXCP6)W(J)=TAGPLO(I)
          ENDIF
 4580   CONTINUE
        IF(NQ.GT.1)THEN
          DO4585JJ=2,NQ
            J=(JJ-1)*LDX
            K=ICOLWR(JJ)
            DO4588I=1,NTEMP
              IF(ISUB(I).EQ.0)GOTO4588
              J=J+1
              IF(K.LE.0)THEN
                W(J)=1.0
              ELSE
                IJ=MAXN*(K-1)+I
                IF(K.LE.MAXCOL)W(J)=V(IJ)
                IF(K.EQ.MAXCP1)W(J)=PRED(I)
                IF(K.EQ.MAXCP2)W(J)=RES(I)
                IF(K.EQ.MAXCP3)W(J)=YPLOT(I)
                IF(K.EQ.MAXCP4)W(J)=XPLOT(I)
                IF(K.EQ.MAXCP5)W(J)=X2PLOT(I)
                IF(K.EQ.MAXCP6)W(J)=TAGPLO(I)
              ENDIF
 4588       CONTINUE
 4585     CONTINUE
        ENDIF
      ELSE
        W(1)=-1.0D0
      ENDIF
C
      LDIFX=1
      IF(IODRE1(1).EQ.'OFF')THEN
        DO381J=1,M
          IFIX(J)=0
  381   CONTINUE
      ELSEIF(IODRE1(1).EQ.'ON')THEN
        DO382J=1,M
          IFIX(J)=1
  382   CONTINUE
      ELSEIF(NUMERR.GE.1 .AND. NERROR(1).EQ.N)THEN
        LDIFX=LDX
        DO4591L=1,NUMERR
          K=ICOLE(L)
          J=(L-1)*LDX
          DO4593I=1,NERROR(L)
            J=J+1
            IJ=MAXN*(K-1)+I
            IF(K.LE.MAXCOL)IFIX(J)=INT(ABS(V(IJ))+0.5)
            IF(K.EQ.MAXCP1)IFIX(J)=INT(ABS(PRED(I))+0.5)
            IF(K.EQ.MAXCP2)IFIX(J)=INT(ABS(RES(I))+0.5)
            IF(K.EQ.MAXCP3)IFIX(J)=INT(ABS(YPLOT(I))+0.5)
            IF(K.EQ.MAXCP4)IFIX(J)=INT(ABS(XPLOT(I))+0.5)
            IF(K.EQ.MAXCP5)IFIX(J)=INT(ABS(X2PLOT(I))+0.5)
            IF(K.EQ.MAXCP6)IFIX(J)=INT(ABS(TAGPLO(I))+0.5)
 4593     CONTINUE
 4591   CONTINUE
      ELSEIF(NUMERR.GE.1 .AND. NERROR(1).EQ.M)THEN
        LDIFX=1
        K=ICOLE(1)
        J=0
        DO4597I=1,NERROR(1)
          J=J+1
          IJ=MAXN*(K-1)+I
          IF(K.LE.MAXCOL)IFIX(J)=INT(ABS(V(IJ))+0.5)
          IF(K.EQ.MAXCP1)IFIX(J)=INT(ABS(PRED(I))+0.5)
          IF(K.EQ.MAXCP2)IFIX(J)=INT(ABS(RES(I))+0.5)
          IF(K.EQ.MAXCP3)IFIX(J)=INT(ABS(YPLOT(I))+0.5)
          IF(K.EQ.MAXCP4)IFIX(J)=INT(ABS(XPLOT(I))+0.5)
          IF(K.EQ.MAXCP5)IFIX(J)=INT(ABS(X2PLOT(I))+0.5)
          IF(K.EQ.MAXCP6)IFIX(J)=INT(ABS(TAGPLO(I))+0.5)
 4597   CONTINUE
      ELSE
        IFIX(1)=-1
        LDIFX=1
      ENDIF
C
      IF(NUMVAR.GE.1)THEN
        DO385L=1,NUMVAR
          K=ICOLV3(L)
          J=(L-1)*LDX
          DO386I=1,NTEMP
            IF(ISUB(I).EQ.0)GOTO386
            J=J+1
            IJ=MAXN*(K-1)+I
            IF(K.LE.MAXCOL)XMAT(J)=V(IJ)
            IF(K.EQ.MAXCP1)XMAT(J)=PRED(I)
            IF(K.EQ.MAXCP2)XMAT(J)=RES(I)
            IF(K.EQ.MAXCP3)XMAT(J)=YPLOT(I)
            IF(K.EQ.MAXCP4)XMAT(J)=XPLOT(I)
            IF(K.EQ.MAXCP5)XMAT(J)=X2PLOT(I)
            IF(K.EQ.MAXCP6)XMAT(J)=TAGPLO(I)
  386     CONTINUE
  385   CONTINUE
      ENDIF
      IF(IMPFLG.EQ.'ON')N=LDX
C
      IF(NUMDEL.GE.1.AND.NDELTA(1).EQ.N)THEN
        LDRHO=LDX
        DO395L=1,NUMDEL
          K=ICOLD(L)
          J=(L-1)*LDX
          DO396I=1,NTEMP
            IF(ISUB(I).EQ.0)GOTO396
            J=J+1
            IJ=MAXN*(K-1)+I
            IF(K.LE.MAXCOL)RHO(J)=V(IJ)
            IF(K.EQ.MAXCP1)RHO(J)=PRED(I)
            IF(K.EQ.MAXCP2)RHO(J)=RES(I)
            IF(K.EQ.MAXCP3)RHO(J)=YPLOT(I)
            IF(K.EQ.MAXCP4)RHO(J)=XPLOT(I)
            IF(K.EQ.MAXCP5)RHO(J)=X2PLOT(I)
            IF(K.EQ.MAXCP6)RHO(J)=TAGPLO(I)
  396     CONTINUE
  395   CONTINUE
      ELSEIF(NUMDEL.EQ.1.AND.NDELTA(1).EQ.M)THEN
        LDRHO=1
        J=0
        K=ICOLD(1)
        DO398I=1,M
          J=J+1
          IJ=MAXN*(K-1)+I
          IF(K.LE.MAXCOL)RHO(J)=V(IJ)
          IF(K.EQ.MAXCP1)RHO(J)=PRED(I)
          IF(K.EQ.MAXCP2)RHO(J)=RES(I)
          IF(K.EQ.MAXCP3)RHO(J)=YPLOT(I)
          IF(K.EQ.MAXCP4)RHO(J)=XPLOT(I)
          IF(K.EQ.MAXCP5)RHO(J)=X2PLOT(I)
          IF(K.EQ.MAXCP6)RHO(J)=TAGPLO(I)
  398   CONTINUE
        DO399I=M+1,N*M
          RHO(I)=0.0D0
  399   CONTINUE
      ELSE
        LDRHO=1
        RHO(1)=-1.0
      ENDIF
C
      IF(NUMDE2.GE.1.AND.(IODRD3(1).NE.'OFF'.AND.IODRD3(1).NE.'ON'))THEN
        DO405L=1,NUMDE2
          K=ICOLD2(L)
          J=(L-1)*LDX
          DO406I=1,NTEMP
            IF(ISUB(I).EQ.0)GOTO406
            J=J+1
            IJ=MAXN*(K-1)+I
            IF(K.LE.MAXCOL)WORK(J)=V(IJ)
            IF(K.EQ.MAXCP1)WORK(J)=PRED(I)
            IF(K.EQ.MAXCP2)WORK(J)=RES(I)
            IF(K.EQ.MAXCP3)WORK(J)=YPLOT(I)
            IF(K.EQ.MAXCP4)WORK(J)=XPLOT(I)
            IF(K.EQ.MAXCP5)WORK(J)=X2PLOT(I)
            IF(K.EQ.MAXCP6)WORK(J)=TAGPLO(I)
  406     CONTINUE
  405   CONTINUE
      ELSE
        DO408I=1,N*M
          WORK(I)=0.0D0
  408   CONTINUE
      ENDIF
C
C               ******************************************************
C               **  STEP 13--                                       **
C               **  PREPARE FOR ENTRANCE INTO DPORTH2               **
C               **  SET THE ICON3 VECTOR                            **
C               **  (WHICH INDICATES WHICH PARAMETERS ARE TO BE HELD**
C               **  CONSTANT) EQUAL TO 0 THROUGHOUT.                **
C               **  DEFINE CONSTRAINTS AND LIMITS.                  **
C               ******************************************************
C
      ISTEPN='13'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO4195I=1,NUMPAR
      ICON3(I)=0
 4195 CONTINUE
C
      IF(NUMCON.EQ.0)GOTO4890
      DO4700I=1,NUMPAR
      DO4800J=1,NUMCON
      J2=J
      IF(IPARN3(I).EQ.IPARNC(J).AND.IPARN4(I).EQ.IPANC2(J))GOTO4810
 4800 CONTINUE
      IPARO3(I)='NONE'
      GOTO4700
 4810 CONTINUE
      IPARO3(I)=IPAROC(J2)
      PARLI3(I)=PARLIM(J2)
 4700 CONTINUE
 4890 CONTINUE
C
C               ******************************************************
C               **  STEP 14--                                       **
C               **  CARRY OUT THE ACTUAL FIT                        **
C               **  VIA CALLING                                     **
C               **  DPORTH2 (FOR GENERAL MODELS), OR                **
C               ******************************************************
C
      ISTEPN='14'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IBUGAZ=IBUGA3
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'ORTH')GOTO6099
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6081)
 6081 FORMAT('***** FROM DPORTH, AS ABOUT TO CALL DPORT2--')
      CALL DPWRST('XXX','BUG ')
      DO6083I=1,NS
      WRITE(ICOUT,6084)I,Y(I),XMAT(I),W(I),RHO(I),IFIX(I)
 6084 FORMAT('I,Y(I),XMAT(I),W(I) = ',I6,2X,4F10.5,2X,I6)
      CALL DPWRST('XXX','BUG ')
 6083 CONTINUE
      DO6185L=1,MAX(NQ,1)
      WRITE(ICOUT,6082)NUMCHZ(L),NLEFT,MAXN,NS,NUMPAZ(L),NUMVAZ(L)
 6082 FORMAT('NUMCHA,NLEFT,MAXN,NS,NUMPAR,NUMVAR = ',7I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6187)L,NUMCHZ(L)
 6187 FORMAT('L,NUMCHZ(L) = ',I5,I5)
      WRITE(ICOUT,6085)(ZMODEL(I,L),I=1,MIN(120,NUMCHZ(L)))
 6085 FORMAT('MODEL(.)--',120A1)
      CALL DPWRST('XXX','BUG ')
 6185 CONTINUE
      DO6286L=1,MAX(NQ,1)
      DO6086J=1,NUMPAZ(L)
      WRITE(ICOUT,6087)J,ZIPARN(J,L),ZPARN2(J,L),PARAM3(J),ICON3(J)
 6087 FORMAT('I,ZIPARN(I),ZPARN2(I),PARAM3(I),ICON3(I) = ',
     1I8,2X,A4,A4,E15.7,A4)
      CALL DPWRST('XXX','BUG ')
 6086 CONTINUE
      DO6088J=1,NUMVAZ(L)
      WRITE(ICOUT,6089)J,ZIDUMV(J,L),ZDUMV2(J,L),LOCDUM(J,L)
 6089 FORMAT('I,ZIDUMV(I,L),ZDUMV2(I,L),LOCDUM(I,L) = ',
     1       I8,2X,A4,A4,2X,I8)
      CALL DPWRST('XXX','BUG ')
 6088 CONTINUE
 6286 CONTINUE
      WRITE(ICOUT,6091)IBUGA3,IBUGCO,IBUGEV,NUMIND
 6091 FORMAT('IBUGA3,IBUGCO,IBUGEV,NUMIND = ',A4,2X,A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 6099 CONTINUE
C
 6520 CONTINUE
C
      LIWORK=MAXOBV
C
      CALL DPORT2(YTEMP,N,XMAT,LDX,RHO,LDRHO,IFIX,LDIFX,NP,M,NQ,
     1WORK,LWORK,IWORK,LIWORK,W,
     1PARAM3,IPARN3,IPARN4,MAXITS,
     1IREP,REPSD,REPDF,RESSD,RESDF,PRED2,RES2,ALFCDF,
     1PODRTF,PODRST,PODRPT,IODRPO,IODRE1,
     1IMPFLG,
     1IBUGA3,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GOTO6590
C
 6590 CONTINUE
C
C               ***************************************
C               **  STEP 15--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
 7000 CONTINUE
C
      ISTEPN='15'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOLPR=MAXCP1
      ICOLRE=MAXCP2
      IREPU='OFF'
      IRESU='ON'
      REPSD=0.0
      REPDF=0.0
C
      CALL UPDAPR(ICOLPR,ICOLRE,PRED2,RES2,PRED,RES,ISUB,NLEFT,
     1IREPU,REPSD,REPDF,IRESU,RESSD,RESDF,ALFCDF,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,ILOCN,IBUGA3,IERROR)
C
 7900 CONTINUE
C
C               *************************************************
C               **  STEP 17--                                  **
C               **  COPY THE FINAL ESTIMATES FROM THE FIT      **
C               **  BACK INTO THE PARAMETERS.                  **
C               **  THESE FINAL ESTIMATES WILL THUS OVERWRITE  **
C               **  THE STARTING VALUES THAT WERE              **
C               **  ORIGINALLY ASSIGNED TO THE PARAMETERS.     **
C               *************************************************
C
 6000 CONTINUE
C
      ISTEPN='17'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ORTH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMPAR.LE.0)GOTO6190
      DO6100J=1,NUMPAR
      IH=IPARN3(J)
      IH2=IPARN4(J)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      VALUE(ILOCP)=PARAM3(J)
 6100 CONTINUE
 6190 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'ORTH')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPORTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NS,ICASFI
 9015 FORMAT('NS,ICASFI = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NUMNAM
 9016 FORMAT('NUMNAM = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9017I=1,NUMNAM
      WRITE(ICOUT,9018)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I),
     1VALUE(I)
 9018 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I)',
     1'VALUE(I) = ',I8,2X,A4,A4,2X,A4,I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9017 CONTINUE
 9042 CONTINUE
 9049 CONTINUE
      WRITE(ICOUT,9051)MAXN2,NLEFT,NS,V(1),PRED(1),RES(1)
 9051 FORMAT('MAXN2,NLEFT,NS,V(1),PRED(1),RES(1) = ',3I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)ICASEQ
 9052 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9053)ICOLW,NWEIGH,IWEIGH
 9053 FORMAT('ICOLW,NWEIGH,IWEIGH = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9061)IWIDTH
 9061 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,9062)(IANS(I),I=1,IWIDTH)
 9062   FORMAT('(IANS(I),I=1,IWIDTH) = ',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      WRITE(ICOUT,9069)IFOUND,IERROR
 9069 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPORT2(Y,N,XMAT,LDX,RHO,LDRHO,IFIX,LDIFX,NP,M,NQ,
     1WORK,LWORK,IWORK,LIWORK,W,
     1PARAM3,IPARN3,IPARN4,MAXITS,
     1IREP,REPSD,REPDF,RESSD,RESDF,PRED2,RES2,ALFCDF,
     1PODRTF,PODRST,PODRPT,IODRPO,IODRE1,
     1IMPFLG,
     1IBUGA3,ISUBRO,IERROR)
C
C     USE ODRPACK TO COMPUTE ORTHOGONAL DISTANCE REGRESSION (ALSO
C     CALLED ERRORS IN VARIABLES REGRESSION).
C
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     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2001/4
C     ORIGINAL VERSION--APRIL     2001.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IODRE1(*)
      CHARACTER*4 IODRPO
      CHARACTER*4 IREP
      CHARACTER*4 IMPFLG
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IERRF1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
C
      CHARACTER*80 IFILE2
      CHARACTER*12 ISTAT2
      CHARACTER*12 IFORM2
      CHARACTER*12 IACCE2
      CHARACTER*12 IPROT2
      CHARACTER*12 ICURS2
      CHARACTER*4 IERRF2
      CHARACTER*4 IENDF2
      CHARACTER*4 IREWI2
C
      CHARACTER*80 IFILE3
      CHARACTER*12 ISTAT3
      CHARACTER*12 IFORM3
      CHARACTER*12 IACCE3
      CHARACTER*12 IPROT3
      CHARACTER*12 ICURS3
      CHARACTER*4 IERRF3
      CHARACTER*4 IENDF3
      CHARACTER*4 IREWI3
C
      CHARACTER*80 IFILE4
      CHARACTER*12 ISTAT4
      CHARACTER*12 IFORM4
      CHARACTER*12 IACCE4
      CHARACTER*12 IPROT4
      CHARACTER*12 ICURS4
      CHARACTER*4 IERRF4
      CHARACTER*4 IENDF4
      CHARACTER*4 IREWI4
C
      CHARACTER*4 ISUBN0
C
C---------------------------------------------------------------------
C
      INTEGER N, NQ, M, NP
C
      INTEGER IFIXB(1)
      INTEGER IFIX(LDIFX,M)
      INTEGER IWORK(*)
C
      DOUBLE PRECISION SCLD(1,1)
      DOUBLE PRECISION SCLB(1)
      DOUBLE PRECISION STPB(1)
      DOUBLE PRECISION STPD(1,1)
      DOUBLE PRECISION BETA(100)
      DOUBLE PRECISION TAUFAC
      DOUBLE PRECISION SSTOL
      DOUBLE PRECISION PARTOL
C
      DOUBLE PRECISION XMAT(LDX,M)
      DOUBLE PRECISION RHO(LDRHO,1,M)
      DOUBLE PRECISION WORK(*)
      DOUBLE PRECISION Y(N,NQ)
      DOUBLE PRECISION W(N,1,NQ)
      REAL PRED2(*)
      REAL RES2(*)
C
      INTEGER DELTAI, EPSI, XPLUSI, FNI, SDI, VCVI
      INTEGER RVARI, WSSI, WSSDEI, WSSEPI, RCONDI, ETAI
      INTEGER OLMAVI, TAUI, ALPHAI, ACTRSI, PNORMI, RNORSI, PRERSI
      INTEGER PARTLI, SSTOLI, TAUFCI, EPSMAI
      INTEGER BETA0I, BETACI, BETASI, BETANI, SI, SSI, SSFI, QRAUXI, UI
      INTEGER FSI, FJACBI, WE1I, DIFFI
      INTEGER DELTSI, DELTNI, TI, TTI, OMEGAI, FJACDI
      INTEGER WRK1I, WRK2I, WRK3I, WRK4I, WRK5I, WRK6I, WRK7I
      INTEGER LWKMN
C
      INTEGER
     1    MSGBI, MSGDI, IFIX2I, ISTOPI,
     1    NNZWI, NPPI, IDFI,
     1    JOBI, IPRINI, LUNERI, LUNRPI,
     1    NROWI, NTOLI, NETAI,
     1    MAXITI, NITERI, NFEVI, NJEVI, INT2I, IRANKI, LDTTI,
     1    LIWKMN
C
      INTEGER LDRHO, LD2WD, LDWE, LD2WE
C
      LOGICAL ISODR
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOF2.INC'
C
      CHARACTER*4 IPARN3
      CHARACTER*4 IPARN4
      DIMENSION IPARN3(*)
      DIMENSION IPARN4(*)
      DIMENSION PARAM3(*)
C
      EXTERNAL FUN
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='DPOR'
      ISUBN2='T2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'ORT2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPORT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)N,NP,M,NQ
   52 FORMAT('N,NP,M,NQ = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)LDX,LDIFX,LDRHO
   53 FORMAT('LDX,LDIFX,LDRHO = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,N
      WRITE(ICOUT,56)I,Y(I,1),XMAT(I,1),RHO(I,1,1),W(I,1,1)
   56 FORMAT('I,Y(I,1),XMAT(I,1),RHO(I,1,1),W(I,1) = ',
     1       I5,4G15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      DO63J=1,MAX(LDIFX,M)
      WRITE(ICOUT,64)J,(IFIX(J,L),L=1,M)
   64 FORMAT('I,IFIX(I,L),L=1,M) = ',20I3)
      CALL DPWRST('XXX','BUG ')
   63 CONTINUE
      DO76J=1,N*M
      WRITE(ICOUT,77)J,WORK(J)
   77 FORMAT('J,WORK(J) =',I8,G15.7)
      CALL DPWRST('XXX','BUG ')
   76 CONTINUE
   90 CONTINUE
C
C               **************************************************
C               **  STEP 0.5--                                  **
C               **   OPEN THE STORAGE FILES                     **
C               **************************************************
C
      ISTEPN='0.5'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'FIT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='FIT2'
      IERRF1='NO'
C
      IREWI1='ON'
      CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IOUNI2=IST2NU
      IFILE2=IST2NA
      ISTAT2=IST2ST
      IFORM2=IST2FO
      IACCE2=IST2AC
      IPROT2=IST2PR
      ICURS2=IST2CS
      ISUBN0='FIT2'
      IERRF2='NO'
C
      IREWI2='ON'
      CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IOUNI3=IST3NU
      IFILE3=IST3NA
      ISTAT3=IST3ST
      IFORM3=IST3FO
      IACCE3=IST3AC
      IPROT3=IST3PR
      ICURS3=IST3CS
      ISUBN0='ORT2'
      IERRF3='NO'
C
      IREWI3='ON'
      CALL DPOPFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1IREWI3,ISUBN0,IERRF3,IBUGA3,ISUBRO,IERROR)
      IF(IERRF3.EQ.'YES')GOTO9000
C
      IOUNI4=IST4NU
      IFILE4=IST4NA
      ISTAT4=IST4ST
      IFORM4=IST4FO
      IACCE4=IST4AC
      IPROT4=IST4PR
      ICURS4=IST4CS
      ISUBN0='ORT2'
      IERRF4='NO'
C
      IREWI4='ON'
      CALL DPOPFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1IREWI4,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
      IF(IERRF4.EQ.'YES')GOTO9000
C
C               *****************************************************
C               **  STEP 2--                                       **
C               **  DEFINE NEED VALUES AND THEN CALL ODRPACK       **
C               **  DRIVER ROUTINE (DODRC).                        **
C               **  INITIALIZE VALUES THAT USE DEFAULT VALUES.     **
C               *****************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'ORT2')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C  DEFINE STARTING VALUES FOR FUNCTION PARAMETERS
      DO110I=1,MIN(NP,100)
        BETA(I)=DBLE(PARAM3(I))
  110 CONTINUE
      LDNP=NP
C
C  DEPENDENT AND EXPLANATORY VARIABLES
      LDY=LDX
      LDN=LDX
C
C  WEIGHTS
      LDWE=LDY
      IF(IMPFLG.EQ.'ON')THEN
        LDWE=1
        W(1,1,1)=-1.0D0
      ENDIF
      LD2WE=1
      LD2WD=1
C
C  PARAMETER AND VARIABLE FIXING
      IFIXB(1)=-1
C
C  COMPUTATION AND INITIALIZATION CONTROL
      ISODR=.TRUE.
      IF(IMPFLG.EQ.'ON')THEN
        IDIG1=1
      ELSE
        IDIG1=0
        IF(IODRE1(1).EQ.'OFF')THEN
          IDIG1=2
          ISODR=.FALSE.
        ENDIF
      ENDIF
      IDIG2=1
      IF(IMPFLG.EQ.'ON')IDIG2=0
      IDIG3=0
      IDIG4=0
      IF(WORK(1).NE.0.0D0)IDIG4=1
      IDIG5=0
      JOB=IDIG1 + 10*IDIG2 + 100*IDIG3 + 1000*IDIG4 + 10000*IDIG5
      NDIGIT=-1
      TAUFAC=PODRTF
C
C  STOPPING CRITIERION
      SSTOL=PODRST
      PARTOL=PODRPT
      MAXITF=MAXITS
C
C  PRINT CONTROL
      LUNERR=IPR
      LUNRPT=IPR
      IF(IODRPO.EQ.'FULL')THEN
        IPRNT=2212
      ELSEIF(IODRPO.EQ.'INTE')THEN
        IPRNT=1111
      ELSEIF(IODRPO.EQ.'SHOR')THEN
        IPRNT=1001
      ELSE
        IPRNT=1111
      ENDIF
C
C  DERIVATIVE STEP SIZES
      STPD(1,1)=-1.0D0
      STPB(1)=-1.0D0
      LDSTPD=1
C
C  SCALING
      SCLD(1,1)=-1.0D0
      LDSCLD=1
      SCLB(1)=-1.0D0
C
C  STOPPING CONDITION
C
CCCCC FOLLOWING LINES WERE TEMPORARY DEBUGGING
ccccc print *,'n,m,np,nq=',n,m,np,nq
ccccc print *,'beta = ',(beta(i),i=1,np)
ccccc print *,'y = ',(Y(i,1),i=1,n)
ccccc print *,'ldy,ldx,ldwe,ld2we=',ldy,ldx,ldwe,ld2we
ccccc print *,'xmat=',((xmat(i,j),i=1,n),j=1,m)
ccccc print *,'w=',(w(i,1,1),i=1,n)
ccccc print *,'rho=',(rho(i,1,1),i=1,n)
ccccc print *,'ifixb(1)=',ifixb(1)
ccccc print *,'ifix=',((ifix(i,j),i=1,n),j=1,m)
ccccc print *,'ldifx,ldrho,ld2wd=',ldifx,ldrho,ld2wd
ccccc print *,'job,ndigit,taufac=',job,ndigit,taufac
ccccc print *,'sstol,partol,maxitf=',sstol,partol,maxitf
ccccc print *,'iprnt,lunerr,lunrpt=',iprnt,lunerr,lunrpt
ccccc print *,'stpb,stpd,ldstpd=',stpb(1),stpd(1,1),ldstpd
ccccc print *,'sclb,scld,ldscd=',sclb(1),scld(1,1),ldscld
ccccc print *,'work=',(work(i),i=1,n*m)
ccccc print *,'lwork.liwork=',lwork,liwork
ccccc print *,'info=',info
C
      CALL DODRC(
     1    FUN,
     1    N, M, NP, NQ,
     1    BETA,
     1    Y, LDY, XMAT, LDX,
     1    W, LDWE, LD2WE, RHO, LDRHO, LD2WD,
     1    IFIXB, IFIX, LDIFX,
     1    JOB, NDIGIT, TAUFAC,
     1    SSTOL, PARTOL, MAXITF,
     1    IPRNT,LUNERR,LUNRPT,
     1    STPB, STPD, LDSTPD,
     1    SCLB, SCLD,LDSCLD,
     1    WORK, LWORK, IWORK, LIWORK,
     1    INFO)
C
      DO120I=1,MIN(NP,100)
        PARAM3(I)=REAL(BETA(I))
  120 CONTINUE
C
C  CHECK FOR ERROR MESSAGES
C
      IF(INFO.GE.0)THEN
        IDIG5 = MOD(INFO,100000)/10000
        IDIG4 = MOD(INFO,10000)/1000
        IDIG3 = MOD(INFO,1000)/100
        IDIG2 = MOD(INFO,100)/10
        IDIG1 = MOD(INFO,10)
      ENDIF
C
      IF(INFO.LT.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,208)
 208    FORMAT('***** ERROR FROM DPORT2--COMPUTATIONS STOPPED IN ',
     1         'FUNCTION EVALUATION ROUTINE.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ELSEIF(INFO.GE.1 .AND. INFO.LE.4)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,210)
 210    FORMAT('***** ODRPACK CONVERGED SUCCESSFULLY.')
        CALL DPWRST('XXX','BUG ')
        IF(INFO.EQ.1)WRITE(ICOUT,211)
        IF(INFO.EQ.2)WRITE(ICOUT,212)
        IF(INFO.EQ.3)WRITE(ICOUT,213)
 211    FORMAT('      SUM-OF-SQUARES CONVERGENCE.')
 212    FORMAT('      PARAMETER CONVERGENCE.')
 213    FORMAT('      BOTH SUM-OF-SQUARES CONVERGENCE AND PARAMETER ',
     1         'CONVERGENCE.')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(INFO.EQ.4)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,410)MAXITF
 410    FORMAT('***** WARNING: ODRPACK REACHED MAXIMUM NUMBER OF ',
     1         'ITERATIONS,',I8,' WITHOUT CONVERGING.')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(INFO.GT.4 .AND. IDIG5.EQ.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,510)
 510    FORMAT('***** WARNING: ODRPACK RESULTS QUESTIONABLE.')
        CALL DPWRST('XXX','BUG ')
        IF(IDIG4.GE.1)THEN
          WRITE(ICOUT,502)
 502      FORMAT('      DERIVATIVES POSSIBLY NOT CORRECT.')
          CALL DPWRST('XXX','BUG ')
        ELSEIF(IDIG3.GE.1 )THEN
          WRITE(ICOUT,511)
 511      FORMAT('      LAST FUNCTION EVALUATION RETURNED AN ERROR.')
          CALL DPWRST('XXX','BUG ')
        ELSEIF(IDIG2.GE.2)THEN
          WRITE(ICOUT,513)
 513      FORMAT('      PROBLEM IS NOT FULL RANK AT SOLUTION.')
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ELSEIF(INFO.GT.4 .AND. IDIG5.GE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,610)
 610    FORMAT('***** ERROR: ODRPACK DETECTED FATAL ERRORS IN ',
     1         'USER INPUT.')
        CALL DPWRST('XXX','BUG ')
        IF(IDIG5.EQ.1 .AND. IDIG4.GE.1)THEN
          WRITE(ICOUT,620)
 620      FORMAT('      NUMBER OF OBSERVATIONS LESS THAN 1.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IDIG5.EQ.1 .AND. IDIG3.GE.1)THEN
          WRITE(ICOUT,630)
 630      FORMAT('      NUMBER OF INDEPENDENT VARIABLES LESS THAN ',
     1           '1.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IDIG5.EQ.1 .AND. IDIG2.GE.1)THEN
          WRITE(ICOUT,640)
 640      FORMAT('      NUMBER OF PARAMETERS LESS THAN 1 OR GREATER',
     1           'THAN NUMBER OF OBSERVATIONS.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IDIG5.EQ.1 .AND. IDIG1.GE.1)THEN
          WRITE(ICOUT,650)
 650      FORMAT('      NUMBER OR RESPONSE VARIABLES IS LESS THAN 1.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IDIG5.EQ.2 .AND. IDIG4.GE.1)THEN
          WRITE(ICOUT,660)
 660      FORMAT('      NUMBER OF OBSERVATIONS IN INDEPENDENT ',
     1           'VARIABLES LESS THAN NUMBER OF')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,662)
 662      FORMAT('      OBSERVATIONS IN DEDEPENDENT VARIABLE.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IDIG5.EQ.2 .AND. IDIG2.GE.2)THEN
          WRITE(ICOUT,665)
 665      FORMAT('      BAD DIMENSION FOR LDWE, LD2WE, LDWD OR LD2WD.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IDIG5.EQ.2 .AND. IDIG2.GE.1)THEN
          WRITE(ICOUT,670)
 670      FORMAT('      BAD DIMENSION FOR LDIFX, LDSCLD, OR LDRHO.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IDIG5.EQ.3 .AND. IDIG4.GE.1)THEN
          WRITE(ICOUT,680)
 680      FORMAT('      STPB OR STPD INCORRECT.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IDIG5.EQ.3 .AND. IDIG3.GE.1)THEN
          WRITE(ICOUT,690)
 690      FORMAT('      SCLB OR SCLD INCORRECT.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IDIG5.EQ.3 .AND. IDIG2.GE.1)THEN
          WRITE(ICOUT,700)
 700      FORMAT('      WEIGHTS FOR RESPONSE VARIABLE INCORRECT.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IDIG5.EQ.3 .AND. IDIG1.GE.1)THEN
          WRITE(ICOUT,710)
 710      FORMAT('      WEIGHTS FOR INDPENDENT VARIABLES INCORRECT.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IDIG5.EQ.4)THEN
          WRITE(ICOUT,720)
 720      FORMAT('      ERROR IN DERIVATIVES.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IDIG5.EQ.5)THEN
          WRITE(ICOUT,730)
 730      FORMAT('      LAST FUNCTION EVALUATION INCORRECT.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IDIG5.EQ.6)THEN
          WRITE(ICOUT,740)
 740      FORMAT('      NUMERICAL ERROR ENCOUNTERED.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,742)
 742      FORMAT('      SOME POSSIBLE CAUSES:')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,744)
 744      FORMAT('      1. USER INPUT POSSIBLY INCORRECT.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,746)
 746      FORMAT('      2. POOR CHOICE OF WEIGHTS OR SCALING.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
      ENDIF
C
      CALL DWINF
     1    (N,M,NP,NQ,LDWE,LD2WE,ISODR,
     1     DELTAI, EPSI, XPLUSI, FNI, SDI, VCVI,
     1     RVARI, WSSI, WSSDEI, WSSEPI, RCONDI, ETAI,
     1     OLMAVI, TAUI, ALPHAI, ACTRSI, PNORMI, RNORSI, PRERSI,
     1     PARTLI, SSTOLI, TAUFCI, EPSMAI,
     1     BETA0I, BETACI, BETASI, BETANI, SI, SSI, SSFI, QRAUXI, UI,
     1     FSI, FJACBI, WE1I, DIFFI,
     1     DELTSI, DELTNI, TI, TTI, OMEGAI, FJACDI,
     1     WRK1I, WRK2I, WRK3I, WRK4I, WRK5I, WRK6I, WRK7I,
     1     LWKMN)
C
      CALL DIWINF
     1    (M,NP,NQ,
     1    MSGBI, MSGDI, IFIX2I, ISTOPI,
     1    NNZWI, NPPI, IDFI,
     1    JOBI, IPRINI, LUNERI, LUNRPI,
     1    NROWI, NTOLI, NETAI,
     1    MAXITI, NITERI, NFEVI, NJEVI, INT2I, IRANKI, LDTTI,
     1    LIWKMN)
C
C               ****************************************************
C               **  STEP 81--                                     **
C               **  WRITE INFO OUT TO FILES--                     **
C               **     1) DPST1F.DAT--COEF COEFSD                 **
C               **     2) DPST2F.DAT--PARAMETER COVARIANCE MATRIX **
C               **     3) DPST3F.DAT--PREDICTED X (X+DELTA)       **
C               **     4) DPST4F.DAT--ERROR IN X (DELTA)          **
C               ****************************************************
C
 8100 CONTINUE
C
      ISTEPN='81'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'ORT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO935L=1,NQ
        DO930I=1,N
          RES2(I+(L-1)*N)=REAL(WORK(EPSI-1+I+(L-1)*N))
          PRED2(I+(L-1)*N)=REAL(WORK(FNI-1+I+(L-1)*N))
  930   CONTINUE
  935 CONTINUE
C
      DO940I=1,N
        WRITE(IOUNI3,'(20(E15.7,1X))') (WORK(XPLUSI-1+I+(J-1)*N),J=1,M)
        WRITE(IOUNI4,'(20(E15.7,1X))') (WORK(DELTAI-1+I+(J-1)*N),J=1,M)
  940 CONTINUE
C
      RESVAR=REAL(WORK(RVARI))
      RESSD=0.0
      IF(RESVAR.GT.0.0)RESSD=SQRT(RESVAR)
      RESDF=REAL(IWORK(IDFI))
      DO950I=1,NP
        DO955J=1,NP
          WORK(VCVI-1+I+(J-1)*N)=DBLE(RESVAR)*WORK(VCVI-1+I+(J-1)*NP)
  955   CONTINUE
        WRITE(IOUNI2,'(20(E15.7,1X))')
     1       (REAL(WORK(VCVI-1+I+(J-1)*NP)),J=1,NP)
  950 CONTINUE
C
      DO8110I=1,NP
        PARAM3(I)=REAL(BETA(I))
        ASD=REAL(WORK(SDI-1+I))
        WRITE(IOUNI1,8111)PARAM3(I),ASD,IPARN3(I),IPARN4(I)
 8111   FORMAT(E15.7,1X,E15.7,10X,A4,A4)
 8110 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO8119
      WRITE(ICOUT,8112)
 8112 FORMAT(6X,'COEF AND SD(COEF) WRITTEN TO FILE DPST1F.DAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8113)
 8113 FORMAT(6X,'PARAMETER VARIANCE-COVARIANCE MATRIX WRITTEN TO ',
     1       'FILE DPST2F.DAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8114)
 8114 FORMAT(6X,'PREDICTED INDEPENDENT VARIABLE ARRAY WRITTEN TO ',
     1       'FILE DPST3F.DAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8116)
 8116 FORMAT(6X,'ERROR IN INDPENDENT VARIABLE ARRAY WRITTEN TO ',
     1       'FILE DPST4F.DAT')
      CALL DPWRST('XXX','BUG ')
 8119 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO8129
 8129 CONTINUE
C
C               **************************************
C               **  STEP 82--                       **
C               **  CLOSE       THE STORAGE FILES.  **
C               **************************************
C
 8200 CONTINUE
C
      ISTEPN='82'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'FIT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDF1='OFF'
      IREWI1='ON'
      CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IENDF2='OFF'
      IREWI2='ON'
      CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IENDF3='OFF'
      IREWI3='ON'
      CALL DPCLFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1IENDF3,IREWI3,ISUBN0,IERRF3,IBUGA3,ISUBRO,IERROR)
      IF(IERRF3.EQ.'YES')GOTO9000
C
      IENDF4='OFF'
      IREWI4='ON'
      CALL DPCLFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1IENDF4,IREWI4,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
      IF(IERRF4.EQ.'YES')GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'ORT2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPORT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IERROR
 9012 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPOSM(ICASLE,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE ORDER STATISTIC MEDIANS FOR
C              UNIFORM DISTRIBUTION
C              NORMAL DISTRIBUTION
C              HALFNORMAL DISTRIBUTION
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--91/11
C     ORIGINAL VERSION--OCTOBER 1991.
C     UPDATED         --MAY     1993. EV1, EV2, WEIBULL
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASLE
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 NEWNAM
      CHARACTER*4 NEWCOL
      CHARACTER*4 ICASEQ
      CHARACTER*4 ILEFT
      CHARACTER*4 ILEFT2
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED   MAY 1993
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPOS'
      ISUBN2='M   '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      IFOUND='YES'
C
      NS2=0
C
C               ***********************************************
C               **  TREAT THE ORDER STATISTIC MEDIANS CASE  **
C               **       1) FOR A FULL VARIABLE, OR          **
C               **       2) FOR PART OF A VARIABLE.          **
C               ***********************************************
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPOSM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASLE,IBUGA3,IBUGQ
   52 FORMAT('ICASLE,IBUGA3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NEWNAM='NO'
      NEWCOL='NO'
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=3
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************************************
C               **  STEP 3--                                                   *
C               **  EXAMINE THE LEFT-HAND SIDE--                               *
C               **  IS THE PARAMETER OR VARIABLE NAME TO LEFT OF = SIGN        *
C               **  ALREADY IN THE NAME LIST?                                  *
C               **  NOTE THAT     ILEFT      IS THE NAME OF THE VARIABLE       *
C               **  ON THE LEFT.                                               *
C               **  NOTE THAT     ILISTL    IS THE LINE IN THE TABLE           *
C               **  OF THE NAME ON THE LEFT.                                   *
C               **  NOTE THAT     ICOLL    IS THE DATA COLUMN (1 TO 12)        *
C               **  FOR THE NAME OF THE LEFT.                                  *
C               ****************************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC ILEFT=IHOL(2)
CCCCC ILEFT2=IHOL2(2)
      ILEFT=IHARG(1)
      ILEFT2=IHARG2(1)
      DO310I=1,NUMNAM
      I2=I
      IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO329
      IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO380
  310 CONTINUE
      NEWNAM='YES'
      ILISTL=NUMNAM+1
      IF(ILISTL.GT.MAXNAM)GOTO320
      GOTO330
C
  320 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,321)
  321 FORMAT('***** ERROR IN DPOSM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,322)
  322 FORMAT('      THE NUMBER OF VARIABLE AND/OR PARAMETER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,323)MAXNAM
  323 FORMAT('      NAMES HAS JUST EXCEEDED THE MAX ALLOWABLE ',
     1I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,324)
  324 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,325)
  325 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,326)
  326 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,327)
  327 FORMAT('      AND THEN REDEFINE (REUSE) SOME OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,328)
  328 FORMAT('      ALREADY-USED NAMES')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  329 CONTINUE
      ILISTL=I2
      GOTO330
C
  330 CONTINUE
      NLEFT=0
      ICOLL=NUMCOL+1
      IF(ICOLL.GT.MAXCOL)GOTO340
      GOTO390
C
  340 CONTINUE
      WRITE(ICOUT,341)
  341 FORMAT('***** ERROR IN DPOSM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,342)
  342 FORMAT('      THE NUMBER OF DATA COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,343)MAXCOL
  343 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE ',I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,344)
  344 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,345)
  345 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,346)
  346 FORMAT('      TO FIND OUT THE FULL LIST OF USED COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,347)
  347 FORMAT('      AND THEN OVERWRITE SOME COLUMNS.   EXAMPLE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,348)
  348 FORMAT('      IF       LET X(I) = 3.14         FAILED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,349)
  349 FORMAT('      THEN ONE MIGHT ENTER     NAME X 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,350)
  350 FORMAT('      (THEREBY EQUATING THE NAME X WITH COLUMN 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,351)
  351 FORMAT('      FOLLOWED BY              LET X = 3.14')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,352)
  352 FORMAT('      (WHICH WILL ACTUALLY OVERWRITE COLUMN 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,353)
  353 FORMAT('      WITH THE NUMERIC CONSTANTS 3.14)')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  380 CONTINUE
      ILISTL=I2
      ICOLL=IVALUE(ILISTL)
      NLEFT=IN(ILISTL)
C
  390 CONTINUE
C
C               *****************************************
C               **  STEP 6--                           **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)           **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO670
      DO610J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO620
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO620
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO630
  610 CONTINUE
      GOTO680
C
  620 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO680
C
  630 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO680
C
  670 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,671)
  671 FORMAT('***** INTERNAL ERROR IN DPOSM')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,672)
  672 FORMAT('      AT BRANCH POINT 5081--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,673)
  673 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,674)
  674 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,675)NUMARG
  675 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,676)
  676 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,677)(IANS(I),I=1,IWIDTH)
  677 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  680 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO690
      WRITE(ICOUT,681)NUMARG,ILOCQ,ICASEQ
  681 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
C
  690 CONTINUE
C
C               ******************************************************
C               **  STEP 7--                                        **
C               **  BRANCH TO THE APPROPRIATE SUBCASE               **
C               **  (BASED ON THE QUALIFIER);                       **
C               **  DETERMINE THE NUMBER (= NOSM)                   **
C               **  OF ORDER STATISTIC MEDIANS TO BE GENERATED.
C               **  NOTE THAT THE VARIABLE NIISUB                   **
C               **  IS THE LENGTH OF THE RESULTING                  **
C               **  VARIABLE ISUB(.).                               **
C               **  NOTE THAT DPFOR AUTOMATICALLY EXTENDS           **
C               **  THE INPUT LENGTH OF ISUB(.) IF NECESSARY.       **
C               **  (HENCE THE REDEFINITION OF NIISUB TO NINEW      **
C               **  AFTER THE CALL TO DPFOR.                        **
C               ******************************************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO710
      IF(ICASEQ.EQ.'SUBS')GOTO720
      IF(ICASEQ.EQ.'FOR')GOTO730
C
  710 CONTINUE
      IF(NEWNAM.EQ.'NO')NIISUB=NLEFT
      IF(NEWNAM.EQ.'YES')NIISUB=MAXN
      DO715I=1,NIISUB
      ISUB(I)=1
  715 CONTINUE
      NOSM=NIISUB
      GOTO750
C
  720 CONTINUE
      NIISUB=MAXN
      CALL DPSUBS(NIISUB,ILOCS,NS,IBUGQ,IERROR)
      NOSM=NS
      GOTO750
C
  730 CONTINUE
      IF(NEWNAM.EQ.'NO')NIISUB=NLEFT
      IF(NEWNAM.EQ.'YES')NIISUB=MAXN
      CALL DPFOR(NIISUB,NINEW,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NIISUB=NINEW
      NOSM=NS
      GOTO750
C
  750 CONTINUE
C
C               ******************************************
C               **  STEP 8--                            **
C               **  GENERATE    NOSM    ORDER           **
C               **  STATISTIC MEDIANS.                  **
C               **  STORE THEM TEMPORARILY IN           **
C               **  THE VECTOR Y(.).                    **
C               ******************************************
C
      ISTEPN='8'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL UNIMED(NOSM,Y)
C
      IF(ICASLE.EQ.'UOSM')GOTO890
      IF(ICASLE.EQ.'NOSM')GOTO820
      IF(ICASLE.EQ.'HOSM')GOTO830
C
CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1993
      IF(ICASLE.EQ.'E1OM'.OR.ICASLE.EQ.'E2OM'.OR.ICASLE.EQ.'WOSM')THEN
         IHP='GAMM'
         IHP2='A   '
         IHWUSE='P'
         MESSAG='YES'
         CALL CHECKN(IHP,IHP2,IHWUSE,
     1   IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1   ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
         IF(IERROR.EQ.'YES')GOTO9000
         GAMMA=VALUE(ILOCP)
C
         IF(GAMMA.GT.0)GOTO1590
         WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1511)
 1511    FORMAT('***** ERROR IN DPOSM--')
      CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1512)
 1512    FORMAT('      THE SPECIFIED SHAPE PARAMETER GAMMA')
      CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1513)
 1513    FORMAT('      FOR THE EV1/EV2/WEIBULL DISTRIBUTIONS')
      CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1514)
 1514    FORMAT('      MUST BE STRICTLY LARGER THAN 0;')
      CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1515)
 1515    FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1516)GAMMA
 1516    FORMAT('      THE SPECIFIED VALUE OF GAMMA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
         IERROR='YES'
         GOTO9000
 1590    CONTINUE
      ENDIF
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    MAY 1993
      IF(ICASLE.EQ.'E1OM')GOTO840
      IF(ICASLE.EQ.'E2OM')GOTO850
      IF(ICASLE.EQ.'WOSM')GOTO860
C
  820 CONTINUE
      DO821I=1,NOSM
      CALL NORPPF(Y(I),Y(I))
  821 CONTINUE
      GOTO890
C
  830 CONTINUE
      DO831I=1,NOSM
      CALL HFNPPF(Y(I),Y(I))
  831 CONTINUE
      GOTO890
C
  840 CONTINUE
      DO841I=1,NOSM
      CALL EV1PPF(Y(I),MINMAX,Y(I))
  841 CONTINUE
      GOTO890
C
  850 CONTINUE
      DO851I=1,NOSM
      CALL EV2PPF(Y(I),GAMMA,MINMAX,Y(I))
  851 CONTINUE
      GOTO890
C
  860 CONTINUE
      DO861I=1,NOSM
      CALL WEIPPF(Y(I),GAMMA,MINMAX,Y(I))
  861 CONTINUE
      GOTO890
C
  890 CONTINUE
C
C               ***********************************************************
C               **  STEP 8--                                             **
C               **  IF CALLED FOR (THAT IS, IF IBUGA3 IS ON),      **
C               **  PRINT OUT THE INTERMEDIATE VARIABLE Y(.).            **
C               **  THIS IS USEFUL FOR DIAGNOSTIC PURPOSES               **
C               **  IN REVIEWING THE OUTPUT FROM THIS SUBROUTINE.        **
C               ***********************************************************
C
      ISTEPN='9'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'OFF')GOTO2090
      WRITE(ICOUT,2051)
 2051 FORMAT('OUTPUT FROM MIDDLE OF DPOSM AFTER UNIMED ',
     1'HAS BEEN CALLED--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2052)NOSM
 2052 FORMAT('NOSM = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NOSM.LE.0)GOTO2090
      DO2054I=1,NOSM
      WRITE(ICOUT,2055)I,Y(I)
 2055 FORMAT('I,Y(I) = ',I8,F12.5)
      CALL DPWRST('XXX','BUG ')
 2054 CONTINUE
C
 2090 CONTINUE
C
C               ******************************************************
C               **  STEP 9--                                        **
C               **  COPY THE ORDER STATISTIC MEDIANS                **
C               **  FROM THE INTERMEDIATE VECTOR Y(.)               **
C               **  TO THE APPROPRIATE COLUMN                       **
C               **  (BASED ON THE QUALIFIER--FULL, SUBSET, OR FOR)  **
C               **  IN THE INTERNAL DATAPLOT DATA TABLE.            **
C               ******************************************************
C
      ISTEPN='10'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NS2=0
      DO2100I=1,NIISUB
      IJ=MAXN*(ICOLL-1)+I
      IF(ISUB(I).EQ.0)GOTO2100
      NS2=NS2+1
      IF(ICOLL.LE.MAXCOL)V(IJ)=Y(NS2)
      IF(ICOLL.EQ.MAXCP1)PRED(I)=Y(NS2)
      IF(ICOLL.EQ.MAXCP2)RES(I)=Y(NS2)
      IF(ICOLL.EQ.MAXCP3)YPLOT(I)=Y(NS2)
      IF(ICOLL.EQ.MAXCP4)XPLOT(I)=Y(NS2)
      IF(ICOLL.EQ.MAXCP5)X2PLOT(I)=Y(NS2)
      IF(ICOLL.EQ.MAXCP6)TAGPLO(I)=Y(NS2)
      IF(NS2.EQ.1)IROW1=I
      IROWN=I
 2100 CONTINUE
C
C               *******************************************
C               **  STEP 10--                            **
C               **  CARRY OUT THE LIST UPDATING AND      **
C               **  GENERATE THE INFORMATIVE PRINTING.   **
C               *******************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL'.AND.NEWNAM.EQ.'NO')NINEW=NLEFT
      IF(ICASEQ.EQ.'FULL'.AND.NEWNAM.EQ.'YES')NINEW=MAXN
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.GE.IROWN)NINEW=NLEFT
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.LT.IROWN)NINEW=IROWN
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'YES')NINEW=IROWN
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.GE.IROWN)NINEW=NLEFT
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.LT.IROWN)NINEW=IROWN
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'YES')NINEW=IROWN
C
      IHNAME(ILISTL)=ILEFT
      IHNAM2(ILISTL)=ILEFT2
      IUSE(ILISTL)='V'
      IVALUE(ILISTL)=ICOLL
      VALUE(ILISTL)=ICOLL
      IN(ILISTL)=NINEW
C
CCCCC IUSE(ICOLL)='V'
CCCCC IVALUE(ICOLL)=ICOLL
CCCCC VALUE(ICOLL)=ICOLL
CCCCC IN(ICOLL)=NINEW
C
      IF(NEWNAM.EQ.'YES')NUMNAM=NUMNAM+1
      IF(NEWNAM.EQ.'YES')NUMCOL=NUMCOL+1
C
      DO4100J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL)GOTO4105
      GOTO4100
 4105 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL
      VALUE(J4)=ICOLL
      IN(J4)=NINEW
 4100 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO4059
      IF(IFEEDB.EQ.'OFF')GOTO4059
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4011)ILEFT,ILEFT2,NS2
 4011 FORMAT('THE NUMBER OF VALUES GENERATED FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IJ=MAXN*(ICOLL-1)+IROW1
      IF(ICOLL.LE.MAXCOL)WRITE(ICOUT,4021)ILEFT,ILEFT2,V(IJ),
     1IROW1
      IF(ICOLL.LE.MAXCOL)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP1)WRITE(ICOUT,4021)ILEFT,ILEFT2,PRED(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP2)WRITE(ICOUT,4021)ILEFT,ILEFT2,RES(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP2)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP3)WRITE(ICOUT,4021)ILEFT,ILEFT2,YPLOT(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP3)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP4)WRITE(ICOUT,4021)ILEFT,ILEFT2,XPLOT(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP4)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP5)WRITE(ICOUT,4021)ILEFT,ILEFT2,X2PLOT(IROW1),
     1IROW1
      IF(ICOLL.EQ.MAXCP5)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP6)WRITE(ICOUT,4021)ILEFT,ILEFT2,TAGPLO(IROW1),
     1IROW1
 4021 FORMAT('THE FIRST           COMPUTED VALUE OF ',A4,A4,
     1' = ',E15.7,'   (ROW ',I6,')')
      IF(ICOLL.EQ.MAXCP6)CALL DPWRST('XXX','BUG ')
C
      IJ=MAXN*(ICOLL-1)+IROWN
      IF(ICOLL.LE.MAXCOL.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,V(IJ),IROWN
 4031 FORMAT('THE LAST (',I5,'-TH) COMPUTED VALUE OF ',A4,A4,
     1' = ',E15.7,'   (ROW ',I6,')')
      IF(ICOLL.LE.MAXCOL.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP1.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,PRED(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP1.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP2.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,RES(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP2.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP3.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,YPLOT(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP3.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP4.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,XPLOT(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP4.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP5.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,X2PLOT(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP5.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP6.AND.
     1NS2.NE.1)WRITE(ICOUT,4031)NS2,ILEFT,ILEFT2,TAGPLO(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP6.AND.
     1NS2.NE.1)CALL DPWRST('XXX','BUG ')
      IF(NS2.NE.1)GOTO4090
      WRITE(ICOUT,4041)
 4041 FORMAT('SINCE THE GENERATED SAMPLE SIZE WAS ONLY 1,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4042)
 4042 FORMAT('THE ABOVE VALUE WAS THE SOLE VALUE COMPUTED.')
      CALL DPWRST('XXX','BUG ')
 4090 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4112)ILEFT,ILEFT2,ICOLL
 4112 FORMAT('THE CURRENT COLUMN FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4113)ILEFT,ILEFT2,NINEW
 4113 FORMAT('THE CURRENT LENGTH OF  ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 4059 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPOSM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASLE,IBUGA3,IBUGQ
 9013 FORMAT('ICASLE,IBUGA3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NS2
 9015 FORMAT('NS2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NS,NIISUB,NOSM
 9016 FORMAT('NS,NIISUB,NOSM = ',I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPOVA2(X1,Y1,X2,Y2,X3,Y3,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW A OVAL
C              WITH ONE END OF THE MAJOR AXIS AT (X1,Y1)
C              WITH ONE END OF THE MINOR AXIS AT (X2,Y2)
C              AND THE OTHER END OF MAJOR AXIS AT (X3,Y3).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT2
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IPATT
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(1000)
      DIMENSION PY(1000)
CCCCC FEBRUARY 1994.  ADD FOLLOWING SECTION
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR11),PX(1))
      EQUIVALENCE (G2RBAG(IGAR12),PY(1))
CCCCC END CHANGE
CCCCC DIMENSION PX3(1000)
CCCCC DIMENSION PY3(1000)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'OVA2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPOVA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y2
   54 FORMAT('X2,Y2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IFIG
   59 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE THE COORDINATES  **
C               **  FOR THE OVAL               **
C               *********************************
C
      PI=3.1415926
C
C               ****************************************************
C               **  STEP 1.1--                                      **
C               **  FIND THE ANGLE OF ROTATION OF THE MAJOR AXIS  **
C               **  FIND THE RADIUS OF THE MAJOR AXIS              **
C               ****************************************************
C
      DELX=X3-X1
      DELY=Y3-Y1
      ALEN=0.0
      TERM=DELX**2+DELY**2
      IF(TERM.GT.0.0)ALEN=SQRT(TERM)
      A=ALEN/2.0
C
      IF(ABS(DELX).GE.0.00001)THETA=ATAN(DELY/DELX)
      IF(ABS(DELX).LT.0.00001.AND.DELY.GE.0.0)THETA=PI/2.0
      IF(ABS(DELX).LT.0.00001.AND.DELY.LT.0.0)THETA=-PI/2.0
      IF(IBUGG4.EQ.'ON')WRITE(ICOUT,776)ALEN,A,THETA
  776 FORMAT('ALEN,A,THETA = ',3E15.7)
      IF(IBUGG4.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ***********************************
C               **  STEP 1.2--                     **
C               **  FIND THE CENTER OF THE OVAL  **
C               ***********************************
C
      XCENT=(X1+X3)/2.0
      YCENT=(Y1+Y3)/2.0
      IF(IBUGG4.EQ.'ON')WRITE(ICOUT,777)XCENT,YCENT
  777 FORMAT('XCENT,YCENT = ',2E15.7)
      IF(IBUGG4.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               *****************************************
C               **  STEP 1.3--                           **
C               **  FIND THE RADIUS OF THE MINOR AXIS  **
C               *****************************************
C
      DELX2=2.0*(X2-XCENT)
      DELY2=2.0*(Y2-YCENT)
      ALENMI=0.0
      TERM=DELX2**2+DELY2**2
      IF(TERM.GT.0.0)ALENMI=SQRT(TERM)
      B=ALENMI/2.0
      IF(IBUGG4.EQ.'ON')WRITE(ICOUT,778)ALENMI,B
  778 FORMAT('ALENMI,B = ',2E15.7)
      IF(IBUGG4.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               *********************
C               **  STEP 1.4--       **
C               **  DRAW THE OVAL  **
C               *********************
C
      K=0
C
      X=0
      Y=0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
C               ******************************************
C               **  STEP 1.5--                          **
C               **  DRAW THE UPPER LEFT QUARTER-CIRCLE  **
C               ******************************************
C
      X=0
      Y=0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      AJX3=XP
      AJY3=YP
      X=(1.0-SQRT(0.5))*B
      Y=SQRT(0.5)*B
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      AJX4=XP
      AJY4=YP
      X=B
      Y=B
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      AJX5=XP
      AJY5=YP
      CALL DPOVA3(AJX3,AJY3,AJX4,AJY4,AJX5,AJY5,PX,PY,K)
C
C               *************************************
C               **  STEP 1.6--                     **
C               **  DRAW THE STRAIGHT TOP SECTION  **
C               *************************************
C
      X=ALEN-B
      Y=B
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
C               *******************************************
C               **  STEP 1.7--                           **
C               **  DRAW THE UPPER-RIGHT QUARTER-CIRCLE  **
C               *******************************************
C
      X=ALEN-B
      Y=B
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      AJX3=XP
      AJY3=YP
      X=ALEN-((1.0-SQRT(0.5))*B)
      Y=SQRT(0.5)*B
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      AJX4=XP
      AJY4=YP
      X=ALEN
      Y=0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      AJX5=XP
      AJY5=YP
      CALL DPOVA3(AJX3,AJY3,AJX4,AJY4,AJX5,AJY5,PX,PY,K)
C
C               *******************************************
C               **  STEP 1.8--                           **
C               **  DRAW THE LOWER-RIGHT QUARTER-CIRCLE  **
C               *******************************************
C
      X=ALEN
      Y=0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      AJX3=XP
      AJY3=YP
      X=ALEN-((1.0-SQRT(0.5))*B)
      Y=-SQRT(0.5)*B
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      AJX4=XP
      AJY4=YP
      X=ALEN-B
      Y=-B
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      AJX5=XP
      AJY5=YP
      CALL DPOVA3(AJX3,AJY3,AJX4,AJY4,AJX5,AJY5,PX,PY,K)
C
C               ****************************************
C               **  STEP 1.9--                        **
C               **  DRAW THE BOTTOM STRAIGHT SECTION  **
C               ****************************************
C
      X=B
      Y=-B
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
C               ******************************************
C               **  STEP 1.10--                         **
C               **  DRAW THE LOWER-LEFT QUARTER-CIRCLE  **
C               ******************************************
C
      X=B
      Y=-B
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      AJX3=XP
      AJY3=YP
      X=(1.0-SQRT(0.5))*B
      Y=-SQRT(0.5)*B
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      AJX4=XP
      AJY4=YP
      X=0
      Y=0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      AJX5=XP
      AJY5=YP
      CALL DPOVA3(AJX3,AJY3,AJX4,AJY4,AJX5,AJY5,PX,PY,K)
C
      NP=K
C
C               ***********************
C               **  STEP 2--         **
C               **  FILL THE FIGURE  **
C               **  (IF CALLED FOR)  **
C               ***********************
C
      IF(IREFSW(1).EQ.'OFF')GOTO2190
      IPATT=IREPTY(1)
      IPATT2='SOLI'
      PTHICK=PREPTH(1)
      PXGAP=PREPSP(1)
      PYGAP=PREPSP(1)
      ICOLF=IREFCO(1)
      ICOLP=IREPCO(1)
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
 2190 CONTINUE
C
C               ***************************
C               **  STEP 3--             **
C               **  DRAW OUT THE FIGURE  **
C               ***************************
C
      IPATT=ILINPA(1)
      PTHICK=PLINTH(1)
      ICOL=ILINCO(1)
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'OVA2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPOVA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)DELX,DELY
 9012 FORMAT('DELX,DELY = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)XCENT,YCENT,A,B
 9013 FORMAT('XCENT,YCENT,A,B = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NP
 9014 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)I,PX(I),PY(I)
 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPOVA3(X1,Y1,X2,Y2,X3,Y3,PX,PY,K)
C
C     PURPOSE--DRAW AN ARC (AS PART OF AN OVAL)
C              WITH ONE END OF THE ARC AT (X1,Y1)
C              SOME MIDDLE POINT AT (X2,Y2),
C              AND THE OTHER END OF THE ARC AT (X3,Y3).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      DIMENSION PX(*)
      DIMENSION PY(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'OVA3')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPOVA3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y2
   54 FORMAT('X2,Y2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)X3,Y3
   55 FORMAT('X3,Y3 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)K
   56 FORMAT('K = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE THE COORDINATES  **
C               **  FOR THE ARC                **
C               *********************************
C
      PI=3.1415926
C
      THETA=0.0
      THETA1=0.0
      THETA2=0.0
      THETA3=0.0
C
C               ****************************************************************
C               **  STEP 1.1--                                                **
C               **  COMPUTE THE INTERCEPT AND SLOPE OF THE LINE               **
C               **  THROUGH THE MIDPOINT OF POINTS 1 AND 2                    **
C               **  AND PERPENDICULAR TO THE SEGMENT BETWEEN POINTS 1 AND 2.  **
C               ****************************************************************
C
      DELX12=X2-X1
      DELY12=Y2-Y1
C
      IF(DELX12.EQ.0.0)GOTO711
      IF(DELY12.EQ.0.0)GOTO712
      GOTO713
C
  711 CONTINUE
      AM12=CPUMAX
      B12=CPUMAX
      AM12P=0.0
      B12P=Y1
      GOTO715
C
  712 CONTINUE
      AM12=0.0
      B12=Y1
      AM12P=CPUMAX
      B12P=CPUMAX
      GOTO715
C
  713 CONTINUE
      AM12=DELY12/DELX12
      B12=-AM12*X1+Y1
      X12=(X1+X2)/2.0
      Y12=(Y1+Y2)/2.0
      AM12P=-1.0/AM12
      B12P=-AM12P*X12+Y12
      GOTO715
C
  715 CONTINUE
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'OVA3')
     1WRITE(ICOUT,716)DELX12,DELY12,B12,AM12,B12P,AM12P
  716 FORMAT('DELX12,DELY12,B12,AM12,B12P,AM12P = ',6E15.7)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'OVA3')
     1CALL DPWRST('XXX','BUG ')
C
C               ****************************************************************
C               **  STEP 1.2--                                                **
C               **  COMPUTE THE INTERCEPT AND SLOPE OF THE LINE               **
C               **  THROUGH THE MIDPOINT OF POINTS 2 AND 3                    **
C               **  AND PERPENDICULAR TO THE SEGMENT BETWEEN POINTS 2 AND 3.  **
C               ****************************************************************
C
      DELX23=X3-X2
      DELY23=Y3-Y2
C
      IF(DELX23.EQ.0.0)GOTO721
      IF(DELY23.EQ.0.0)GOTO722
      GOTO723
C
  721 CONTINUE
      AM23=CPUMAX
      B23=CPUMAX
      AM23P=0.0
      B23P=Y2
      GOTO725
C
  722 CONTINUE
      AM23=0.0
      B23=Y2
      AM23P=CPUMAX
      B23P=CPUMAX
      GOTO725
C
  723 CONTINUE
      AM23=DELY23/DELX23
      B23=-AM23*X2+Y2
      X23=(X2+X3)/2.0
      Y23=(Y2+Y3)/2.0
      AM23P=-1.0/AM23
      B23P=-AM23P*X23+Y23
      GOTO725
C
  725 CONTINUE
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'OVA3')
     1WRITE(ICOUT,726)DELX23,DELY23,B23,AM23,B23P,AM23P
  726 FORMAT('DELX23,DELY23,B23,AM23,B23P,AM23P = ',6E15.7)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'OVA3')
     1CALL DPWRST('XXX','BUG ')
C
C               ***************************************************
C               **  STEP 1.3--                                   **
C               **  COMPUTE THE COORDINATES OF THE CENTER POINT  **
C               **  OF THE CIRCLE DEFINED BY THE 3 ARC POINTS.   **
C               ***************************************************
C
      ANUM=-(B12P-B23P)
      ADEN=AM12P-AM23P
      XCENT=CPUMAX
      IF(ADEN.NE.0.0)XCENT=ANUM/ADEN
      YCENT=AM12P*XCENT+B12P
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'OVA3')
     1WRITE(ICOUT,731)ANUM,ADEN,XCENT,YCENT
  731 FORMAT('ANUM,ADEN,XCENT,YCENT = ',4E15.7)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'OVA3')
     1CALL DPWRST('XXX','BUG ')
C
C               ****************************************************
C               **  STEP 1.4--                                    **
C               **  COMPUTE THE ANGLE OF ROTATION OF THE FIGURE.  **
C               ****************************************************
C
      DELX=X3-X1
      DELY=Y3-Y1
C
      IF(ABS(DELX).GE.0.00001.AND.DELX.LT.0.0)
     1THETA=PI+ATAN(DELY/DELX)
      IF(ABS(DELX).GE.0.00001.AND.DELX.GT.0.0)
     1THETA=ATAN(DELY/DELX)
C
      IF(ABS(DELX).LT.0.00001.AND.DELY.LT.0.0)
     1THETA=1.5*(PI/2.0)
      IF(ABS(DELX).LT.0.00001.AND.DELX.EQ.0.0)
     1THETA=PI/2.0
      IF(ABS(DELX).LT.0.00001.AND.DELY.GT.0.0)
     1THETA=PI/2.0
C
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'OVA3')
     1WRITE(ICOUT,741)DELX,DELY,THETA
  741 FORMAT('DELX,DELY,THETA = ',3E15.7)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'OVA3')
     1CALL DPWRST('XXX','BUG ')
C
C               ***********************************************************
C               **  STEP 1.5--                                           **
C               **  COMPUTE THE RADIUS OF THE CIRCLE.                    **
C               **  COMPUTE THE ANGLE FROM THE CENTER POINT TO POINT 1.  **
C               ***********************************************************
C
      DELXC1=2.0*(X1-XCENT)
      DELYC1=2.0*(Y1-YCENT)
      ALEN=0.0
      TERM=DELXC1**2+DELYC1**2
      IF(TERM.GT.0.0)ALEN=SQRT(TERM)
      R=ALEN/2.0
      IF(ABS(DELXC1).GE.0.00001.AND.DELXC1.GE.0.0)
     1THETA1=ATAN(DELYC1/DELXC1)
      IF(ABS(DELXC1).GE.0.00001.AND.DELXC1.LT.0.0)
     1THETA1=PI+ATAN(DELYC1/DELXC1)
      IF(ABS(DELXC1).LT.0.00001.AND.DELYC1.GE.0.0)
     1THETA1=PI/2.0
      IF(ABS(DELXC1).LT.0.00001.AND.DELYC1.LT.0.0)
     1THETA1=1.5*(PI/2.0)
      IF(THETA1.LT.0.0)THETA1=THETA1+2.0*PI
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'OVA3')
     1WRITE(ICOUT,751)ALEN,R
  751 FORMAT('ALEN,R = ',2E15.7)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'OVA3')
     1CALL DPWRST('XXX','BUG ')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'OVA3')
     1WRITE(ICOUT,752)DELXC1,DELYC1,THETA1
  752 FORMAT('DELXC1,DELYC1,THETA1 = ',3E15.7)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'OVA3')
     1CALL DPWRST('XXX','BUG ')
C
C               ***********************************************************
C               **  STEP 1.6--                                           **
C               **  COMPUTE THE ANGLE FROM THE CENTER POINT TO POINT 2.  **
C               ***********************************************************
C
      DELXC2=2.0*(X2-XCENT)
      DELYC2=2.0*(Y2-YCENT)
      IF(ABS(DELXC2).GE.0.00001.AND.DELXC2.GE.0.0)
     1THETA2=ATAN(DELYC2/DELXC2)
      IF(ABS(DELXC2).GE.0.00001.AND.DELXC2.LT.0.0)
     1THETA2=PI+ATAN(DELYC2/DELXC2)
      IF(ABS(DELXC2).LT.0.00001.AND.DELYC2.GE.0.0)
     1THETA2=PI/2.0
      IF(ABS(DELXC2).LT.0.00001.AND.DELYC2.LT.0.0)
     1THETA2=1.5*(PI/2.0)
      IF(THETA2.LT.0.0)THETA2=THETA2+2.0*PI
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'OVA3')
     1WRITE(ICOUT,761)DELXC2,DELYC2,THETA2
  761 FORMAT('DELXC2,DELYC2,THETA2 = ',3E15.7)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'OVA3')
     1CALL DPWRST('XXX','BUG ')
C
C               ***********************************************************
C               **  STEP 1.7--                                           **
C               **  COMPUTE THE ANGLE FROM THE CENTER POINT TO POINT 3.  **
C               ***********************************************************
C
      DELXC3=2.0*(X3-XCENT)
      DELYC3=2.0*(Y3-YCENT)
      IF(ABS(DELXC3).GE.0.00001.AND.DELXC3.GE.0.0)
     1THETA3=ATAN(DELYC3/DELXC3)
      IF(ABS(DELXC3).GE.0.00001.AND.DELXC3.LT.0.0)
     1THETA3=PI+ATAN(DELYC3/DELXC3)
      IF(ABS(DELXC3).LT.0.00001.AND.DELYC3.GE.0.0)
     1THETA3=PI/2.0
      IF(ABS(DELXC3).LT.0.00001.AND.DELYC3.LT.0.0)
     1THETA3=1.5*(PI/2.0)
      IF(THETA3.LT.0.0)THETA3=THETA3+2.0*PI
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'OVA3')
     1WRITE(ICOUT,771)DELXC3,DELYC3,THETA3
  771 FORMAT('DELXC3,DELYC3,THETA3 = ',3E15.7)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'OVA3')
     1CALL DPWRST('XXX','BUG ')
C
C               ******************************
C               **  STEP 1.8--              **
C               **  COMPUTE THE ARC POINTS  **
C               ******************************
C
      K=K+1
      PX(K)=X1
      PY(K)=Y1
C
      IF(THETA1.LE.THETA3.AND.THETA3.LE.THETA2)GOTO3001
      IF(THETA2.LE.THETA1.AND.THETA1.LE.THETA3)GOTO3002
      IF(THETA3.LE.THETA1.AND.THETA1.LE.THETA2)GOTO3003
      IF(THETA2.LE.THETA3.AND.THETA3.LE.THETA1)GOTO3004
      GOTO3005
 3001 CONTINUE
      THETA1=THETA1+2.0*PI
      GOTO3005
 3002 CONTINUE
      THETA1=THETA1+2.0*PI
      THETA2=THETA2+2.0*PI
      GOTO3005
 3003 CONTINUE
      THETA1=THETA1+2.0*PI
      GOTO3005
 3004 CONTINUE
      THETA2=THETA2+2.0*PI
      THETA3=THETA3+2.0*PI
      GOTO3005
 3005 CONTINUE
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'OVA3')
     1WRITE(ICOUT,3009)THETA1,THETA2,THETA3
 3009 FORMAT('THETA1,THETA2,THETA3 = ',3E15.7)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'OVA3')
     1CALL DPWRST('XXX','BUG ')
C
      DELTHE=THETA3-THETA1
      IMAX=101
      AIMAX=IMAX
      DO3010I=1,IMAX
      AI=I
      P=(AI-1.0)/(AIMAX-1.0)
      PHI2=THETA1+P*DELTHE
      X=XCENT+R*COS(PHI2)
      Y=YCENT+R*SIN(PHI2)
      K=K+1
      PX(K)=X
      PY(K)=Y
 3010 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'IND2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPOVA3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)K
 9014 FORMAT('K = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,K
      WRITE(ICOUT,9016)I,PX(I),PY(I)
 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9022)XCENT,YCENT,R
 9022 FORMAT('XCENT,YCENT,R = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPOVAL(IHARG,IARGT,ARG,NUMARG,
     1PXSTAR,PYSTAR,
     1PXEND,PYEND,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG,
     1IGRASW,IDIASW,
     1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
CCCCC ADD FOLLOWING LINE JULY 1997.
     1UNITSW,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DRAW ONE OR MORE OVALS
C              (DEPENDING ON HOW MANY NUMBERS ARE PROVIDED).
C              THE COORDINATES ARE IN STANDARDIZED UNITS
C              OF 0 TO 100.
C     NOTE--THE INPUT COORDINATES DEFINE 3 SUCCESSIVE POINTS
C           AROUND THE OVAL--AT THE ENDS OF AXES.
C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 3
C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*3 = 6.
C     NOTE--IF 4 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN OVAL WILL GO
C           FROM THE LAST CURSOR POSITION
C           (ASSUMED TO BE AT ONE END OF MAJOR AXIS)
C           THROUGH THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIRST AND SECOND NUMBERS
C           (ASSUMED TO BE AT ONE END OF MINOR AXIS),
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS
C           (ASSUMED TO BE AT THE OTHER END OF MAJOR AXIS),
C           AND THEN BACK TO THE OTHER END OF THE MINOR AXIS,
C           AND CONTINUING BACK THE START POINT TO CLOSE THE OVAL.
C     NOTE--IF 6 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN OVAL WILL GO
C           FROM THE ABSOLUTE (X,Y) POSITION
C           AS RESULTING FORM THE FIRST AND SECOND NUMBERS
C           (ASSUMED TO BE AT ONE END OF MAJOR AXIS),
C           THROUGH THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS
C           (ASSUMED TO BE AT ONE END OF MINOR AXIS),
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIFTH AND SIXTH NUMBERS
C           (ASSUMED TO BE AT THE OTHER END OF MAJOR AXIS),
C           AND THEN BACK TO THE OTHER END OF THE MINOR AXIS,
C           AND CONTINUING BACK THE START POINT TO CLOSE THE OVAL.
C     NOTE--AND SO FORTH FOR 10, 14, 18, ... NUMBERS.
C     INPUT  ARGUMENTS--IHARG
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PXSTAR
C                     --PYSTAR
C     OUTPUT ARGUMENTS--PXEND
C                     --PYEND
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --NOVEMBER  1982.
C     UPDATED         --JANUARY   1989.  CALL LIST FOR OFFSET VAR (ALAN)
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C     UPDATED         --JULY      1997.  SUPPORT FOR "DATA" UNITS (ALAN)
C
C-----NON-COMMON VARIABLES-----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
CCCCC ADD FOLLOWING LINE JULY 1997.
      CHARACTER*4 UNITSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IFIG
      CHARACTER*4 IBELSW
      CHARACTER*4 IERASW
      CHARACTER*4 IBACCO
      CHARACTER*4 ICOPSW
      CHARACTER*4 ITYPEO
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
      IERRG4=IERROR
CCCCC IBUGG4=IBUGD2
CCCCC ISUBG4=ISUBRO
C
      ILOCFN=0
      NUMNUM=0
C
      X1=0.0
      Y1=0.0
      X2=0.0
      Y2=0.0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'OVAL')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPOVAL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMARG
   53 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I),IARGT(I),ARG(I)
   56 FORMAT('I,IHARG(I),IARGT(I),ARG(I) = ',I8,2X,A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,57)PXSTAR,PYSTAR
   57 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)PXEND,PYEND
   58 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)IGRASW,IDIASW
   76 FORMAT('IGRASW,IDIASW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)PGRAXF,PGRAYF,PDIAXC,PDIAYC
   77 FORMAT('PGRAXF,PGRAYF,PDIAXC,PDIAYC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,78)PDIAHE,PDIAWI,PDIAVG,PDIAHG
   78 FORMAT('PDIAHE,PDIAWI,PDIAVG,PDIAHG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80)NUMDEV
   80 FORMAT('NUMDEV= ',I8)
      CALL DPWRST('XXX','BUG ')
      DO81I=1,NUMDEV
      WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
   82 FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I)
   83 FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I)
   84 FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
      WRITE(ICOUT,87)IFOUND
   87 FORMAT('IFOUND= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4
   88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGD2,IERROR
   89 FORMAT('IBUGD2,IERROR= ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFIG='OVAL'
      NUMPT=3
      NUMPT2=2*NUMPT
C
C               ********************************
C               **  STEP 0--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
C  AUGUST 1988.  ADD OFFSET VARIABLE
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               ************************************
C               **  STEP 1--                      **
C               **  CARRY OUT OPENING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      CALL DPOPDE
C
      IBELSW='OFF'
      NUMRIN=0
      IERASW='OFF'
      IBACCO='JUNK'
C
      CALL DPOPPL(IGRASW,
     1IBELSW,NUMRIN,IERASW,
     1IBACCO)
C
C               *****************************************
C               **  STEP 2--                           **
C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
C               *****************************************
C
      IF(NUMARG.GE.2.AND.
     1IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1111
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ABSO'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1112
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'RELA'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1113
      GOTO1130
C
 1111 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=1
      GOTO1119
C
 1112 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=2
      GOTO1119
C
 1113 CONTINUE
      ITYPEO='RELA'
      ILOCFN=2
      GOTO1119
 1119 CONTINUE
C
      IF(ILOCFN.GT.NUMARG)GOTO1129
      DO1120I=ILOCFN,NUMARG
      IF(IARGT(I).EQ.'NUMB')GOTO1120
      GOTO1129
 1120 CONTINUE
      IFOUND='YES'
      GOTO1149
 1129 CONTINUE
      GOTO1130
C
 1130 CONTINUE
      IERRG4='YES'
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPOVAL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ILLEGAL FORM FOR DRAW ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1134)
 1134 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('      SUPPOSE IT IS DESIRED TO DRAW AN OVAL ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      WITH ONE END OF MAJOR AXIS AT THE POINT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      ONE END OF THE MINOR AXIS AT THE POINT 30 10')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1138)
 1138 FORMAT('      AND WITH THE OTHER END OF THE MAJOR AXIS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1139)
 1139 FORMAT('      AT THE POINT 40 20')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      OVAL 20 20 30 10 40 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      OVAL ABSOLUTE 20 20 30 10 40 20 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1149 CONTINUE
C
C               ****************************
C               **  STEP 3--              **
C               **  DRAW OUT THE LINE(S)  **
C               ****************************
C
      NUMNUM=NUMARG-ILOCFN+1
      IF(NUMNUM.LT.NUMPT2)GOTO1151
      GOTO1152
C
 1151 CONTINUE
      J=ILOCFN-1
      X1=PXSTAR
      Y1=PYSTAR
      GOTO1159
C
 1152 CONTINUE
      J=ILOCFN
      IF(J.GT.NUMARG)GOTO1190
      X1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR)
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR)
      GOTO1159
 1159 CONTINUE
C
 1160 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X2=X1+X2
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
C
 1170 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X3=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X3,X3,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X3=X2+X3
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y3=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y3,Y3,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y3=Y2+Y3
C
      CALL DPOVA2(X1,Y1,X2,Y2,X3,Y3,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      X1=X3
      Y1=Y3
C
      GOTO1160
 1190 CONTINUE
C
      PXEND=X3
      PYEND=Y3
C
C               ************************************
C               **  STEP 4--                      **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSW='OFF'
      NUMCOP=0
      CALL DPCLPL(ICOPSW,NUMCOP,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
 8000 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'OVAL')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPOVAL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOCFN,NUMNUM
 9012 FORMAT('ILOCFN,NUMNUM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X1,Y1,X2,Y2,X3,Y3
 9013 FORMAT('X1,Y1,X2,Y2,X3,Y3 = ',6E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PXSTAR,PYSTAR
 9015 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PXEND,PYEND
 9016 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IFIG
 9017 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)IFOUND
 9027 FORMAT('IFOUND = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGG4,ISUBG4,IERRG4
 9028 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGD2,IERROR
 9029 FORMAT('IBUGD2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
