xref: /dports/graphics/dataplot/dataplot-2c1b27601a3b7523449de612613eadeead9a8f70/src/dp4.F

      COMPLEX FUNCTION C9LGMC(ZIN)
C***BEGIN PROLOGUE  C9LGMC
C***DATE WRITTEN   780401   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  C7A
C***KEYWORDS  COMPLETE GAMMA FUNCTION,COMPLEX,CORRECTION TERM,
C             GAMMA FUNCTION,LOGARITHM,SPECIAL FUNCTION
C***AUTHOR  FULLERTON, W., (LANL)
C***PURPOSE  Computes the LOG GAMMA correction term for most Z so that
C            CLOG(CGAMMA(Z)) = 0.5*LOG(2.*PI) + (Z-0.5)*CLOG(Z) - Z
C            + C9LGMC(Z)
C***DESCRIPTION
C
C Compute the LOG GAMMA correction term for large CABS(Z) when REAL(Z)
C .GE. 0.0 and for large ABS(AIMAG(Y)) when REAL(Z) .LT. 0.0.  We find
C C9LGMC so that
C   CLOG((Z)) = 0.5*LOG(2.*PI) + (Z-0.5)*CLOG(Z) - Z + C9LGMC(Z)
C***REFERENCES  (NONE)
C***ROUTINES CALLED  R1MACH,XERROR
C***END PROLOGUE  C9LGMC
      COMPLEX ZIN, Z, Z2INV
      DIMENSION BERN(11)
C
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOP2.INC'
C
      DATA BERN( 1) /    .08333333333 3333333E0   /
      DATA BERN( 2) /   -.002777777777 7777778E0  /
      DATA BERN( 3) /    .0007936507936 5079365E0 /
      DATA BERN( 4) /   -.0005952380952 3809524E0 /
      DATA BERN( 5) /    .0008417508417 5084175E0 /
      DATA BERN( 6) /   -.001917526917 5269175E0  /
      DATA BERN( 7) /    .006410256410 2564103E0  /
      DATA BERN( 8) /   -.02955065359 4771242E0   /
      DATA BERN( 9) /    .1796443723 6883057E0    /
      DATA BERN(10) /  -1.392432216 9059011E0     /
      DATA BERN(11) /  13.40286404 4168392E0      /
      DATA NTERM, BOUND, XBIG, XMAX / 0, 3*0.0 /
C***FIRST EXECUTABLE STATEMENT  C9LGMC
C
      C9LGMC = (0.0, 0.0)
C
CCCCC IERR2=0
      IF (NTERM.NE.0) GO TO 10
C
      NTERM = INT(-0.30*LOG(R1MACH(3)))
      BOUND = 0.1170*FLOAT(NTERM)*
     1  (0.1*R1MACH(3))**(-1./(2.*FLOAT(NTERM)-1.))
      XBIG = 1.0/SQRT(R1MACH(3))
      XMAX = EXP (AMIN1(LOG(R1MACH(2)/12.0), -LOG(12.*R1MACH(1))) )
C
 10   Z = ZIN
      X = REAL (Z)
      Y = AIMAG(Z)
      CABSZ = CABS(Z)
C
      IF (X.LT.0.0 .AND. ABS(Y).LT.BOUND)THEN
CCCCC CALL XERROR (  'C9LGMC  C9LGMC
CCCCC1 NOT VALID FOR NEGATIVE REAL(Z) AND SMALL ABS(AIMAG(Z))', 69, 2,2)
        WRITE(ICOUT,11)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,12)
        CALL DPWRST('XXX','BUG ')
CCCCC   IERR2=1
        RETURN
      ENDIF
   11 FORMAT('***** INTERNAL ERROR FROM C9LGMC: C9LGMC NOT ',
     1       'VALID FOR NEGATIVE REAL(Z) AND')
   12 FORMAT('      SMALL ABS(AIMZ(Z))')
C
      IF (CABSZ.LT.BOUND) THEN
CCCCC CALL XERROR ( 'C9LGMC  C9LGMC NOT VALID FOR SM
CCCCC1ALL CABS(Z)', 42, 3, 2)
        WRITE(ICOUT,21)
        CALL DPWRST('XXX','BUG ')
CCCCC   IERR2=1
        RETURN
      ENDIF
   21 FORMAT('***** INTERNAL ERROR FROM C9LGMC: C9LGMC NOT ',
     1       'VALID FOR SMALL ABS(AIMZ(Z))')
C
      IF (CABSZ.GE.XMAX) GO TO 50
C
      IF (CABSZ.GE.XBIG) C9LGMC = 1.0/(12.0*Z)
      IF (CABSZ.GE.XBIG) RETURN
C
      Z2INV = 1.0/Z**2
      C9LGMC = (0.0, 0.0)
      DO 40 I=1,NTERM
        NDX = NTERM + 1 - I
        C9LGMC = BERN(NDX) + C9LGMC*Z2INV
 40   CONTINUE
C
      C9LGMC = C9LGMC/Z
      RETURN
C
 50   C9LGMC = (0.0, 0.0)
CCCCC CALL XERROR ( 'C9LGMC  Z SO BIG C9LGMC UNDERFLOWS', 34, 1, 1)
      WRITE(ICOUT,51)
      CALL DPWRST('XXX','BUG ')
CCCCC IERR2=2
   51 FORMAT('***** INTERNAL WARNING FROM C9LGMC: Z SO BIG ',
     1       'THAT C9LGMC UNDERFLOWS')
      RETURN
C
      END
      SUBROUTINE CALCPT(PX1,PY1,AX1,AY1,ISUBN0)
C
C     THIS ROUTINE IS A MODIFIED VERSION OF CALCPT.  IT IS USED
C     ONLY BY THE "CALCOMP" DEVICES (CALCOMP, ZETA) USING THE
C     STANDARD "CALCOMP ROUTINES".
C     CALCPT CONVERTS FROM DATAPLOT
C     UNITS TO DEVICE INTEGER UNITS, BUT IT ALSO APPLIES "WINDOW"
C     TRANSFORMATIONS NEEDED BY THE "MULTI-PLOT" AND "WINDOW
C     COORDINATE" COMMANDS.  THE CALCOMP COORDINATES NEED TO BE
C     TRANSLATED TO INCHES.
C
C     PURPOSE--TRANSLATE THE STANDARDIZED (0.0 TO 100.0) COORDINATES (PX1,PY1)
C              INTO (INTEGER PICTURE POINT) DEVICE COORDINATES (AX1,AY1)
C     ISUBN0 = NAME OF SUBROUTINE WHICH CALLED GRWRST.
C              (AND THEREBY HAVE WALKBACK INFORMATION).
C     NOTE--THE ONLY VARIABLES IN THE    PLOT CONTROL COMMON
C           THAT ARE USED HEREIN ARE THE ONES IN /RWIND/
C
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED--SEPTEMBER 1986.
C     UPDATED--APRIL     1992.  COMMENT OUT PWX1 LINES
C     UPDATED--APRIL     1992.  COMMENT OUT 9000 CONTINUE
C     UPDATED--APRIL     1992.  GIVE VALUES TO X1 AND Y1
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 ISUBN0
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED APRIL 1992
      X1=-999.0
      Y1=-999.0
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'LCPT')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF CALCPT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ISUBN0
   52 FORMAT('ISUBN0 (NAME OF THE CALLING SUBROUTINE) = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IMANUF,IMODEL
   53 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMHPP,NUMVPP
   54 FORMAT('NUMHPP,NUMVPP = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)ANUMHP,ANUMVP
   55 FORMAT('ANUMHP,ANUMVP = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)PX1,PY1
   56 FORMAT('PX1,PY1 = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)PWXMIN,PWXMAX,PWYMIN,PWYMAX
   61 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)IBUGG4
   69 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C              **************************************
C              **  STEP 0--                        **
C              **  DETERMINE THE DIMENSION OF THE  **
C              **  IN INCHES                       **
C              **************************************
C
      DOTPPI=1000.
      XPAGE=ANUMHP/DOTPPI
      YPAGE=ANUMVP/DOTPPI
C
C               *************************************
C               **  STEP 1--                       **
C               **  CARRY OUT THE TRANSFORMATION.  **
C               *************************************
C
      AX1=PWXMIN+(PX1/100.0)*(PWXMAX-PWXMIN)
      IF(AX1.LE.0.0)AX1=0.0
      IF(AX1.GE.100.)AX1=100.
C
      AY1=PWYMIN+(PY1/100.0)*(PWYMAX-PWYMIN)
      IF(AY1.LE.0.0)AY1=0.0
      IF(AY1.GE.100.)AY1=100.
C
C              **************************************
C              **  STEP 2--                        **
C              **  CONVERT TO INCH FORMAT          **
C              **************************************
C
      AX1=XPAGE*(AX1/100.)
      AY1=YPAGE*(AY1/100.)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT APRIL 1992
C9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'LCPT')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF CALCPT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IMANUF,IMODEL
 9012 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NUMHPP,NUMVPP
 9013 FORMAT('NUMHPP,NUMVPP = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ANUMHP,ANUMVP
 9014 FORMAT('ANUMHP,ANUMVP = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PX1,PY1
 9015 FORMAT('PX1,PY1   = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT  APRIL 1992 (ALAN)
CCCCC WRITE(ICOUT,9016)PWX1,PWY1
C9016 FORMAT('PWX1,PWY1 = ',E15.7,E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)X1,Y1
 9017 FORMAT('X1,Y1     = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)AX1,AY1
 9018 FORMAT('AX1,AY1   = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)PWXMIN,PWXMAX,PWYMIN,PWYMAX
 9021 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      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 CALCTR(IA,IH,NLEN)
C
C  CALCTR WILL CONVERT A CHARACTER VARIABLE OR QUOTED STRING
C  TO HOLLERITH FORMAT.  IT IS REQUIRED FOR THE CALCOMP LIBRARY
C  ROUTINES SINCE A FEW FORTRAN COMPILERS WILL NOT ALLOW CHARACTER
C  VARIABLES TO BE PASSED TO HOLLERITH ARRAYS (E.G., NOS/VE FORTRAN).
C  THE DIMENSION OF "ITEMP" IS MACHINE DEPENDENT
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
      CHARACTER*10 FMT1,FMT2
      CHARACTER*(*) IA
      INTEGER IH(*)
C
C  DIMENSION ITEMP TO "NUMCPW", I.E., THE NUMBER OF CHARACTERS PER WORD
C
      CHARACTER*8 ITEMP
C
CCCCC NLEN=LEN(IA)
      NWORDS=NLEN/NUMCPW
      NREM=MOD(NLEN,NUMCPW)
      ITEMP=' '
      IF(NWORDS.GT.99)NWORDS=99
      IF(NWORDS.LT.0)NWORDS=0
      IF(NREM.GT.0)ITEMP(1:NREM)=IA(NWORDS*NUMCPW+1:NWORDS*NUMCPW+NREM)
      FMT1='(  A  )'
      WRITE(FMT1(2:3),'(I2)')NWORDS
      WRITE(FMT1(5:6),'(I2)')NUMCPW
      FMT2='(A  )'
      WRITE(FMT2(3:4),'(I2)')NREM
C
      IF(NWORDS.GE.1)READ(IA,FMT1)(IH(J),J=1,NWORDS)
      IF(NREM.GT.0)READ(ITEMP,FMT2)IH(NWORDS+1)
C
      RETURN
      END
      SUBROUTINE CANDIS(X,Y,N,IWRITE,STATVA,IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CANBERRA DISTANCE BETWEEN THE
C              TWO SETS OF DATA IN THE INPUT VECTORS X AND Y.  THE
C              SAMPLE CANBERRA DISTANCE WILL BE A SINGLE PRECISION VALUE
C              CALCULATED AS:
C
C                 DISTANCE = SUM[i=1 to n][(|X(i) - Y(i)|)/(|X(i)| + |Y(i)|)]
C
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                                (UNSORTED) OBSERVATIONS WHICH
C                                CONSTITUTE THE FIRST SET OF DATA.
C                     --Y      = THE SINGLE PRECISION VECTOR OF
C                                (UNSORTED) OBSERVATIONS WHICH
C                                CONSTITUTE THE SECOND SET OF DATA.
C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTORS X AND Y.
C     OUTPUT ARGUMENTS--STATVA = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE COSINE DISTANCE
C                                BETWEEN THE TWO SETS OF DATA IN THE
C                                INPUT VECTORS X AND Y.  THIS SINGLE
C                                PRECISION VALUE WILL BE BETWEEN 0.0
C                                AND 1.0 (INCLUSIVELY).
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE CANBERRA DISTANCE BETWEEN THE 2 SETS
C             OF DATA IN THE INPUT VECTORS X AND Y.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--ABS.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--Lance, G. N.; Williams, W. T. (1966). "Computer programs for
C                 hierarchical polythetic classification ("similarity
C                 analysis")", Computer Journal, Vol. 9, No. 1, pp. 60-64.
C               --Lance, G. N.; Williams, W. T. (1967). "Mixed-data
C                 classificatory programs I.) Agglomerative Systems",
C                 Australian Computer Journal, pp. 15-20.
C     WRITTEN BY--ALAN HECKERT
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGYS
C                 GAITHERSBURG, MD 20899
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGYS.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2018/08
C     ORIGINAL VERSION--AUGUST    2018.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
      DIMENSION Y(*)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='CAND'
      ISUBN2='IS  '
      IERROR='NO'
      STATVA=CPUMIN
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'NDIS')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF CANDIS--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA3,ISUBRO,N
   52   FORMAT('IBUGA3,ISUBRO,N = ',2(A4,2X),I8)
        CALL DPWRST('XXX','BUG ')
        DO55I=1,N
          WRITE(ICOUT,56)I,X(I),Y(I)
   56     FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
          CALL DPWRST('XXX','BUG ')
   55   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      AN=N
C
      IF(N.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,111)
  111   FORMAT('***** ERROR IN CANBERRA DISTANCE--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,112)
  112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE RESPONSE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,113)
  113   FORMAT('      VARIABLES IS LESS THAN 1.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,117)N
  117   FORMAT('      THE NUMBER OF OBSERVATIONS HERE = ',I8,'.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ************************************************
C               **  STEP 2--                                  **
C               **  COMPUTE THE MANHATTAN DISTANCE.           **
C               ************************************************
C
      STATVA=0.0
      DO200I=1,N
        TERM1=ABS(X(I) - Y(I))
        TERM2=ABS(X(I))
        TERM3=ABS(Y(I))
        STATVA=STATVA + TERM1/(TERM2 + TERM3)
  200 CONTINUE
C
C               *******************************
C               **  STEP 3--                 **
C               **  WRITE OUT A LINE         **
C               **  OF SUMMARY INFORMATION.  **
C               *******************************
C
      IF(IFEEDB.EQ.'ON' .AND. IWRITE.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,811)N,STATVA
  811   FORMAT('THE CANBERRA DISTANCE OF THE ',I8,
     1           ' OBSERVATIONS = ',G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'NDIS')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF CANDIS--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IERROR,STATVA
 9012   FORMAT('IERROR,STATVA = ',A4,2X,G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE CANTOR(N,X,P,ANUM,IERROR)
C
CCCCC ***** NOTE--THIS SUBROUTINE IS CURRENTLY (APRIL 1989)
CCCCC             ONLY VALID FOR P = 0.33333.
CCCCC             TO BE DONE--GENERALIZE FOR ALL P BETWEEN 0 AND 1.
C
C     PURPOSE--THIS SUBROUTINE GENERATES N CANTOR NUMBERS
C              (A CLASSIC CHAOS THEORY SET)
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
C                                OF CANTOR SET NUMBERS
C                                TO BE GENERATED.
C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
C                                (OF DIMENSION AT LEAST N)
C                                INTO WHICH THE GENERATED
C                                CANTOR NUMBERS
C                                WILL BE PLACED.
C                     --P      = THE FRACTIONAL SIZE OF THE HOLE
C                                IN THE MIDDLE OF THE UNIT INTERVAL
C                                (P MUST BE BETWEEN 0 AND 1).
C     OUTPUT--N CANTOR SET NUMBERS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     LANGUAGE--ANSI FORTRAN (1977)
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89.6
C     ORIGINAL VERSION--APRIL 1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
      DIMENSION ANUM(*)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      CPUMA3=CPUMAX/3.0
C
C               ******************************************
C               **  TREAT THE CANTOR SET CASE    **
C               ******************************************
C
C               *******************************************
C               **  STEP 1--                             **
C               **  TEST THE INPUT ARGUMENTS FOR ERRORS  **
C               *******************************************
C
      IF(N.GE.1)GOTO190
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,101)
  101 FORMAT('***** ERROR IN CANTOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,102)
  102 FORMAT('      THE SIZE OF THE DESIRED SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,103)
  103 FORMAT('      OF CANTOR NUMBERS MUST BE 1 OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,104)
  104 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,105)N
  105 FORMAT('      N = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  190 CONTINUE
C
C               ******************************
C               **  STEP 2--                **
C               **  GENERATE THE SET   **
C               ******************************
C
CCCCC ***** CURRENTLY ONLY VALID FOR P = 1/3
CCCCC ***** UPDATE THIS FOR GENERAL P
C
CCCCC PLOCAL=P
      IF(P.NE.0.33333)THEN
        PLOCAL=0.33333
      ELSE
        PLOCAL=P
      ENDIF
      R=2.0/(1.0-PLOCAL)
      ICOUNT=0
C
      K=1
      DENOM=R**K
      ANUM(1)=1.0
      ICOUNT=ICOUNT+1
      X(ICOUNT)=ANUM(1)/DENOM
      IF(N.LE.1)GOTO1900
C
      DO1100K=2,20
      DENOM=R**K
      LMAX=2**(K-1)
      LMIN=(LMAX/2)+1
      L2=0
      DO1200L=LMIN,LMAX
      L2=L2+1
      L3=LMIN-L2
      AMIRRO=ANUM(L3)
      ANUM(L)=DENOM-1.0-AMIRRO
 1200 CONTINUE
      DO1300L=1,LMAX
      ICOUNT=ICOUNT+1
      RATIO=ANUM(L)/DENOM
      IF(X(ICOUNT).GE.CPUMA3)GOTO1350
      X(ICOUNT)=RATIO
      IF(ICOUNT.GE.N)GOTO1900
 1300 CONTINUE
 1100 CONTINUE
C
 1350 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1351)
 1351 FORMAT('***** ERROR IN CANTOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1352)
 1352 FORMAT('      A NUMBER IN THE CANTOR SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1353)
 1353 FORMAT('      HAS JUST EXCEEDED THE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1354)
 1354 FORMAT('      LARGEST FLOATING POINT NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1355)
 1355 FORMAT('      ALLOWABLE FOR THIS COMPUTER (',E15.7,').')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1356)
 1356 FORMAT('      THE VALUE CAUSING THE OVERFLOW WAS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1357)ICOUNT
 1357 FORMAT('      THE ',I8,'-TH NUMBER IN THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1358)
 1358 FORMAT('      CANTOR SET.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1900 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      RETURN
      END
      FUNCTION CARG(Z)
C***BEGIN PROLOGUE  CARG
C***DATE WRITTEN   770401   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  A4A
C***KEYWORDS  ARGUMENT,COMPLEX,COMPLEX NUMBER,ELEMENTARY FUNCTION
C***AUTHOR  FULLERTON, W., (LANL)
C***PURPOSE  Computes the argument of a complex number.
C***DESCRIPTION
C
C CARG(Z) calculates the argument of the complex number Z.  Note
C that CARG returns a real result.  If Z = X+iY, then CARG is ATAN(Y/X),
C except when both X and Y are zero, in which case the result
C will be zero.
C***REFERENCES  (NONE)
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  CARG
      COMPLEX Z
C***FIRST EXECUTABLE STATEMENT  CARG
      CARG = 0.0
      IF (REAL(Z).NE.0. .OR. AIMAG(Z).NE.0.) CARG =
     1  ATAN2 (AIMAG(Z), REAL(Z))
C
      RETURN
      END
      SUBROUTINE CATCHR(AMAT1,AMAT2,AMAT3,Y1,Y2,INDX,
     1MAXROM,MAXCOM,NR1,NC1,
     1IBUGA3,IERROR)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              CATCHER MATRIX:
C              C = X(X'X)**(-1)
C              THIS MATRIX IS USEFUL FOR MANY REGRESSION DIAGNOSTIC
C              CAPABILITIES.
C     INPUT  ARGUMENTS--AMAT1  = THE DESIGN MATRIX (X)
C                     --AMAT2  = A SCRATCH MATRIX
C                     --Y1     = A SCRATCH VECTOR
C                     --Y2     = A SCRATCH VECTOR
C                     --INDX   = A SCRATCH INTEGER) VECTOR
C                     --MAXROM = THE INTEGER ROW DIMENSION OF AMAT1
C                     --MAXCOM = THE INTEGER COUMN DIMENSION OF AMAT1
C                     --NR1    = THE INTEGER NUMBER OF ROWS OF AMAT1
C                     --NC1    = THE INTEGER NUMBER OF COLUMNS OF AMAT1
C     OUTPUT ARGUMENTS--AMAT3  = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED CATCHER MATRTIX
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUES OF THE
C             CATCHER MATRIX.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     LANGUAGE--ANSI FORTRAN (1977)
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2002.6
C     ORIGINAL VERSION--JUNE      2002.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION AMAT1(MAXROM,MAXCOM)
      DIMENSION AMAT2(MAXROM,MAXCOM)
      DIMENSION AMAT3(MAXROM,MAXCOM)
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      INTEGER   INDX(*)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
      DATA ZERO /0.0/
      DATA ONE  /1.0/
      DATA EPS  /1.0E-20/
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON')THEN
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF CATCHR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXROM,MAXCOM,NR1,NC1
   53 FORMAT('MAXROM, MAXCOM, NR1, NC1 = ',4I8)
      CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               **********************************
C               **  COMPUTE CATCHER MATRIX      **
C               **  1) COMPUTE X'X              **
C               **  2) COMPUTE INVERSE OF X'X   **
C               **  3) COMPUTE X TIMES INVERSE  **
C               **********************************
C
      DO110J=1,MAXCOM
        DO120I=1,MAXROM
          AMAT2(I,J)=ZERO
  120   CONTINUE
  110 CONTINUE
C
      CALL SGEMM ('T', 'N', NC1, NC1, NR1, ONE, AMAT1, MAXROM,
     $             AMAT1, MAXROM, ZERO, AMAT2, MAXROM, IERROR)
      IF(IERROR.EQ.'YES')RETURN
C
      IF(IBUGA3.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,151)
  151   FORMAT('***** IN CATCHR, AFTER CALL SGEMM--')
        CALL DPWRST('XXX','BUG ')
        DO 152 I=1,NC1
          WRITE(ICOUT,153)I,(AMAT2(I,J),J=1,MIN(5,NC1))
  153     FORMAT('***** I,AMAT2(I,1..MIN(NC1,5)',I8,5E15.7)
          CALL DPWRST('XXX','BUG ')
  152   CONTINUE
      ENDIF
C
      RCOND=0.0
      CALL SGECO(AMAT2,MAXROM,NC1,INDX,RCOND,Y1)
C
      IF(IBUGA3.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,171)RCOND
  171   FORMAT('***** IN CATCHR, AFTER CALL SGECO, RCOND=',E15.7)
        CALL DPWRST('XXX','BUG ')
        DO 172 I=1,NC1
          WRITE(ICOUT,173)I,(AMAT2(I,J),J=1,MIN(5,NC1))
  173     FORMAT('***** I,AMAT2(I,1..MIN(NC1,5)',I8,5E15.7)
          CALL DPWRST('XXX','BUG ')
  172   CONTINUE
      ENDIF
C
      IF(RCOND.LE.EPS)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5171)
        CALL DPWRST('XXX','ERRO ')
        WRITE(ICOUT,5172)
        CALL DPWRST('XXX','ERRO ')
        WRITE(ICOUT,5173)
        CALL DPWRST('XXX','ERRO ')
        IERROR='YES'
        GOTO9000
      ENDIF
 5171 FORMAT('*** ERROR FROM CATCHR: UNABLE TO COMPUTE THE INVERSE OF ',
     1       'THE X-TRANSPOSE*X MATRIX.')
 5172 FORMAT('    PROBLEM: SOME COLUMNS ARE LINEARLY DEPDENDENT ON ',
     1       ' OTHER COLUMNS.')
 5173 FORMAT('    SUGGESTED SOLUTION: WORK WITH A SUBSET OF THE ',
     1       'ORIGINAL COLUMNS.')
C
      IJOB=1
      CALL SGEDI(AMAT2,MAXROM,NC1,INDX,Y1,Y2,IJOB)
C
      IF(IBUGA3.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,181)
  181   FORMAT('***** IN CATCHR, AFTER CALL SGEDI')
        CALL DPWRST('XXX','BUG ')
        DO 182 I=1,NC1
          WRITE(ICOUT,183)I,(AMAT2(I,J),J=1,MIN(5,NC1))
  183     FORMAT('***** I,AMAT2(I,1..MIN(NC1,5)',I8,5E15.7)
          CALL DPWRST('XXX','BUG ')
  182   CONTINUE
      ENDIF
C
      CALL SGEMM ('N', 'N', NR1, NC1, NC1, ONE, AMAT1, MAXROM,
     $             AMAT2, MAXROM, ZERO, AMAT3, MAXROM, IERROR)
      IF(IERROR.EQ.'YES')RETURN
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 CATCHR--')
      CALL DPWRST('XXX','BUG ')
      DO9022I=1,NR1
        WRITE(ICOUT,9023)I,(AMAT3(I,J),J=1,MIN(5,NC1))
 9023   FORMAT('***** I,AMAT3(I,1..MIN(NC1,5)',I8,5E15.7)
        CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
      WRITE(ICOUT,9012)IBUGA3,IERROR
 9012 FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE CATLAN(DX,DCATLN)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CATLAN BETA FUNCTION
C              FOR REAL ARGUMENTS GREATER THAN OR EQUAL TO 1 USING
C              EULER-MACMACLAURIN SUMMATION.
C              CATLAN(X)=SUM((-1)**(K-1)/(2*K+1)**X)  WHERE THE SUM IS FROM
C                      0 TO INFINITY
C              FOR BETTER COMPUTATIONAL ACCURACY, ACTUALLY
C              COMPUTE CATLAN(X) - 1.
C     INPUT  ARGUMENTS--DX     = THE DOUBLE PRECISION VALUE AT
C                                WHICH THE CATLAN
C                                FUNCTION IS TO BE EVALUATED.
C     OUTPUT ARGUMENTS--DCATLN  = THE DOUBLE PRECISION ZETA
C                                FUNCTION VALUE.
C     OUTPUT--THE DOUBLE PRECISION CATLAN
C             FUNCTION VALUE DCATLN.
C     PRINTING--NONE.
C     RESTRICTIONS--NONE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY APPLIED MATHEMATICS
C                 SERIES 55, 1964.
C               --THOMPSON, "ATLAS FOR COMPUTING MATHEMATICAL
C                 FUNCTIONS", WILEY, 1997.  THIS ROUTINE IS A
C                 FORTRAN TRANSLATION OF THE C FUNCTION ON PAGE 150
C                 OF THIS BOOK.
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     LANGUAGE--ANSI FORTRAN (1966)
C     VERSION NUMBER--97.9
C     ORIGINAL VERSION--SEPTEMBER 1997.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
C
      INCLUDE 'DPCOP2.INC'
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA DEPS/1.0D-20/
C
C-----START POINT-----------------------------------------------------
C
      IF(DX.EQ.1.0D0)THEN
        DCATLN=-0.214601836603
        RETURN
      ENDIF
      DP=1.0
      CALL CATLN2(DEPS,DP,DX,DTERM1)
      DP=-1.0
      CALL CATLN2(DEPS,DP,DX,DTERM2)
C
CCCCC COMPUTE CATLAN(X) - 1 FOR BETTER ACCURACY.
CCCCC DCATLN=DSUM+1.0D0
      DCATLN=DTERM1 - DTERM2
      RETURN
      END
      SUBROUTINE CATLN2(DEPS,DP,DX,DSUM)
C
C     PURPOSE--THIS SUBROUTINE IS USED THE CATLAN SUBROUTINE
C              IN COMPUTING THE CATLAN BETA FUNCTION.
C     INPUT  ARGUMENTS--DX     = THE DOUBLE PRECISION VALUE AT
C                                WHICH THE CATLAN
C                                FUNCTION IS TO BE EVALUATED.
C                       DP     = EITHER +1 OR -1
C                       DEPS   = USED TO CONTROL PREFISION
C     OUTPUT ARGUMENTS--DSUM    = SUM RETURNED TO TO THE CATLAN ROUTINE
C     OUTPUT--THE DOUBLE PRECISION DSUM
C     PRINTING--NONE.
C     RESTRICTIONS--NONE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY APPLIED MATHEMATICS
C                 SERIES 55, 1964.
C               --THOMPSON, "ATLAS FOR COMPUTING MATHEMATICAL
C                 FUNCTIONS", WILEY, 1997.  THIS ROUTINE IS A
C                 FORTRAN TRANSLATION OF THE C FUNCTION ON PAGE 150
C                 OF THIS BOOK.
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     LANGUAGE--ANSI FORTRAN (1966)
C     VERSION NUMBER--97.9
C     ORIGINAL VERSION--SEPTEMBER 1997.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      DTERM=32.0D0*DX*(DX+1.0D0)*(DX+2.0D0)*(DX+3.0D0)*
     1      (DX+4.0D0)/945.0D0
      DN=(DTERM/DEPS)**(1.0D0/(DX+5.0D0))
      IF(DN.LE.5.5D0)THEN
        N=5
      ELSEIF(DN.GE.9999.5)THEN
        N=10000
      ELSE
        N=INT(DN)
      ENDIF
C
      FN=DBLE(N)
      FK=0.0D0
      DNEGX=-DX
      DSUM=0.0D0
      DO100K=1,N-1
        FK=FK+1.0D0
        DSUM=DSUM + (4.0D0*FK+DP)**DNEGX
  100 CONTINUE
C
C  ADD EULER-MACLAURIN CORRECTION TERMS
C
      F4NP=4.0D0*FN+DP
      DSUM=DSUM + (F4NP**DNEGX)*(0.5D0 + 0.25D0*F4NP/(DX-1.0D0)
     1     + DX*(1.0D0 -
     1     4.0D0*(DX+1.0D0)*(DX+2.0D0)/(15.0D0*F4NP*F4NP))/
     1     (3.0D0*F4NP))+DTERM/(F4NP**(DX+5.0D0))
C
      RETURN
      END
      SUBROUTINE CAUCDF(X,CDF)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE FOR THE CAUCHY DISTRIBUTION
C              WITH MEDIAN = 0 AND 75% POINT = 1.
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = (1/PI)*(1/(1+X*X)).
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
C                                WHICH THE CUMULATIVE DISTRIBUTION
C                                FUNCTION IS TO BE EVALUATED.
C     OUTPUT ARGUMENTS--CDF    = THE SINGLE PRECISION CUMULATIVE
C                                DISTRIBUTION FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION
C             FUNCTION VALUE CDF.
C     PRINTING--NONE.
C     RESTRICTIONS--NONE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--ATAN.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN.
C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 154-165.
C     WRITTEN BY--JAMES F. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--APRIL     1994.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C---------------------------------------------------------------------
C
      DATA PI/3.14159265358979/
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS.
C     NO INPUT ARGUMENT ERRORS POSSIBLE
C     FOR THIS DISTRIBUTION.
C
C-----START POINT-----------------------------------------------------
C
      CDF=0.5+((1.0/PI)*ATAN(X))
C
      RETURN
      END
      SUBROUTINE CAUFUN (N, X, FVEC, IFLAG, XDATA, NOBS)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE FUNCTIONS FOR THE
C              CAUCHY MAXIMUM LIKELIHOOD EQUATIONS (FROM
C              P. 310 OF JOHNSON, KOTZ, AND BALKRISHNAN (VOLUME 1).
C
C      SUM[i=1 to n][2*(X(i)-ahat)/(bhat^2+(X(i)-ahat)^2) = 0
C
C      N/BAT - SUM[i=1 to n][2*bhat/(bhat^2 + (X(i)-ahat))^2)] = 0
C
C              FOR COMPUTATIONAL PURPOSES, THESE EQUATIONS ARE
C              REWRITTEN AS:
C
C      SUM[i=1 to n][1/(1 + ((X(i) - THETAHAT)/LAMBDA^2)^2)] - N/2 = 0
C      SUM[i=1 to n][X(i)/(1 + ((X(i) - THETAHAT)/LAMBDA)^2)]
C                    - (N/2)*THETAHAT = 0
C
C              THE MAXIMUM LIKELIHOOD EQUATIONS GIVEN IN HAAS,
C              BAIN, AND ANTLE ARE
C
C      SUM[i=1 to n][((X(i)-AHAT)/BHAT)/(1+(X(I)-AHAT)/BHAT)^2)] = 0
C      SUM[i=1 to n][{1 + (X(i)-AHAT)/BHAT)^2}^(-1)] - (1/2)*N = 0
C
C              CALLED BY SNSQE ROUTINE FOR SOLVING SIMULTANEOUS
C              NONLINEAR EQUATIONS.  NOTE THAT THE CALLING SEQUENCE
C              DID NOT ACCOMODATE A DATA ARRAY (AND ASSCIATED NUMBER OF
C              OBSERVATIONS), SO THESE WERE ADDED TO THE CALL LIST.
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-408.
C              --"CONTINUOUS UNIVARIATE DISTRIBUTIONS--VOLUME I",
C                SECOND EDITION, JOHNSON, KOTZ, AND BALAKRISHNAN,
C                WILEY, 1994,, PP. 310-311.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/3
C     ORIGINAL VERSION--MARCH     2004.
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION X(*)
      DOUBLE PRECISION FVEC(*)
      REAL XDATA(*)
C
      DOUBLE PRECISION DN
      DOUBLE PRECISION DA
      DOUBLE PRECISION DB
      DOUBLE PRECISION DX
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
C  SET IFLAG = 0 FOR JOHNSON, KOTZ, BALAKRISHNAN FORM
C      IFLAG = 1 FOR HAAS, BAIN, AND ANTLE
C
C  COMPUTE SOME SUMS
C
      N=2
C
      DN=DBLE(NOBS)
      DSUM1=0.0D0
      DSUM2=0.0D0
      DA=X(1)
      DB=X(2)
      IFLAG=0
C
      IF(IFLAG.EQ.0)THEN
        DO100I=1,NOBS
          DX=DBLE(XDATA(I))
          DSUM1=DSUM1 + 1.0D0/(1.0D0 + ((DX-DA)/DB)**2)
          DSUM2=DSUM2 + DX/(1.0D0 + ((DX-DA)/DB)**2)
  100   CONTINUE
        FVEC(1) = DSUM1 - DN/2.0D0
        FVEC(2) = DSUM2 - (DN/2.0D0)*DA
      ELSE
        DO200I=1,NOBS
          DX=(DBLE(XDATA(I))-DA)/DB
          DSUM1=DSUM1 + DX/(1.0D0 + DX*DX)
          DSUM2=DSUM2 + 1.0D0/(1.0D0 + DX*DX)
  200   CONTINUE
        FVEC(1) = DSUM1
        FVEC(2) = DSUM2 - 0.5D0*DN
      ENDIF
C
      RETURN
      END
      SUBROUTINE CAULI1(Y,N,ALOC,SCALE,
     1                  ALIK,AIC,AICC,BIC,
     1                  ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE LIKELIHOOD FUNCTION FOR
C              THE CAUCHY DISTRIBUTION.  THIS IS FOR THE RAW DATA
C              CASE (I.E., NO GROUPING AND NO CENSORING).
C
C              IT IS ASSUMED THAT BASIC ERROR CHECKING HAS ALREADY BEEN
C              PERFORMED.
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2010/6
C     ORIGINAL VERSION--JUNE      2010.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DOUBLE PRECISION DX
      DOUBLE PRECISION DS
      DOUBLE PRECISION DU
CCCCC DOUBLE PRECISION DN
      DOUBLE PRECISION DPI
      DOUBLE PRECISION DNP
      DOUBLE PRECISION DLIK
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DTERM2
      DOUBLE PRECISION DTERM3
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
      DATA DPI / 3.1415926535 8979323846 2643383279 503 D0 /
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='CAUL'
      ISUBN2='I1  '
C
      IERROR='NO'
C
      ALIK=-99.0
      AIC=-99.0
      AICC=-99.0
      BIC=-99.0
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'ULI1')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF CAULI1--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3,ISUBRO
   52   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,ALOC,SCALE
   55   FORMAT('N,ALOC,SCALE = ',I8,2G15.7)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,G15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ******************************************
C               **  STEP 1--                            **
C               **  COMPUTE LIKELIHOOD FUNCTION         **
C               ******************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'ULI1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERFLG=0
      IERROR='NO'
      IWRITE='OFF'
C
C     CAUCHY LOG-LIKELIHOOD FUNCTION IS:
C
C     N*LOG(SCALE) - N*LOG(PI) -
C     SUM[i=1 TO N][LOG{SCALE**2 + (X(i) - LOC)**2}]
C
      DN=DBLE(N)
      DS=DBLE(SCALE)
      DU=DBLE(ALOC)
      DTERM1=DN*DLOG(DS) - DN*DLOG(DPI)
      DSUM1=0.0D0
      DO1000I=1,N
        DX=DBLE(Y(I))
        DTERM2=DS**2 + (DX - DU)**2
        DSUM1=DSUM1 + DLOG(DTERM2)
 1000 CONTINUE
C
      DLIK=DTERM1 - DSUM1
      ALIK=REAL(DLIK)
      DNP=2.0D0
      AIC=REAL(-2.0D0*DLIK + 2.0D0*DNP)
      DTERM3=(2.0D0*DNP*(DNP+1.0D0))/(DN-DNP-1.0D0)
      AICC=REAL(-2.0D0*DLIK + 2.0D0*DNP + DTERM3)
      BIC=REAL(-2.0D0*DLIK + DNP*LOG(DN))
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'ULI1')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('**** AT THE END OF CAULI1--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9013)DSUM1,DTERM1,DTERM3
 9013   FORMAT('DSUM1,DTERM1,DTERM3 = ',3G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9014)ALIK,AIC,AICC,BIC
 9014   FORMAT('ALIK,AIC,AICC,BIC = ',4G15.7)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE CAUML1(Y,N,TEMP1,TEMP2,DTEMP1,MAXNXT,
     1XMEAN,XMED,XSD,XMAD,XIQ,XMIN,XMAX,
     1ALOC,ASCALE,ALOCOS,ASCLOS,ALOWOS,SCAWOS,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE ORDER STATISTICS, THE WEIGHTED
C              ORDER STATISTICS, AND THE MAXIMUM LIKELIHOOD ESTIMATES
C              FOR THE CAUCHY DISTRIBUTION FOR THE RAW DATA CASE (I.E.,
C              NO CENSORING AND NO GROUPING).  IT WILL OPTIONALLY RETURN
C              THE CONFIDENCE INTERVALS FOR THE LOCATION AND SCALE
C              PARAMETERS BASED ON THE ANTLE METHOD.
C
C              IT IS ASSUMED THAT BASIC ERROR CHECKING HAS ALREADY BEEN
C              PERFORMED.
C
C              PUT THIS IN A SEPARATE ROUTINE AS IT MAY BE CALLED
C              FROM MULTIPLE PLACES (DPMLDE WILL GENERATE THE OUTPUT
C              FOR THE CAUCHY MLE COMMAND).
C
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--ALAN HECKERT
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2009/10
C     ORIGINAL VERSION--OCTOBER   2009. EXTRACTED AS A SEPARATE
C                                       SUBROUTINE (FROM DPMLDE)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*40 IDIST
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      INTEGER IFLAG
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION TEMP1(*)
      DIMENSION TEMP2(*)
      DOUBLE PRECISION DTEMP1(*)
C
CCCCC DOUBLE PRECISION DN
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION TOL
      DOUBLE PRECISION XPAR(2)
      DOUBLE PRECISION FVEC(2)
C
      EXTERNAL CAUFUN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
      DATA PI/3.14159265358979/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='CAUM'
      ISUBN2='L1  '
      IWRITE='OFF'
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'UML1')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF CAUML1--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,MAXNXT
   52   FORMAT('IBUGA3,ISUBRO,N,MAXNXT = ',2(A4,2X),3I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,G15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ******************************************
C               **  STEP 1--                            **
C               **  CARRY OUT CALCULATIONS              **
C               **  FOR CAUCHY MLE ESTIMATE             **
C               ******************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'UML1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IDIST='CAUCHY'
      IFLAG=0
      CALL SUMRAW(Y,N,IDIST,IFLAG,
     1            XMEAN,XVAR,XSD,XMIN,XMAX,
     1            ISUBRO,IBUGA3,IERROR)
C
      P1=55.65
      CALL PERCEN(P1,Y,N,IWRITE,TEMP2,MAXNXT,XUPPQU,IBUGA3,IERROR)
      P2=100.0 - P1
      CALL PERCEN(P2,Y,N,IWRITE,TEMP2,MAXNXT,XLOWQU,IBUGA3,IERROR)
      CALL MEDIAN(Y,N,IWRITE,TEMP2,MAXNXT,XMED,IBUGA3,IERROR)
      CALL MAD(Y,N,IWRITE,TEMP1,TEMP2,MAXNXT,XMAD,IBUGA3,IERROR)
      CALL LOWQUA(Y,N,IWRITE,TEMP2,MAXNXT,ALOWQU,IBUGA3,IERROR)
      CALL UPPQUA(Y,N,IWRITE,TEMP2,MAXNXT,AUPPQU,IBUGA3,IERROR)
      XIQ=AUPPQU - ALOWQU
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,Y)
      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(Y(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(Y(I))
 3210 CONTINUE
      ALOWOS=REAL(DSUM1)
      SCAWOS=REAL(DSUM2)
C
      IF(N.EQ.3)THEN
        CALL SORT(Y,N,Y)
        X1=Y(1)
        X2=Y(2)
        X3=Y(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,Y)
        X1=Y(1)
        X2=Y(2)
        X3=Y(3)
        X4=Y(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
        JAC=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
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'UML1')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('**** AT THE END OF CAUML1--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9055)N,XMEAN,XMED,XSD,XMAD,XMIN,XMAX
 9055   FORMAT('N,XMEAN,XMED,XSD,XMAD,XMIN,XMAX = ',I8,6G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9056)ALOC,ASCALE,ALOCOS,ASCLOS,ALOWOS,SCAWOS
 9056   FORMAT('ALOC,ASCALE,ALOCOS,ASCLOS,ALOWOS,SCAWOS = ',6G15.7)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE CAUPDF(X,PDF)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY
C              FUNCTION VALUE FOR THE CAUCHY DISTRIBUTION
C              WITH MEDIAN = 0 AND 75% POINT = 1.
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = (1/PI)*(1/(1+X*X)).
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
C                                WHICH THE PROBABILITY DENSITY
C                                FUNCTION IS TO BE EVALUATED.
C     OUTPUT ARGUMENTS--PDF    = THE SINGLE PRECISION PROBABILITY
C                                DENSITY FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY
C             FUNCTION VALUE PDF.
C     PRINTING--NONE.
C     RESTRICTIONS--NONE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN.
C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 154-165.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--APRIL     1994.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C---------------------------------------------------------------------
C
      DATA C/.31830988618379/
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS.
C     NO INPUT ARGUMENT ERRORS POSSIBLE
C     FOR THIS DISTRIBUTION.
C
C-----START POINT-----------------------------------------------------
C
      PDF=C*(1.0/(1.0+X*X))
C
      RETURN
      END
      SUBROUTINE CAUPPF(P,PPF)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE FOR THE CAUCHY DISTRIBUTION
C              WITH MEDIAN = 0 AND 75% POINT = 1.
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = (1/PI)*(1/(1+X*X)).
C              NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION
C              IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE
C              DISTRIBUTION FUNCTION OF THE DISTRIBUTION.
C     INPUT  ARGUMENTS--P      = THE SINGLE PRECISION VALUE
C                                (BETWEEN 0.0 AND 1.0)
C                                AT WHICH THE PERCENT POINT
C                                FUNCTION IS TO BE EVALUATED.
C     OUTPUT ARGUMENTS--PPF    = THE SINGLE PRECISION PERCENT
C                                POINT FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION PERCENT POINT
C             FUNCTION VALUE PPF.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
C     RESTRICTIONS--P SHOULD BE BETWEEN 0.0 AND 1.0, EXCLUSIVELY.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SIN, COS.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION
C                 OF THE LOCATION PARAMETER OF A SYMMETRIC
C                 DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION,
C                 PRINCETON UNIVERSITY), 1969, PAGES 21-44, 229-231.
C               --FILLIBEN, 'THE PERCENT POINT FUNCTION',
C                 (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 154-165.
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     LANGUAGE--ANSI FORTRAN (1966)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JUNE      1972.
C     UPDATED         --SEPTEMBER 1975.
C     UPDATED         --NOVEMBER  1975.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----DATA STATEMENTS-----------------------------------------------------
C
      DATA PI/3.14159265359/
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LE.0.0.OR.P.GE.1.0)GOTO50
      GOTO90
   50 WRITE(ICOUT,1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,46)P
      CALL DPWRST('XXX','BUG ')
      RETURN
   90 CONTINUE
    1 FORMAT('***** FATAL ERROR--THE 1ST INPUT ARGUMENT TO THE ',
     1' CAUPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL')
   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
C
      ARG=PI*P
      PPF=-COS(ARG)/SIN(ARG)
C
      RETURN
      END
      SUBROUTINE CAURAN(N,ISEED,X)
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE CAUCHY DISTRIBUTION
C              WITH MEDIAN = 0 AND 75% POINT = 1.
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = (1/PI)*(1/(1+X*X)).
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
C                                OF RANDOM NUMBERS TO BE
C                                GENERATED.
C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
C                                (OF DIMENSION AT LEAST N)
C                                INTO WHICH THE GENERATED
C                                RANDOM SAMPLE WILL BE PLACED.
C     OUTPUT--A RANDOM SAMPLE OF SIZE N
C             FUNCTION VALUE FOR THE CAUCHY DISTRIBUTION
C             WITH MEDIAN = 0 AND 75% POINT = 1.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SIN, COS.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--TOCHER, THE ART OF SIMULATION,
C                 1963, PAGE 15.
C               --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS,
C                 1964, PAGE 36.
C               --FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION
C                 OF THE LOCATION PARAMETER OF A SYMMETRIC
C                 DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION,
C                 PRINCETON UNIVERSITY), 1969, PAGE 231.
C               --FILLIBEN, 'THE PERCENT POINT FUNCTION',
C                 (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 154-165.
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     LANGUAGE--ANSI FORTRAN (1966)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JUNE      1972.
C     UPDATED         --SEPTEMBER 1975.
C     UPDATED         --NOVEMBER  1975.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA PI/3.14159265359/
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      GOTO90
   50 WRITE(ICOUT, 5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,47)N
      CALL DPWRST('XXX','BUG ')
      RETURN
   90 CONTINUE
    5 FORMAT('***** FATAL ERROR--THE 1ST INPUT ARGUMENT TO THE ',
     1'CAURAN SUBROUTINE IS NON-POSITIVE *****')
   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8   ,' *****')
C
C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
C
      CALL UNIRAN(N,ISEED,X)
C
C     GENERATE N CAUCHY RANDOM NUMBERS
C     USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD.
C
      DO100I=1,N
      ARG=PI*X(I)
      X(I)=-COS(ARG)/SIN(ARG)
  100 CONTINUE
C
      RETURN
      END
      SUBROUTINE CAUSF(P,SF)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE SPARSITY
C              FUNCTION VALUE FOR THE CAUCHY DISTRIBUTION
C              WITH MEDIAN = 0 AND 75% POINT = 1.
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = (1/PI)*(1/(1+X*X)).
C              NOTE THAT THE SPARSITY FUNCTION OF A DISTRIBUTION
C              IS THE DERIVATIVE OF THE PERCENT POINT FUNCTION,
C              AND ALSO IS THE RECIPROCAL OF THE PROBABILITY
C              DENSITY FUNCTION (BUT IN UNITS OF P RATHER THAN X).
C     INPUT  ARGUMENTS--P      = THE SINGLE PRECISION VALUE
C                                (BETWEEN 0.0 AND 1.0)
C                                AT WHICH THE SPARSITY
C                                FUNCTION IS TO BE EVALUATED.
C     OUTPUT ARGUMENTS--SF     = THE SINGLE PRECISION
C                                SPARSITY FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION SPARSITY
C             FUNCTION VALUE SF.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
C     RESTRICTIONS--P SHOULD BE BETWEEN 0.0 AND 1.0, EXCLUSIVELY.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SIN.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN.
C     REFERENCES--FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION
C                 OF THE LOCATION PARAMETER OF A SYMMETRIC
C                 DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION,
C                 PRINCETON UNIVERSITY), 1969, PAGES 21-44, 229-231.
C               --FILLIBEN, 'THE PERCENT POINT FUNCTION',
C                 (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 154-165.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--APRIL     1994.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C---------------------------------------------------------------------
C
      DATA PI/3.14159265358979/
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LE.0.0.OR.P.GE.1.0)GOTO50
      GOTO90
   50 CONTINUE
      WRITE(ICOUT,1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,46)P
      RETURN
    1 FORMAT('***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE')
    2 FORMAT('      CAUPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1)')
    3 FORMAT('       INTERVAL *****')
   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
C
   90 CONTINUE
C
C-----START POINT-----------------------------------------------------
C
      ARG=PI*P
      SF=PI/((SIN(ARG))**2)
C
      RETURN
      END
      COMPLEX FUNCTION CBETA(A,B,IERR2)
C***BEGIN PROLOGUE  CBETA
C***DATE WRITTEN   770701   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  C7B
C***KEYWORDS  BETA FUNCTION,COMPLETE BETA FUNCTION,COMPLEX,
C             SPECIAL FUNCTION
C***AUTHOR  FULLERTON, W., (LANL)
C***PURPOSE  CBETA computes the complete Beta function of complex
C            parameters A and B.
C***DESCRIPTION
C
C CBETA computes the complete beta function of complex parameters A
C and B.
C Input Parameters:
C       A   complex and the real part of A positive
C       B   complex and the real part of B positive
C***REFERENCES  (NONE)
C***ROUTINES CALLED  CGAMMA,CLBETA,GAMLIM,XERROR
C***END PROLOGUE  CBETA
C
      INCLUDE 'DPCOP2.INC'
C
      COMPLEX A, B, CGAMMA, CLBETA, CEXP
C
      DATA XMAX / 0.0 /
C
C***FIRST EXECUTABLE STATEMENT  CBETA
      CBETA = (0.0, 0.0)
      IERR2=0
      IF (XMAX.EQ.0.0) CALL GAMLIM (XMIN, XMAX)
C
      IF (REAL(A).LE.0.0 .OR. REAL(B).LE.0.0) THEN
CCCCC   CALL XERROR ( 'CBETA   REA
CCCCC1L PART OF BOTH ARGUMENTS MUST BE GT 0', 48, 1, 2)
        WRITE(ICOUT,11)
        CALL DPWRST('XXX','BUG ')
      ENDIF
   11 FORMAT('***** ERROR FROM CBETA: REAL PARTS OF PARAMETER',
     1       'MUST BE POSITIVE')
C
      IF (REAL(A)+REAL(B).LT.XMAX) CBETA = CGAMMA(A) * (CGAMMA(B)/
     1  CGAMMA(A+B) )
      IF (REAL(A)+REAL(B).LT.XMAX) RETURN
C
      CBETA = CEXP (CLBETA(A, B))
C
      RETURN
      END
      SUBROUTINE CC(X,N,ENGLSL,ENGUSL,TARGET,IWRITE,XCC,
     1IBUGA3,IERROR)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SAMPLE CC (PROCESS CAPABILITY INDEX)
C              OF THE DATA IN THE INPUT VECTOR X.
C              CC = MAX((TARGET-MU)/(TARGET-LSL),(MU-TARGET)/(USL))
C     NOTE--CC IS A MEASURE OF PROCESS ACCURACY--
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                                (UNSORTED OR SORTED) OBSERVATIONS.
C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR X.
C                     --ENGLSL = LOWER (ENGINEERING) SPEC LIMIT
C                     --ENGUSL = UPPER (ENGINEERING) SPEC LIMIT
C                     --TARGET = TARGET (ENGINEERING) SPEC LIMIT
C     OUTPUT ARGUMENTS--CC    = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE CC
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE CC INDEX
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--MEAN AND SD.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT.
C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--NORMA HUBELE, ARIZONA STATE
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-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98.11
C     ORIGINAL VERSION--NOVEMBER  1998.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DN
      DOUBLE PRECISION DX
      DOUBLE PRECISION DSUM
      DOUBLE PRECISION DMEAN
C
      DOUBLE PRECISION DUSL
      DOUBLE PRECISION DLSL
      DOUBLE PRECISION DTARG
      DOUBLE PRECISION DNUM
      DOUBLE PRECISION DDEN
      DOUBLE PRECISION DCC
C
      DIMENSION X(*)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      DMEAN=0.0D0
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 CC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)N
   53 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ENGUSL,ENGLSL
   54 FORMAT('ENGUSL,ENGLSL = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,N
      WRITE(ICOUT,56)I,X(I)
   56 FORMAT('I,X(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  COMPUTE PROCESS CAPABILITY INDEX CC  **
C               ********************************************
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.1)GOTO119
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
  111 FORMAT('***** ERROR IN CC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,112)
  112 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,113)
  113 FORMAT('      IN THE VARIABLE FOR WHICH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,114)
  114 FORMAT('      THE CC STATISTIC IS TO BE COMPUTED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,115)
  115 FORMAT('      MUST BE 1 OR LARGER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,116)
  116 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,117)N
  117 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS HERE = ',I8,
     1'.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
  119 CONTINUE
C
C               ***************************************
C               **  STEP 2--                         **
C               **  COMPUTE THE STANDARD DEVIATION.  **
C               ***************************************
C
      DN=N
      DSUM=0.0D0
      DO200I=1,N
      DX=X(I)
      DSUM=DSUM+DX
  200 CONTINUE
      DMEAN=DSUM/DN
C
C               **************************************************
C               **  STEP 3--                                    **
C               **  COMPUTE THE CC RATIO                       **
C               **************************************************
C
      DUSL=ENGUSL
      DLSL=ENGLSL
      DTARG=TARGET
C
      DNUM=(DTARG-DMEAN)/(DTARG-DLSL)
      DDEN=(DMEAN-DTARG)/DUSL
C
      DCC=MAX(DNUM,DDEN)
      XCC=REAL(DCC)
C
C               *******************************
C               **  STEP 3--                 **
C               **  WRITE OUT A LINE         **
C               **  OF SUMMARY INFORMATION.  **
C               *******************************
C
      IF(IFEEDB.EQ.'OFF')GOTO890
      IF(IWRITE.EQ.'OFF')GOTO890
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,811)N,XCC
  811 FORMAT('THE CC OF THE ',I8,' OBSERVATIONS = ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
  890 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 CC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA3,IERROR
 9012 FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N
 9013 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)DMEAN
 9014 FORMAT('DMEAN = ',D15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)DUSL,DLSL
 9016 FORMAT('DUSL,DLSL = ',2D15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)DNUM,DDEN,DCC,XCC
 9017 FORMAT('DNUM,DDEN,DCC,XCC = ',3D15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      COMPLEX FUNCTION CCOT(Z)
C***BEGIN PROLOGUE  CCOT
C***DATE WRITTEN   770401   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  C4A
C***KEYWORDS  COMPLEX,COTANGENT,ELEMENTARY FUNCTION
C***AUTHOR  FULLERTON, W., (LANL)
C***PURPOSE  Computes the complex Cotangent.
C***DESCRIPTION
C
C CCOT(Z) calculates the comlex trigonometric cotangent of Z.
C***REFERENCES  (NONE)
C***ROUTINES CALLED  R1MACH,XERCLR,XERROR
C***END PROLOGUE  CCOT
      COMPLEX Z
C
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOP2.INC'
C
      DATA SQEPS /0./
C***FIRST EXECUTABLE STATEMENT  CCOT
      CCOT = (0., 0.)
C
      IF (SQEPS.EQ.0.) SQEPS = SQRT (R1MACH(4))
C
      X2 = 2.0*REAL(Z)
      Y2 = 2.0*AIMAG(Z)
C
      SN2X = SIN (X2)
CCCCC CALL XERCLR
C
      DEN = COSH(Y2) - COS(X2)
      IF (DEN.EQ.0.) THEN
CCCCC   CALL XERROR (  'CCOT    COT IS SINGULAR FOR INPUT Z
CCCCC1 (X IS 0 OR PI AND Y IS 0)'  , 61, 2, 2)
        WRITE(ICOUT,102)
        CALL DPWRST('XXX','BUG ')
        RETURN
      ENDIF
 102  FORMAT('***** INTERNAL ERROR FROM CCOT: COT IS SINGULAR')
C
      IF (ABS(DEN).GT.AMAX1(ABS(X2),1.)*SQEPS) GO TO 10
CCCCC CALL XERCLR
CCCCC CALL XERROR ( 'CCOT    ANSWER LT HALF PRECISION, ABS(X) TOO BIG OR
CCCCC1 X TOO NEAR 0 OR PI', 70, 1, 1)
      WRITE(ICOUT,202)
      CALL DPWRST('XXX','BUG ')
 202  FORMAT('***** INTERNAL WARNING FROM CCOT: ANSWER IS LESS THAN'
     1,' HALF PRECISION BECAUSE ABS(X) IS TOO LARGE')
      WRITE(ICOUT,203)
      CALL DPWRST('XXX','BUG ')
 203  FORMAT('      OR X IS TOO NEAR 0 OR PI')
C
 10   CCOT = CMPLX (SN2X/DEN, -SINH(Y2)/DEN)
C
      RETURN
      END
      DOUBLE PRECISION FUNCTION CDFGLO(X,PARA)
C===================================================== CDFGLO.FOR
C***********************************************************************
C*                                                                     *
C*  FORTRAN CODE WRITTEN FOR INCLUSION IN IBM RESEARCH REPORT RC20525, *
C*  'FORTRAN ROUTINES FOR USE WITH THE METHOD OF L-MOMENTS, VERSION 3' *
C*                                                                     *
C*  J. R. M. HOSKING                                                   *
C*  IBM RESEARCH DIVISION                                              *
C*  T. J. WATSON RESEARCH CENTER                                       *
C*  YORKTOWN HEIGHTS                                                   *
C*  NEW YORK 10598, U.S.A.                                             *
C*                                                                     *
C*  VERSION 3     AUGUST 1996                                          *
C*                                                                     *
C***********************************************************************
C
C  DISTRIBUTION FUNCTION OF THE GENERALIZED LOGISTIC DISTRIBUTION
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION PARA(3)
C
      INCLUDE 'DPCOP2.INC'
C
      DATA ZERO/0.0D0/,ONE/1.0D0/
C
C         SMALL IS USED TO TEST WHETHER X IS EFFECTIVELY AT
C         THE ENDPOINT OF THE DISTRIBUTION
C
      DATA SMALL/1.0D-15/
C
      U=PARA(1)
      A=PARA(2)
      G=PARA(3)
C
      IF(A.LE.ZERO)THEN
        CDFGLO=ZERO
        WRITE(ICOUT,7000)
 7000   FORMAT('***** ERROR IN GL5CDF--NON-POSITIVE SCALE ',
     1         'PARAMETER IS INVALID.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7005)
 7005   FORMAT('      L-MOMENTS INVALID')
        CALL DPWRST('XXX','WRIT')
        GOTO 9000
      ENDIF
C
      Y=(X-U)/A
      IF(G.EQ.ZERO)GOTO 20
      ARG=ONE-G*Y
      IF(ARG.GT.SMALL)GOTO 10
      IF(G.LT.ZERO)CDFGLO=ZERO
      IF(G.GT.ZERO)CDFGLO=ONE
      GOTO9000
C
   10 CONTINUE
      Y=-DLOG(ARG)/G
   20 CONTINUE
      CDFGLO=ONE/(ONE+DEXP(-Y))
C
 9000 CONTINUE
      RETURN
      END
C===================================================== CDFKAP.FOR
      DOUBLE PRECISION FUNCTION CDFKAP(X,PARA)
C***********************************************************************
C*                                                                     *
C*  FORTRAN CODE WRITTEN FOR INCLUSION IN IBM RESEARCH REPORT RC20525, *
C*  'FORTRAN ROUTINES FOR USE WITH THE METHOD OF L-MOMENTS, VERSION 3' *
C*                                                                     *
C*  J. R. M. HOSKING                                                   *
C*  IBM RESEARCH DIVISION                                              *
C*  T. J. WATSON RESEARCH CENTER                                       *
C*  YORKTOWN HEIGHTS                                                   *
C*  NEW YORK 10598, U.S.A.                                             *
C*                                                                     *
C*  VERSION 3     AUGUST 1996                                          *
C*                                                                     *
C***********************************************************************
C
C  DISTRIBUTION FUNCTION OF THE KAPPA DISTRIBUTION
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION PARA(4)
C
      INCLUDE 'DPCOP2.INC'
C
      DATA ZERO/0D0/,ONE/1D0/
C
C         SMALL IS A SMALL NUMBER, USED TO TEST WHETHER X IS
C         EFFECTIVELY AT AN ENDPOINT OF THE DISTRIBUTION
C
      DATA SMALL/1D-15/
C
      U=PARA(1)
      A=PARA(2)
      G=PARA(3)
      H=PARA(4)
C
      IF(A.LE.ZERO)THEN
        WRITE(ICOUT,7000)
 7000   FORMAT('***** ERROR FROM ROUTINE CDFKAP: SCALE PARAMETER IS ',
     1         'NON-POSITIVE.')
        CDFKAP=ZERO
        GOTO 9000
      ENDIF
C
      Y=(X-U)/A
      IF(G.EQ.ZERO)GOTO 20
      ARG=ONE-G*Y
      IF(ARG.GT.SMALL)GOTO 10
      IF(G.LT.ZERO)CDFKAP=ZERO
      IF(G.GT.ZERO)CDFKAP=ONE
      GOTO9000
C
   10 Y=-DLOG(ARG)/G
   20 Y=DEXP(-Y)
      IF(H.EQ.ZERO)GOTO 40
      ARG=ONE-H*Y
      IF(ARG.GT.SMALL)GOTO 30
      CDFKAP=ZERO
      GOTO9000
   30 Y=-DLOG(ARG)/H
   40 CDFKAP=DEXP(-Y)
      GOTO9000
C
 9000 CONTINUE
      RETURN
      END
C===================================================== CDFPE3.FOR
      DOUBLE PRECISION FUNCTION CDFPE3(X,PARA)
C***********************************************************************
C*                                                                     *
C*  FORTRAN CODE WRITTEN FOR INCLUSION IN IBM RESEARCH REPORT RC20525, *
C*  'FORTRAN ROUTINES FOR USE WITH THE METHOD OF L-MOMENTS, VERSION 3' *
C*                                                                     *
C*  J. R. M. HOSKING                                                   *
C*  IBM RESEARCH DIVISION                                              *
C*  T. J. WATSON RESEARCH CENTER                                       *
C*  YORKTOWN HEIGHTS                                                   *
C*  NEW YORK 10598, U.S.A.                                             *
C*                                                                     *
C*  VERSION 3     AUGUST 1996                                          *
C*                                                                     *
C***********************************************************************
C
C  DISTRIBUTION FUNCTION OF THE PEARSON TYPE 3 DISTRIBUTION
C
C  OTHER ROUTINES USED: DERF,DLGAMA (DLGADP),GAMIND
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION PARA(3)
C
      INCLUDE 'DPCOP2.INC'
C
      DATA ZERO/0D0/,HALF/0.5D0/,ONE/1D0/,TWO/2D0/,FOUR/4D0/
      DATA RTHALF/0.70710 67811 86547 524D0/
C
C         SMALL IS USED TO TEST WHETHER SKEWNESS IS EFFECTIVELY ZERO
C
      DATA SMALL/1D-6/
C
      CDFPE3=ZERO
      IF(PARA(2).LE.ZERO)THEN
        WRITE(ICOUT,7000)
 7000   FORMAT('***** ERROR FROM ROUTINE CDFPE3: SCALE PARAMETER IS ',
     1         'NON-POSITIVE.')
        CALL DPWRST('XXX','WRIT')
        GOTO9000
      ENDIF
C
      GAMMA=PARA(3)
      IF(DABS(GAMMA).LE.SMALL)GOTO 10
      ALPHA=FOUR/(GAMMA*GAMMA)
      Z=TWO*(X-PARA(1))/(PARA(2)*GAMMA)+ALPHA
CCCCC IF(Z.GT.ZERO)CDFPE3=GAMIND(Z,ALPHA,DLGAMA(ALPHA))
      IF(Z.GT.ZERO)CDFPE3=GAMIND(Z,ALPHA,DLGADP(ALPHA))
      IF(GAMMA.LT.ZERO)CDFPE3=ONE-CDFPE3
      GOTO9000
C
C         ZERO SKEWNESS
C
   10 Z=(X-PARA(1))/PARA(2)
      CDFPE3=HALF+HALF*DERFDP(Z*RTHALF)
      GOTO9000
C
 9000 CONTINUE
      RETURN
      END
      DOUBLE PRECISION FUNCTION CDFWAK(X,PARA)
C===================================================== CDFWAK.FOR
C***********************************************************************
C*                                                                     *
C*  FORTRAN CODE WRITTEN FOR INCLUSION IN IBM RESEARCH REPORT RC20525, *
C*  'FORTRAN ROUTINES FOR USE WITH THE METHOD OF L-MOMENTS, VERSION 3' *
C*                                                                     *
C*  J. R. M. HOSKING                                                   *
C*  IBM RESEARCH DIVISION                                              *
C*  T. J. WATSON RESEARCH CENTER                                       *
C*  YORKTOWN HEIGHTS                                                   *
C*  NEW YORK 10598, U.S.A.                                             *
C*                                                                     *
C*  VERSION 3     AUGUST 1996                                          *
C*                                                                     *
C***********************************************************************
C
C  CUMULATIVE DISTRIBUTION FUNCTION OF THE WAKEBY DISTRIBUTION
C
C  OTHER ROUTINES USED: QUAWAK
C
C  METHOD: THE EQUATION X=G(Z), WHERE G(Z) IS THE WAKEBY QUANTILE
C  EXPRESSED AS A FUNCTION OF Z=-LOG(1-F), IS SOLVED USING HALLEY'S
C  METHOD (THE 2ND-ORDER ANALOGUE OF NEWTON-RAPHSON ITERATION).
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION PARA(5)
C
      INCLUDE 'DPCOP2.INC'
C
      DATA ZERO/0.0D0/,HALF/0.5D0/,ONE/1.0D0/
      DATA P1/0.1D0/,P7/0.7D0/,P99/0.99D0/
C
C         EPS,MAXIT CONTROL THE TEST FOR CONVERGENCE OF THE ITERATION
C         ZINCMX IS THE LARGEST PERMITTED ITERATIVE STEP
C         ZMULT CONTROLS WHAT HAPPENS WHEN THE ITERATION STEPS BELOW ZERO
C         UFL SHOULD BE CHOSEN SO THAT DEXP(UFL) JUST DOES NOT CAUSE
C           UNDERFLOW
C
      DATA EPS/1.0D-8/,MAXIT/20/,ZINCMX/3.0D0/,ZMULT/0.2D0/
      DATA UFL/-170.0D0/
C
      XI=PARA(1)
      A=PARA(2)
      B=PARA(3)
      C=PARA(4)
      D=PARA(5)
C
C         TEST FOR VALID PARAMETERS
C
      IF(B+D.LE.ZERO.AND.(B.NE.ZERO.OR.C.NE.ZERO.OR.D.NE.ZERO))GOTO 1000
      IF(A.EQ.ZERO.AND.B.NE.ZERO)GOTO 1000
      IF(C.EQ.ZERO.AND.D.NE.ZERO)GOTO 1000
      IF(C.LT.ZERO.OR.A+C.LT.ZERO)GOTO 1000
      IF(A.EQ.ZERO.AND.C.EQ.ZERO)GOTO 1000
C
      CDFWAK=ZERO
      IF(X.LE.XI)RETURN
C
C         TEST FOR SPECIAL CASES
C
      IF(B.EQ.ZERO.AND.C.EQ.ZERO.AND.D.EQ.ZERO)GOTO 100
      IF(C.EQ.ZERO)GOTO 110
      IF(A.EQ.ZERO)GOTO 120
C
C         GENERAL CASE
C
      CDFWAK=ONE
      IF(D.LT.ZERO.AND.X.GE.XI+A/B-C/D)GOTO9000
C
C         INITIAL VALUES FOR ITERATION:
C         IF X IS IN THE LOWEST DECILE OF THE DISTRIBUTION, START AT Z=0
C           (F=0);
C         IF X IS IN THE HIGHEST PERCENTILE OF THE DISTRIBUTION,
C           STARTING VALUE IS OBTAINED FROM ASYMPTOTIC FORM OF THE
C           DISTRIBUTION FOR LARGE Z (F NEAR 1);
C         OTHERWISE START AT Z=0.7 (CLOSE TO F=0.5).
C
      Z=P7
      IF(X.LT.QUAWAK(P1,PARA))Z=ZERO
      IF(X.LT.QUAWAK(P99,PARA))GOTO 10
      IF(D.LT.ZERO)Z=DLOG((X-XI-A/B)*D/C+ONE)/D
      IF(D.EQ.ZERO)Z=(X-XI-A/B)/C
      IF(D.GT.ZERO)Z=DLOG((X-XI)*D/C+ONE)/D
   10 CONTINUE
C
C         HALLEY'S METHOD, WITH MODIFICATIONS:
C         IF HALLEY ITERATION WOULD MOVE IN WRONG DIRECTION
C           (TEMP.LE.ZERO), USE ORDINARY NEWTON-RAPHSON INSTEAD;
C         IF STEP GOES TOO FAR (ZINC.GT.ZINCMX OR ZNEW.LE.ZERO),
C            LIMIT ITS LENGTH.
C
      DO 30 IT=1,MAXIT
        EB=ZERO
        BZ=-B*Z
        IF(BZ.GE.UFL)EB=DEXP(BZ)
        GB=Z
        IF(DABS(B).GT.EPS)GB=(ONE-EB)/B
        ED=DEXP(D*Z)
        GD=-Z
        IF(DABS(D).GT.EPS)GD=(ONE-ED)/D
        XEST=XI+A*GB-C*GD
        FUNC=X-XEST
        DERIV1=A*EB+C*ED
        DERIV2=-A*B*EB+C*D*ED
        TEMP=DERIV1+HALF*FUNC*DERIV2/DERIV1
        IF(TEMP.LE.ZERO)TEMP=DERIV1
        ZINC=FUNC/TEMP
        IF(ZINC.GT.ZINCMX)ZINC=ZINCMX
        ZNEW=Z+ZINC
        IF(ZNEW.LE.ZERO)GOTO 20
          Z=ZNEW
          IF(DABS(ZINC).LE.EPS)GOTO 200
          GOTO 30
   20   CONTINUE
        Z=Z*ZMULT
   30 CONTINUE
C
C         NOT CONVERGED
C
      WRITE(ICOUT,7010)
 7010 FORMAT('***** WARNING IN WAKCDF--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7012)
 7012 FORMAT('      ITERATION HAS NOT CONVERGED.  THE RESULT ',
     1       'MAY NOT BE RELIABLE.')
      CALL DPWRST('XXX','WRIT')
      GOTO 200
C
C         SPECIAL CASE B=C=D=0: WAKEBY IS EXPONENTIAL
C
  100 CONTINUE
      Z=(X-XI)/A
      GOTO 200
C
C         SPECIAL CASE C=0: WAKEBY IS GENERALIZED PARETO, BOUNDED ABOVE
C
  110 CONTINUE
      CDFWAK=ONE
      IF(X.GE.XI+A/B)RETURN
      Z=-DLOG(ONE-(X-XI)*B/A)/B
      GOTO 200
C
C         SPECIAL CASE A=0: WAKEBY IS GENERALIZED PARETO, NO UPPER BOUND
C
  120 CONTINUE
      Z=DLOG(ONE+(X-XI)*D/C)/D
      GOTO 200
C
C         CONVERT Z VALUE TO PROBABILITY
C
  200 CDFWAK=ONE
      IF(-Z.LT.UFL)GOTO9000
      CDFWAK=ONE-DEXP(-Z)
      GOTO9000
C
 1000 CONTINUE
      WRITE(ICOUT,7000)
 7000 FORMAT('***** ERROR IN WAKCDF--PARAMETERS INVALID.')
      CALL DPWRST('XXX','WRIT')
      CDFWAK=ZERO
      GOTO9000
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE CHASE(A,X,Y,IMX,JMX,I,J,NS,CN,XC,YC,NMX,N,BOX)
C
C     PURPOSE--XX
C
C     WRITTEN BY--DAVID W. BEHRINGER NOAA/AOML (MIAMI).
C                 AS PART OF NOAA'S CONCX V.3   MARCH 1988.
C     ORIGINAL VERSION (IN DATAPLOT)--AUGUST    1988.
C     UPDATED         --JANUARY   1989.  MORE CHANGES TO STANDARD FORTRAN 77--
C                                        BYTE TO CHARACTER*1,
C                                        DO WHILE/END DO (ALAN HECKERT).
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOCP.INC'
C
C---------------------------------------------------------------------
C
CCCCC BYTE BOX(4,IMX,JMX)                JANUARY 1989
CCCCC DIMENSION A(IMX,JMX),X(IMX),Y(JMX),XC(NMX),YC(NMX)
CCCCC DIMENSION XP(3),YP(3),LP(3)
C
CCCCC BYTE BOX                           JANUARY 1989
      CHARACTER*1 BOX
      CHARACTER*1 ITEMP
C
      DIMENSION A(IMX,JMX)
      DIMENSION X(*)
      DIMENSION Y(*)
      DIMENSION XC(*)
      DIMENSION YC(*)
      DIMENSION BOX(4,MAXIMX,MAXJMX)
C
      DIMENSION XP(3)
      DIMENSION YP(3)
      DIMENSION LP(3)
C
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      IF(ISUBG4.EQ.'HASE')THEN
        WRITE(ICOUT,101)IMX,JMX,NMX
  101   FORMAT('***** SUBROUTINE CHASE: IMX,JMX,NMX = ',3I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      IO=0
CCCCC DO WHILE ((BOX(NS,I,J).EQ.0.OR.BOX(NS,I,J).EQ.2).AND.IO.EQ.0)
  99  CONTINUE
      IF((BOX(NS,I,J).EQ.'0'.OR.BOX(NS,I,J).EQ.'2').AND.IO.EQ.0)GOTO100
        GOTO199
 100    CONTINUE
        ITEMP=BOX(NS,I,J)
        CALL DPCOAN(ITEMP,IJUNK)
        IJUNK=IJUNK+1
        CALL DPCONA(IJUNK,ITEMP)
        BOX(NS,I,J)=ITEMP
CCCCC   BOX(NS,I,J)=BOX(NS,I,J)+1
        DO110L=1,3
          XP(L)=0.
          YP(L)=0.
 110    CONTINUE
        NXT=0
        DO120LL=NS+1,NS+3
          L=MOD((LL-1),4)+1
          IF (BOX(L,I,J).EQ.'0'.OR.BOX(L,I,J).EQ.'2') THEN
            IF (L.EQ.1) THEN
              DNM=A(I,J+1)-A(I,J)
              IF (DNM.NE.0.) THEN
                R=(CN-A(I,J))/DNM
              ELSE
                R=-1.
              END IF
              IF ((R.GT.0..AND.R.LT.1.).OR.
     1           (R.EQ.0..AND.DNM.LT.0.).OR.
     2           (R.EQ.1..AND.DNM.GT.0.)) THEN
                NXT=NXT+1
                LP(NXT)=1
                XP(NXT)=X(I)
                YP(NXT)=Y(J)+R*(Y(J+1)-Y(J))
              END IF
            ELSE IF (L.EQ.2) THEN
              DNM=A(I+1,J+1)-A(I,J+1)
              IF (DNM.NE.0.) THEN
                R=(CN-A(I,J+1))/DNM
              ELSE
                R=-1.
              END IF
              IF ((R.GT.0..AND.R.LT.1.).OR.
     1           (R.EQ.0..AND.DNM.LT.0.).OR.
     2           (R.EQ.1..AND.DNM.GT.0.)) THEN
                NXT=NXT+1
                LP(NXT)=2
                XP(NXT)=X(I)+R*(X(I+1)-X(I))
                YP(NXT)=Y(J+1)
              END IF
            ELSE IF (L.EQ.3) THEN
              DNM=A(I+1,J)-A(I+1,J+1)
              IF (DNM.NE.0.) THEN
                R=(CN-A(I+1,J+1))/DNM
              ELSE
                R=-1.
              END IF
              IF ((R.GT.0..AND.R.LT.1.).OR.
     1           (R.EQ.0..AND.DNM.LT.0.).OR.
     2           (R.EQ.1..AND.DNM.GT.0.)) THEN
                NXT=NXT+1
                LP(NXT)=3
                XP(NXT)=X(I+1)
                YP(NXT)=Y(J+1)+R*(Y(J)-Y(J+1))
              END IF
            ELSE IF (L.EQ.4) THEN
              DNM=A(I,J)-A(I+1,J)
              IF (DNM.NE.0.) THEN
                R=(CN-A(I+1,J))/DNM
              ELSE
                R=-1.
              END IF
              IF ((R.GT.0..AND.R.LT.1.).OR.
     1           (R.EQ.0..AND.DNM.LT.0.).OR.
     2           (R.EQ.1..AND.DNM.GT.0.)) THEN
                NXT=NXT+1
                LP(NXT)=4
                XP(NXT)=X(I+1)+R*(X(I)-X(I+1))
                YP(NXT)=Y(J)
              END IF
            END IF
          END IF
 120    CONTINUE
        IF (NXT.EQ.0) THEN
          NS=-1
          GOTO9000
        ELSE IF (NXT.EQ.1) THEN
          LN=1
        ELSE IF (NXT.EQ.2) THEN
          LN=1
          PRINT *,'  WARNING! CELL HAS 2 EXITS!'
        ELSE
          D1=(XC(N)-XP(1))**2+(YC(N)-YP(1))**2
          D2=(XC(N)-XP(3))**2+(YC(N)-YP(3))**2
            IF (D1.LE.D2) THEN
            LN=1
          ELSE
            LN=3
          END IF
        END IF
        N=N+1
        XC(N)=XP(LN)
        YC(N)=YP(LN)
        L=LP(LN)
        ITEMP=BOX(L,I,J)
        CALL DPCOAN(ITEMP,IJUNK)
        IJUNK=IJUNK+1
        CALL DPCONA(IJUNK,ITEMP)
        BOX(L,I,J)=ITEMP
CCCCC   BOX(L,I,J)=BOX(L,I,J)+1
        IF (BOX(L,I,J).EQ.'3') THEN
          IO=1
        ELSE
          ML2=MOD(L,2)
          I=I+ML2*(L-2)
          J=J+(ML2-1)*(L-3)
          NS=MOD((L+ML2),4)+2-ML2
          IO=0
        END IF
      GOTO99
 199  CONTINUE
      NS=-1
      GOTO9000
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE CDIV(AR,AI,BR,BI,CR,CI)
C***BEGIN PROLOGUE  CDIV
C***REFER TO  EISDOC
C
C     Complex division, (CR,CI) = (AR,AI)/(BR,BI)
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  CDIV
      REAL AR,AI,BR,BI,CR,CI
C
      REAL S,ARS,AIS,BRS,BIS
C***FIRST EXECUTABLE STATEMENT  CDIV
      S = ABS(BR) + ABS(BI)
      ARS = AR/S
      AIS = AI/S
      BRS = BR/S
      BIS = BI/S
      S = BRS**2 + BIS**2
      CR = (ARS*BRS + AIS*BIS)/S
      CI = (AIS*BRS - ARS*BIS)/S
      RETURN
      END
      SUBROUTINE CFFTB(N,C,WSAVE)
C***BEGIN PROLOGUE  CFFTB
C***DATE WRITTEN   790601   (YYMMDD)
C***REVISION DATE  860115   (YYMMDD)
C***CATEGORY NO.  J1A2
C***KEYWORDS  FOURIER TRANSFORM
C***AUTHOR  SWARZTRAUBER, P. N., (NCAR)
C***PURPOSE  Unnormalized inverse of CFFTF.
C***DESCRIPTION
C           From the book, "Numerical Methods and Software" by
C                D. Kahaner, C. Moler, S. Nash
C                Prentice Hall, 1988
C
C  Subroutine CFFTB computes the backward complex discrete Fourier
C  transform (the Fourier synthesis).  Equivalently, CFFTB computes
C  a complex periodic sequence from its Fourier coefficients.
C  The transform is defined below at output parameter C.
C
C  A call of CFFTF followed by a call of CFFTB will multiply the
C  sequence by N.
C
C  The array WSAVE which is used by subroutine CFFTB must be
C  initialized by calling subroutine CFFTI(N,WSAVE).
C
C  Input Parameters
C
C
C  N      the length of the complex sequence C.  The method is
C         more efficient when N is the product of small primes.
C
C  C      a complex array of length N which contains the sequence
C
C  WSAVE   a real work array which must be dimensioned at least 4*N+15
C          in the program that calls CFFTB.  The WSAVE array must be
C          initialized by calling subroutine CFFTI(N,WSAVE), and a
C          different WSAVE array must be used for each different
C          value of N.  This initialization does not have to be
C          repeated so long as N remains unchanged.  Thus subsequent
C          transforms can be obtained faster than the first.
C          The same WSAVE array can be used by CFFTF and CFFTB.
C
C  Output Parameters
C
C  C      For J=1,...,N
C
C             C(J)=the sum from K=1,...,N of
C
C                   C(K)*EXP(I*J*K*2*PI/N)
C
C                         where I=SQRT(-1)
C
C  WSAVE   contains initialization calculations which must not be
C          destroyed between calls of subroutine CFFTF or CFFTB
C
C  *   References                                                      *
C  *                                                                   *
C  *   1. P.N. Swarztrauber, Vectorizing the FFTs, in Parallel         *
C  *      Computations (G. Rodrigue, ed.), Academic Press, 1982,       *
C  *      pp. 51-83.                                                   *
C  *   2. B.L. Buzbee, The SLATEC Common Math Library, in Sources      *
C  *      and Development of Mathematical Software (W. Cowell, ed.),   *
C  *      Prentice-Hall, 1984, pp. 302-318.                            *
C  *                                                                   *
C  *********************************************************************
C
C***REFERENCES  (NONE)
C***ROUTINES CALLED  CFFTB1
C***END PROLOGUE  CFFTB
      DIMENSION       C(*)       ,WSAVE(*)
C***FIRST EXECUTABLE STATEMENT  CFFTB
      IF (N .EQ. 1) RETURN
      IW1 = N+N+1
      IW2 = IW1+N+N
      CALL CFFTB1 (N,C,WSAVE,WSAVE(IW1),WSAVE(IW2))
      RETURN
      END
      SUBROUTINE CFFTB1(N,C,CH,WA,IFAC)
C***BEGIN PROLOGUE  CFFTB1
C***REFER TO  CFFTB
C***ROUTINES CALLED  PASSB,PASSB2,PASSB3,PASSB4,PASSB5
C***END PROLOGUE  CFFTB1
CCCCC DECEMBER 2009 (ALAN HECKERT): MAKE IFAC REAL TO AVOID
CCCCC COMPILATION ERRORS FOR NEW INTEL 11 COMPILER
C
      DIMENSION       CH(*)      ,C(*)       ,WA(*)
      REAL            IFAC(*)
C***FIRST EXECUTABLE STATEMENT  CFFTB1
      NF = INT(IFAC(2)+0.01)
      NA = 0
      L1 = 1
      IW = 1
      DO 116 K1=1,NF
         IP = INT(IFAC(K1+2) + 0.1)
         L2 = IP*L1
         IDO = N/L2
         IDOT = IDO+IDO
         IDL1 = IDOT*L1
         IF (IP .NE. 4) GO TO 103
         IX2 = IW+IDOT
         IX3 = IX2+IDOT
         IF (NA .NE. 0) GO TO 101
         CALL PASSB4 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
         GO TO 102
  101    CALL PASSB4 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
  102    NA = 1-NA
         GO TO 115
  103    IF (IP .NE. 2) GO TO 106
         IF (NA .NE. 0) GO TO 104
         CALL PASSB2 (IDOT,L1,C,CH,WA(IW))
         GO TO 105
  104    CALL PASSB2 (IDOT,L1,CH,C,WA(IW))
  105    NA = 1-NA
         GO TO 115
  106    IF (IP .NE. 3) GO TO 109
         IX2 = IW+IDOT
         IF (NA .NE. 0) GO TO 107
         CALL PASSB3 (IDOT,L1,C,CH,WA(IW),WA(IX2))
         GO TO 108
  107    CALL PASSB3 (IDOT,L1,CH,C,WA(IW),WA(IX2))
  108    NA = 1-NA
         GO TO 115
  109    IF (IP .NE. 5) GO TO 112
         IX2 = IW+IDOT
         IX3 = IX2+IDOT
         IX4 = IX3+IDOT
         IF (NA .NE. 0) GO TO 110
         CALL PASSB5 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
         GO TO 111
  110    CALL PASSB5 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4))
  111    NA = 1-NA
         GO TO 115
  112    IF (NA .NE. 0) GO TO 113
         CALL PASSB (NAC,IDOT,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
         GO TO 114
  113    CALL PASSB (NAC,IDOT,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
  114    IF (NAC .NE. 0) NA = 1-NA
  115    L1 = L2
         IW = IW+(IP-1)*IDOT
  116 CONTINUE
      IF (NA .EQ. 0) RETURN
      N2 = N+N
      DO 117 I=1,N2
         C(I) = CH(I)
  117 CONTINUE
      RETURN
      END
      SUBROUTINE CFFTF(N,C,WSAVE)
C***BEGIN PROLOGUE  CFFTF
C***DATE WRITTEN   790601   (YYMMDD)
C***REVISION DATE  860115   (YYMMDD)
C***CATEGORY NO.  J1A2
C***KEYWORDS  FOURIER TRANSFORM
C***AUTHOR  SWARZTRAUBER, P. N., (NCAR)
C***PURPOSE  Forward transform of a complex, periodic sequence.
C***DESCRIPTION
C           From the book, "Numerical Methods and Software" by
C                D. Kahaner, C. Moler, S. Nash
C                Prentice Hall, 1988
C
C  Subroutine CFFTF computes the forward complex discrete Fourier
C  transform (the Fourier analysis).  Equivalently, CFFTF computes
C  the Fourier coefficients of a complex periodic sequence.
C  The transform is defined below at output parameter C.
C
C  The transform is not normalized.  To obtain a normalized transform
C  the output must be divided by N.  Otherwise a call of CFFTF
C  followed by a call of CFFTB will multiply the sequence by N.
C
C  The array WSAVE which is used by subroutine CFFTF must be
C  initialized by calling subroutine CFFTI(N,WSAVE).
C
C  Input Parameters
C
C
C  N      the length of the complex sequence C.  The method is
C         more efficient when N is the product of small primes.
C
C  C      a complex array of length N which contains the sequence
C
C  WSAVE   a real work array which must be dimensioned at least 4*N+15
C          in the program that calls CFFTF.  The WSAVE array must be
C          initialized by calling subroutine CFFTI(N,WSAVE), and a
C          different WSAVE array must be used for each different
C          value of N.  This initialization does not have to be
C          repeated so long as N remains unchanged.  Thus subsequent
C          transforms can be obtained faster than the first.
C          The same WSAVE array can be used by CFFTF and CFFTB.
C
C  Output Parameters
C
C  C      for J=1,...,N
C
C             C(J)=the sum from K=1,...,N of
C
C                   C(K)*EXP(-I*J*K*2*PI/N)
C
C                         where I=SQRT(-1)
C
C  WSAVE   contains initialization calculations which must not be
C          destroyed between calls of subroutine CFFTF or CFFTB
C
C  *   References                                                      *
C  *                                                                   *
C  *   1. P.N. Swarztrauber, Vectorizing the FFTs, in Parallel         *
C  *      Computations (G. Rodrigue, ed.), Academic Press, 1982,       *
C  *      pp. 51-83.                                                   *
C  *   2. B.L. Buzbee, The SLATEC Common Math Library, in Sources      *
C  *      and Development of Mathematical Software (W. Cowell, ed.),   *
C  *      Prentice-Hall, 1984, pp. 302-318.                            *
C  *                                                                   *
C  *********************************************************************
C
C***REFERENCES  (NONE)
C***ROUTINES CALLED  CFFTF1
C***END PROLOGUE  CFFTF
      DIMENSION       C(*)       ,WSAVE(*)
C***FIRST EXECUTABLE STATEMENT  CFFTF
      IF (N .EQ. 1) RETURN
      IW1 = N+N+1
      IW2 = IW1+N+N
      CALL CFFTF1 (N,C,WSAVE,WSAVE(IW1),WSAVE(IW2))
      RETURN
      END
      SUBROUTINE CFFTF1(N,C,CH,WA,IFAC)
C***BEGIN PROLOGUE  CFFTF1
C***REFER TO  CFFTF
C***ROUTINES CALLED  PASSF,PASSF2,PASSF3,PASSF4,PASSF5
C***END PROLOGUE  CFFTF1
CCCCC DECEMBER 2009 (ALAN HECKERT): MAKE IFAC REAL TO AVOID
CCCCC COMPILATION ERRORS FOR NEW INTEL 11 COMPILER
      DIMENSION       CH(*)      ,C(*)       ,WA(*)
      REAL            IFAC(*)
C***FIRST EXECUTABLE STATEMENT  CFFTF1
      NF = INT(IFAC(2) + 0.01)
      NA = 0
      L1 = 1
      IW = 1
      DO 116 K1=1,NF
         IP = INT(IFAC(K1+2) + 0.01)
         L2 = IP*L1
         IDO = N/L2
         IDOT = IDO+IDO
         IDL1 = IDOT*L1
         IF (IP .NE. 4) GO TO 103
         IX2 = IW+IDOT
         IX3 = IX2+IDOT
         IF (NA .NE. 0) GO TO 101
         CALL PASSF4 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
         GO TO 102
  101    CALL PASSF4 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
  102    NA = 1-NA
         GO TO 115
  103    IF (IP .NE. 2) GO TO 106
         IF (NA .NE. 0) GO TO 104
         CALL PASSF2 (IDOT,L1,C,CH,WA(IW))
         GO TO 105
  104    CALL PASSF2 (IDOT,L1,CH,C,WA(IW))
  105    NA = 1-NA
         GO TO 115
  106    IF (IP .NE. 3) GO TO 109
         IX2 = IW+IDOT
         IF (NA .NE. 0) GO TO 107
         CALL PASSF3 (IDOT,L1,C,CH,WA(IW),WA(IX2))
         GO TO 108
  107    CALL PASSF3 (IDOT,L1,CH,C,WA(IW),WA(IX2))
  108    NA = 1-NA
         GO TO 115
  109    IF (IP .NE. 5) GO TO 112
         IX2 = IW+IDOT
         IX3 = IX2+IDOT
         IX4 = IX3+IDOT
         IF (NA .NE. 0) GO TO 110
         CALL PASSF5 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
         GO TO 111
  110    CALL PASSF5 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4))
  111    NA = 1-NA
         GO TO 115
  112    IF (NA .NE. 0) GO TO 113
         CALL PASSF (NAC,IDOT,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
         GO TO 114
  113    CALL PASSF (NAC,IDOT,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
  114    IF (NAC .NE. 0) NA = 1-NA
  115    L1 = L2
         IW = IW+(IP-1)*IDOT
  116 CONTINUE
      IF (NA .EQ. 0) RETURN
      N2 = N+N
      DO 117 I=1,N2
         C(I) = CH(I)
  117 CONTINUE
      RETURN
      END
      SUBROUTINE CFFTI(N,WSAVE)
C***BEGIN PROLOGUE  CFFTI
C***DATE WRITTEN   790601   (YYMMDD)
C***REVISION DATE  860115   (YYMMDD)
C***CATEGORY NO.  J1A2
C***KEYWORDS  FOURIER TRANSFORM
C***AUTHOR  SWARZTRAUBER, P. N., (NCAR)
C***PURPOSE  Initialize for CFFTF and CFFTB.
C***DESCRIPTION
C           From the book, "Numerical Methods and Software" by
C                D. Kahaner, C. Moler, S. Nash
C                Prentice Hall, 1988
C
C  Subroutine CFFTI initializes the array WSAVE which is used in
C  both CFFTF and CFFTB.  The prime factorization of N together with
C  a tabulation of the trigonometric functions are computed and
C  stored in WSAVE.
C
C  Input Parameter
C
C  N       the length of the sequence to be transformed
C
C  Output Parameter
C
C  WSAVE   a work array which must be dimensioned at least 4*N+15.
C          The same work array can be used for both CFFTF and CFFTB
C          as long as N remains unchanged.  Different WSAVE arrays
C          are required for different values of N.  The contents of
C          WSAVE must not be changed between calls of CFFTF or CFFTB.
C***REFERENCES  (NONE)
C***ROUTINES CALLED  CFFTI1
C***END PROLOGUE  CFFTI
      DIMENSION       WSAVE(*)
C***FIRST EXECUTABLE STATEMENT  CFFTI
C
      IF (N .EQ. 1) RETURN
      IW1 = N+N+1
      IW2 = IW1+N+N
      CALL CFFTI1 (N,WSAVE(IW1),WSAVE(IW2))
      RETURN
      END
      SUBROUTINE CFFTI1(N,WA,IFAC)
C***BEGIN PROLOGUE  CFFTI1
C***REFER TO  CFFTI
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  CFFTI1
CCCCC DECEMBER 2009 (ALAN HECKERT): MAKE IFAC REAL TO AVOID
CCCCC COMPILATION ERRORS FOR NEW INTEL 11 COMPILER
      DIMENSION       WA(*)      ,NTRYH(4)
      REAL            IFAC(*)
      DATA NTRYH(1),NTRYH(2),NTRYH(3),NTRYH(4)/3,4,2,5/
C
      NTRY = 0
C
C***FIRST EXECUTABLE STATEMENT  CFFTI1
      NL = N
      NF = 0
      J = 0
  101 J = J+1
C
CCCCC 7/2008: MODIFY FOLLOWING LINE SO THAT IT DOES NOT
CCCCC         GENERATE A WARNING MESSAGE FOR FORTRAN 95
CCCCC         COMPILER.
C
CCCCC IF (J-4) 102,102,103
      IF (J-4.GT.0) GOTO 103
      NTRY = NTRYH(J)
      GO TO 104
  103 NTRY = NTRY+2
  104 NQ = NL/NTRY
      NR = NL-NTRY*NQ
C
CCCCC 7/2008: MODIFY FOLLOWING LINE SO THAT IT DOES NOT
CCCCC         GENERATE A WARNING MESSAGE FOR FORTRAN 95
CCCCC         COMPILER.
C
CCCCC IF (NR) 101,105,101
      IF (NR.NE.0) GOTO101
      NF = NF+1
      IFAC(NF+2) = REAL(NTRY)
      NL = NQ
      IF (NTRY .NE. 2) GO TO 107
      IF (NF .EQ. 1) GO TO 107
      DO 106 I=2,NF
         IB = NF-I+2
         IFAC(IB+2) = IFAC(IB+1)
  106 CONTINUE
      IFAC(3) = REAL(2)
  107 IF (NL .NE. 1) GO TO 104
      IFAC(1) = REAL(N)
      IFAC(2) = REAL(NF)
      TPI = 8.*ATAN(1.)
      ARGH = TPI/REAL(N)
      I = 2
      L1 = 1
      DO 110 K1=1,NF
         IP = INT(IFAC(K1+2) + 0.01)
         LD = 0
         L2 = L1*IP
         IDO = N/L2
         IDOT = IDO+IDO+2
         IPM = IP-1
         DO 109 J=1,IPM
            I1 = I
            WA(I-1) = 1.
            WA(I) = 0.
            LD = LD+L1
            FI = 0.
            ARGLD = REAL(LD)*ARGH
            DO 108 II=4,IDOT,2
               I = I+2
               FI = FI+1.
               ARG = FI*ARGLD
               WA(I-1) = COS(ARG)
               WA(I) = SIN(ARG)
  108       CONTINUE
            IF (IP .LE. 5) GO TO 109
            WA(I1-1) = WA(I-1)
            WA(I1) = WA(I)
  109    CONTINUE
         L1 = L2
  110 CONTINUE
      RETURN
      END
      DOUBLE PRECISION FUNCTION CHEVAL(N,A,T)
C
C   This function evaluates a Chebyshev series, using the
C   Clenshaw method with Reinsch modification, as analysed
C   in the paper by Oliver.
C
C   INPUT PARAMETERS
C
C       N - INTEGER - The no. of terms in the sequence
C
C       A - DOUBLE PRECISION ARRAY, dimension 0 to N - The coefficients of
C           the Chebyshev series
C
C       T - DOUBLE PRECISION - The value at which the series is to be
C           evaluated
C
C
C   REFERENCES
C
C        "An error analysis of the modified Clenshaw method for
C         evaluating Chebyshev and Fourier series" J. Oliver,
C         J.I.M.A., vol. 20, 1977, pp379-391
C
C
C MACHINE-DEPENDENT CONSTANTS: NONE
C
C
C INTRINSIC FUNCTIONS USED;
C
C    ABS
C
C
C AUTHOR:  Dr. Allan J. MacLeod,
C          Dept. of Mathematics and Statistics,
C          University of Paisley ,
C          High St.,
C          PAISLEY,
C          SCOTLAND
C
C
C LATEST MODIFICATION:   21 December , 1992
C
C
      INTEGER I,N
      DOUBLE PRECISION A(0:N),D1,D2,HALF,T,TEST,TT,TWO,U0,U1,U2,ZERO
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOP2.INC'
C
      DATA ZERO,HALF/ 0.0 D 0 , 0.5 D 0 /
      DATA TEST,TWO/ 0.6 D 0 , 2.0 D 0 /
C
      CHEVAL =  DBLE(CPUMIN)
      D1=0.0D0
      D2=0.0D0
C
      U1 = ZERO
      U2 = ZERO
C
C   If ABS ( T )  < 0.6 use the standard Clenshaw method
C
      IF ( ABS( T ) .LT. TEST ) THEN
         U0 = ZERO
         TT = T + T
         DO 100 I = N , 0 , -1
            U2 = U1
            U1 = U0
            U0 = TT * U1 + A( I ) - U2
 100     CONTINUE
         CHEVAL =  ( U0 - U2 ) / TWO
      ELSE
C
C   If ABS ( T )  > =  0.6 use the Reinsch modification
C
         D1 = ZERO
C
C   T > =  0.6 code
C
         IF ( T .GT. ZERO ) THEN
            TT =  ( T - HALF ) - HALF
            TT = TT + TT
            DO 200 I = N , 0 , -1
               D2 = D1
               U2 = U1
               D1 = TT * U2 + A( I ) + D2
               U1 = D1 + U2
 200        CONTINUE
            CHEVAL =  ( D1 + D2 ) / TWO
         ELSE
C
C   T < =  -0.6 code
C
            TT =  ( T + HALF ) + HALF
            TT = TT + TT
            DO 300 I = N , 0 , -1
               D2 = D1
               U2 = U1
               D1 = TT * U2 + A( I ) - D2
               U1 = D1 - U2
 300        CONTINUE
            CHEVAL =  ( D1 - D2 ) / TWO
         ENDIF
      ENDIF
      RETURN
      END
      SUBROUTINE CGAMA(X,Y,KF,GR,GI)
C
C       =========================================================
C       Purpose: Compute the gamma function �(z) or ln[�(z)]
C                for a complex argument
C       Input :  x  --- Real part of z
C                y  --- Imaginary part of z
C                KF --- Function code
C                       KF=0 for ln[�(z)]
C                       KF=1 for �(z)
C       Output:  GR --- Real part of ln[�(z)] or �(z)
C                GI --- Imaginary part of ln[�(z)] or �(z)
C       ========================================================
C
        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
        DIMENSION A(10)
C
        DATA A/8.333333333333333D-02,-2.777777777777778D-03,
     &         7.936507936507937D-04,-5.952380952380952D-04,
     &         8.417508417508418D-04,-1.917526917526918D-03,
     &         6.410256410256410D-03,-2.955065359477124D-02,
     &         1.796443723688307D-01,-1.39243221690590D+00/
C
        PI=3.141592653589793D0
        X1=0.0
        Y1=0.0
        NA=0
C
        IF (Y.EQ.0.0D0.AND.X.EQ.INT(X).AND.X.LE.0.0D0) THEN
           GR=1.0D+300
           GI=0.0D0
           RETURN
        ELSE IF (X.LT.0.0D0) THEN
           X1=X
           Y1=Y
           X=-X
           Y=-Y
        ENDIF
        X0=X
        IF (X.LE.7.0) THEN
           NA=INT(7-X)
           X0=X+NA
        ENDIF
        Z1=DSQRT(X0*X0+Y*Y)
        TH=DATAN(Y/X0)
        GR=(X0-.5D0)*DLOG(Z1)-TH*Y-X0+0.5D0*DLOG(2.0D0*PI)
        GI=TH*(X0-0.5D0)+Y*DLOG(Z1)-Y
        DO 10 K=1,10
           T=Z1**(1-2*K)
           GR=GR+A(K)*T*DCOS((2.0D0*K-1.0D0)*TH)
           GI=GI-A(K)*T*DSIN((2.0D0*K-1.0D0)*TH)
10      CONTINUE
        IF (X.LE.7.0) THEN
           GR1=0.0D0
           GI1=0.0D0
           DO 15 J=0,NA-1
              GR1=GR1+.5D0*DLOG((X+J)**2+Y*Y)
              GI1=GI1+DATAN(Y/(X+J))
15         CONTINUE
           GR=GR-GR1
           GI=GI-GI1
        ENDIF
        IF (X1.LT.0.0D0) THEN
           Z1=DSQRT(X*X+Y*Y)
           TH1=DATAN(Y/X)
           SR=-DSIN(PI*X)*DCOSH(PI*Y)
           SI=-DCOS(PI*X)*DSINH(PI*Y)
           Z2=DSQRT(SR*SR+SI*SI)
           TH2=DATAN(SI/SR)
           IF (SR.LT.0.0D0) TH2=PI+TH2
           GR=DLOG(PI/(Z1*Z2))-GR
           GI=-TH1-TH2-GI
           X=X1
           Y=Y1
        ENDIF
        IF (KF.EQ.1) THEN
           G0=DEXP(GR)
           GR=G0*DCOS(GI)
           GI=G0*DSIN(GI)
        ENDIF
      RETURN
      END
      COMPLEX FUNCTION CGAMMA(Z)
C***FOR DATAPLOT, THIS ROUTINE IS USED IN CALCULATION OF CBETA FUNCTION,
C***WE USE CGAMA ABOVE FOR CGAMMA FUNCTION.
C***BEGIN PROLOGUE  CGAMMA
C***DATE WRITTEN   770701   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  C7A
C***KEYWORDS  COMPLETE GAMMA FUNCTION,COMPLEX,GAMMA FUNCTION,
C             SPECIAL FUNCTION
C***AUTHOR  FULLERTON, W., (LANL)
C***PURPOSE  Computes the Gamma function of complex argument.
C***DESCRIPTION
C
C CGAMMA(Z) calculates the complete gamma function for COMPLEX
C argument Z.  This is a preliminary version that is portable
C but not accurate.
C***REFERENCES  (NONE)
C***ROUTINES CALLED  CLNGAM
C***END PROLOGUE  CGAMMA
      COMPLEX Z, CLNGAM, CEXP
C***FIRST EXECUTABLE STATEMENT  CGAMMA
      CGAMMA = CEXP (CLNGAM(Z))
C
      RETURN
      END
      SUBROUTINE CHEBT(X,AN,CN)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CHEBYSHEV T
C              POLYNOMIAL OF ORDER N.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION INPUT ARGUMENT
C                       CN     = THE SINGLE PRECISION VALUE FOR THE
C                                ORDER OF THE FUNCTION (SHOULD BE
C                                NON-NEGATIVE ORDER)
C     OUTPUT ARGUMENTS--CN    = THE SINGLE PRECISION VALUE OF THE
C                                CHEBYSHEV T POLYNOMIAL.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
C     RESTRICTIONS--
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE
C     MODE OF INTERNAL OPERATIONS--SOME DOUBLE PRECISION.
C     LANGUAGE--ANSI FORTRAN.
C     REFERENCES--"HANDBOOK OF MATHEMATICAL FUNCTIONS, AMS 55",
C                 ABRAMOWITZ AND STEGUM.
C                 USE FOLLOWING RECURRENCE FORMULA:
C                    T(N+1) = 2.0*X*T(N-1)-T(N-2)
C                 FIRST FEW TERMS ARE FROM TABLE 22.3 OF ABRAMOWITZ
C                 AND STEGUM.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE:  301-975-2855
C     ORIGINAL VERSION--JULY       1995.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
      DOUBLE PRECISION DX
      DOUBLE PRECISION DCN, DCN1, DCN2
C
C-----START POINT-----------------------------------------------------
C
      IF(X.LT.-1.0.OR.X.GT.1.0)THEN
        WRITE(ICOUT,4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)X
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
    4 FORMAT('***** NON-FATAL DIAGNOSTIC--THE 1ST INPUT ARGUMENT ',
     1'TO THE CHEBT SUBROUTINE IS OUTSIDE THE (-1,1) INTERVAL *****')
   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
      N=INT(AN+0.5)
      IF(N.LT.0)THEN
        WRITE(ICOUT,6)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,47)N
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
    6 FORMAT('***** NON-FATAL DIAGNOSTIC--THE 2ND INPUT ARGUMENT ',
     1'TO THE CHEBT SUBROUTINE IS NEGATIVE *****')
   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,' *****')
C
      DX=DBLE(X)
C
      IF(N.LE.0)THEN
        CN=1.0
      ELSEIF(N.EQ.1)THEN
        CN=X
      ELSEIF(N.EQ.2)THEN
        CN=2.0*X**2-1.0
      ELSEIF(N.EQ.3)THEN
        DCN=4.0D0*DX**3 - 3.0*DX
        CN=REAL(DCN)
      ELSE
        DCN1=4.0D0*DX**3 - 3.0*DX
        DCN2=2.0D0*DX**2-1.0D0
        DO1000I=4,N
          DCN=2.0D0*DX*DCN1-DCN2
          DCN2=DCN1
          DCN1=DCN
 1000   CONTINUE
        CN=REAL(DCN)
      ENDIF
C
 9999 CONTINUE
      RETURN
      END
      SUBROUTINE CHEBU(X,AN,CN)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CHEBYSHEV U
C              POLYNOMIAL OF ORDER N.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION INPUT ARGUMENT
C                       CN     = THE SINGLE PRECISION VALUE FOR THE
C                                ORDER OF THE FUNCTION (SHOULD BE
C                                NON-NEGATIVE ORDER)
C     OUTPUT ARGUMENTS--CN    = THE SINGLE PRECISION VALUE OF THE
C                                CHEBYSHEV U POLYNOMIAL.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
C     RESTRICTIONS--
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE
C     MODE OF INTERNAL OPERATIONS--SOME DOUBLE PRECISION.
C     LANGUAGE--ANSI FORTRAN.
C     REFERENCES--"HANDBOOK OF MATHEMATICAL FUNCTIONS, AMS 55",
C                 ABRAMOWITZ AND STEGUM.
C                 USE FOLLOWING RECURRENCE FORMULA:
C                    U(N+1) = 2.0*X*U(N-1)-U(N-2)
C                 FIRST FEW TERMS ARE FROM TABLE 22.5 OF ABRAMOWITZ
C                 AND STEGUM.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE:  301-975-2855
C     ORIGINAL VERSION--JULY       1995.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
      DOUBLE PRECISION DX
      DOUBLE PRECISION DCN, DCN1, DCN2
C
C-----START POINT-----------------------------------------------------
C
      IF(X.LT.-1.0.OR.X.GT.1.0)THEN
        WRITE(ICOUT,4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)X
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
    4 FORMAT('***** NON-FATAL DIAGNOSTIC--THE 1ST INPUT ARGUMENT ',
     1'TO THE CHEBU SUBROUTINE IS OUTSIDE THE (-1,1) INTERVAL *****')
   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
      N=INT(AN+0.5)
      IF(N.LT.0)THEN
        WRITE(ICOUT,6)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,47)N
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
    6 FORMAT('***** NON-FATAL DIAGNOSTIC--THE 2ND INPUT ARGUMENT ',
     1'TO THE CHEBU SUBROUTINE IS NEGATIVE *****')
   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,' *****')
C
      DX=DBLE(X)
C
      IF(N.LE.0)THEN
        CN=1.0
      ELSEIF(N.EQ.1)THEN
        CN=2.0*X
      ELSEIF(N.EQ.2)THEN
        CN=4.0*X**2-1.0
      ELSEIF(N.EQ.3)THEN
        DCN=8.0D0*DX**3 - 4.0*DX
        CN=REAL(DCN)
      ELSE
        DCN1=8.0D0*DX**3 - 4.0*DX
        DCN2=4.0D0*DX**2-1.0D0
        DO1000I=4,N
          DCN=2.0D0*DX*DCN1-DCN2
          DCN2=DCN1
          DCN1=DCN
 1000   CONTINUE
        CN=REAL(DCN)
      ENDIF
C
 9999 CONTINUE
      RETURN
      END
      SUBROUTINE CHEDI2(X,Y,N,IWRITE,STATVA,IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CHEBYCHEV DISTANCE BETWEEN THE
C              TWO SETS OF DATA IN THE INPUT VECTORS X AND Y.  THE
C              SAMPLE CHEBYSHEV DISTANCE WILL BE A SINGLE PRECISION VALUE
C              CALCULATED AS:
C
C                 D = MAX[i=1 to N][ABS|(X(i) - Y(i))|]
C
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                                (UNSORTED) OBSERVATIONS WHICH
C                                CONSTITUTE THE FIRST SET OF DATA.
C                     --Y      = THE SINGLE PRECISION VECTOR OF
C                                (UNSORTED) OBSERVATIONS WHICH
C                                CONSTITUTE THE SECOND SET OF DATA.
C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTORS X AND Y.
C     OUTPUT ARGUMENTS--STATVA = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE CHEBYSHEV DISTANCE
C                                BETWEEN THE TWO SETS OF DATA IN THE
C                                INPUT VECTORS X AND Y.  THIS SINGLE
C                                PRECISION VALUE WILL BE BETWEEN 0.0
C                                AND 1.0 (INCLUSIVELY).
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE CHEBYSHEV DISTANCE BETWEEN THE 2 SETS
C             OF DATA IN THE INPUT VECTORS X AND Y.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--ABS.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--XXX
C     WRITTEN BY--ALAN HECKERT
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGYS
C                 GAITHERSBURG, MD 20899
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGYS.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2017/08
C     ORIGINAL VERSION--AUGUST    2017.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
      DIMENSION Y(*)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='CHED'
      ISUBN2='I2  '
      IERROR='NO'
      STATVA=CPUMIN
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'EDI2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF CHEDI2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,P
   52   FORMAT('IBUGA3,ISUBRO,N,P = ',2(A4,2X),I8,F7.2)
        CALL DPWRST('XXX','BUG ')
        DO55I=1,N
          WRITE(ICOUT,56)I,X(I),Y(I)
   56     FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
          CALL DPWRST('XXX','BUG ')
   55   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,111)
  111   FORMAT('***** ERROR IN CHEBYSHEV DISTANCE--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,112)
  112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE RESPONSE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,113)
  113   FORMAT('      VARIABLES IS LESS THAN 1.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,117)N
  117   FORMAT('      THE NUMBER OF OBSERVATIONS = ',I8,'.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ************************************************
C               **  STEP 2--                                  **
C               **  COMPUTE THE MINKOWSKI DISTANCE.           **
C               ************************************************
C
      STATVA=CPUMIN
      DO200I=1,N
        AVAL=ABS(X(I) - Y(I))
        IF(AVAL.GT.STATVA)STATVA=AVAL
  200 CONTINUE
C
C               *******************************
C               **  STEP 3--                 **
C               **  WRITE OUT A LINE         **
C               **  OF SUMMARY INFORMATION.  **
C               *******************************
C
      IF(IFEEDB.EQ.'ON' .AND. IWRITE.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,811)N,STATVA
  811   FORMAT('THE CHEBYSHEV DISTANCE OF THE ',I8,
     1           ' OBSERVATIONS  = ',G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'EDI2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF CHEDIS--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IERROR,STATVA
 9012   FORMAT('IERROR,STATVA = ',A4,2X,G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE CHCDF(X,ANU,CDF)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE FOR THE CHI DISTRIBUTION
C              WITH POSITIVE DEGREES OF FREEDOM PARAMETER = NU.
C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X.
C              THE PROBABILITY DENSITY FUNCTION IS GIVEN
C              IN THE REFERENCES BELOW.
C              THE CDF IS CAN BE COMPUTED WITH THE SLATEC ROUTINE
C              DGAMIC.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
C                                WHICH THE CUMULATIVE DISTRIBUTION
C                                FUNCTION IS TO BE EVALUATED.
C                                X SHOULD BE NON-NEGATIVE.
C                     --ANU    = THE POSITIVE NUMBER OF DEGREES
C                                OF FREEDOM.
C     OUTPUT ARGUMENTS--CDF    = THE SINGLE PRECISION CUMULATIVE
C                                DISTRIBUTION FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION
C             FUNCTION VALUE CDF FOR THE CHI DISTRIBUTION
C             WITH DEGREES OF FREEDOM PARAMETER = ANU.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE.
C                 --NU SHOULD BE A POSITIVE INTEGER VARIABLE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NORCDF.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DEXP.
C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1994, PAGE 417.
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     LANGUAGE--ANSI FORTRAN (1966)
C     VERSION NUMBER--95/4
C     ORIGINAL VERSION--APRIL     1995.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DTERM1, DTERM2
      DOUBLE PRECISION DCDF
      DOUBLE PRECISION DGAMIP
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOP2.INC'
C
C-----DATA STATEMENTS-------------------------------------------------
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(ANU.LE.0.0)THEN
        WRITE(ICOUT,15)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,47)ANU
        CALL DPWRST('XXX','BUG ')
        CDF=0.0
        GOTO9000
      ENDIF
   15 FORMAT('***** ERROR--THE SECOND INPUT ARGUMENT TO CHCDF ',
     1'IS NON-POSITIVE')
      IF(X.LT.0.0)THEN
        WRITE(ICOUT,4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)X
        CALL DPWRST('XXX','BUG ')
        CDF=0.0
        GOTO9000
      ENDIF
    4 FORMAT('***** ERROR--THE FIRST INPUT ARGUMENT TO CHCDF ',
     1'IS NEGATIVE')
   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
C
      IF(X.LE.R1MACH(1))THEN
        CDF=0.0
        RETURN
      ENDIF
C
      DTERM1=DBLE(ANU/2.0)
      DTERM2=DBLE(X**2/2.0)
      DCDF=DGAMIP(DTERM1,DTERM2)
      CDF=REAL(DCDF)
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE CHCDF2(DX,DNU,DCDF)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE FOR THE CHI DISTRIBUTION
C              WITH POSITIVE DEGREES OF FREEDOM PARAMETER = NU.
C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X.
C              THE PROBABILITY DENSITY FUNCTION IS GIVEN
C              IN THE REFERENCES BELOW.
C              THE CDF IS CAN BE COMPUTED WITH THE SLATEC ROUTINE
C              DGAMIC.
C     NOTE--THIS IS A DOUBLE PRECISION VERSION OF CHCDF USED BY
C           CHPPF FOR GREATER ACCURACY.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
C                                WHICH THE CUMULATIVE DISTRIBUTION
C                                FUNCTION IS TO BE EVALUATED.
C                                X SHOULD BE NON-NEGATIVE.
C                     --ANU    = THE POSITIVE NUMBER OF DEGREES
C                                OF FREEDOM.
C     OUTPUT ARGUMENTS--CDF    = THE SINGLE PRECISION CUMULATIVE
C                                DISTRIBUTION FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION
C             FUNCTION VALUE CDF FOR THE CHI DISTRIBUTION
C             WITH DEGREES OF FREEDOM PARAMETER = ANU.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE.
C                 --NU SHOULD BE A POSITIVE INTEGER VARIABLE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NORCDF.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DEXP.
C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1994, PAGE 417.
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     LANGUAGE--ANSI FORTRAN (1966)
C     VERSION NUMBER--95/4
C     ORIGINAL VERSION--APRIL     1995.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DTERM1, DTERM2
      DOUBLE PRECISION DX
      DOUBLE PRECISION DCDF
      DOUBLE PRECISION DNU
      DOUBLE PRECISION DGAMIP
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOP2.INC'
C
C-----DATA STATEMENTS-------------------------------------------------
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(DNU.LE.0.0D0)THEN
        WRITE(ICOUT,15)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,47)ANU
        CALL DPWRST('XXX','BUG ')
        DCDF=0.0D0
        GOTO9000
      ENDIF
   15 FORMAT('***** ERROR--THE SECOND INPUT ARGUMENT TO CHCDF ',
     1'IS NON-POSITIVE')
      IF(DX.LT.0.0D0)THEN
        WRITE(ICOUT,4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)DX
        CALL DPWRST('XXX','BUG ')
        DCDF=0.0D0
        GOTO9000
      ENDIF
    4 FORMAT('***** ERROR--THE FIRST INPUT ARGUMENT TO CHCDF ',
     1'IS NEGATIVE')
   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
C
      IF(DX.LE.D1MACH(1))THEN
        DCDF=0.0D0
        RETURN
      ENDIF
C
      DTERM1=DNU/2.0D0
      DTERM2=DX**2/2.0D0
      DCDF=DGAMIP(DTERM1,DTERM2)
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE CHFDV(X1,X2,F1,F2,D1,D2,NE,XE,FE,DE,NEXT,IERR)
C***BEGIN PROLOGUE  CHFDV
C     THIS PROLOGUE HAS BEEN REMOVED FOR REASONS OF SPACE
C     FOR A COMPLETE COPY OF THIS ROUTINE CONTACT THE AUTHORS
C     From the book "Numerical Methods and Software"
C          by  D. Kahaner, C. Moler, S. Nash
C               Prentice Hall 1988
C***END PROLOGUE  CHFDV
C
C  DECLARE ARGUMENTS.
C
      INTEGER  NE, NEXT(2), IERR
      REAL  X1, X2, F1, F2, D1, D2, XE(NE), FE(NE), DE(NE)
C
C  DECLARE LOCAL VARIABLES.
C
      INTEGER  I
      REAL  C2, C2T2, C3, C3T3, DEL1, DEL2, DELTA, H, X, XMI, XMA, ZERO
C
      INCLUDE 'DPCOP2.INC'
C
      DATA  ZERO /0./
C
C  VALIDITY-CHECK ARGUMENTS.
C
C***FIRST EXECUTABLE STATEMENT  CHFDV
      IF (NE .LT. 1)  GO TO 5001
      H = X2 - X1
      IF (H .EQ. ZERO)  GO TO 5002
C
C  INITIALIZE.
C
      IERR = 0
      NEXT(1) = 0
      NEXT(2) = 0
      XMI = AMIN1(ZERO, H)
      XMA = AMAX1(ZERO, H)
C
C  COMPUTE CUBIC COEFFICIENTS (EXPANDED ABOUT X1).
C
      DELTA = (F2 - F1)/H
      DEL1 = (D1 - DELTA)/H
      DEL2 = (D2 - DELTA)/H
C                                           (DELTA IS NO LONGER NEEDED.)
      C2 = -(DEL1+DEL1 + DEL2)
      C2T2 = C2 + C2
      C3 = (DEL1 + DEL2)/H
C                               (H, DEL1 AND DEL2 ARE NO LONGER NEEDED.)
      C3T3 = C3+C3+C3
C
C  EVALUATION LOOP.
C
      DO 500  I = 1, NE
         X = XE(I) - X1
         FE(I) = F1 + X*(D1 + X*(C2 + X*C3))
         DE(I) = D1 + X*(C2T2 + X*C3T3)
C          COUNT EXTRAPOLATION POINTS.
         IF ( X.LT.XMI )  NEXT(1) = NEXT(1) + 1
         IF ( X.GT.XMA )  NEXT(2) = NEXT(2) + 1
C        (NOTE REDUNDANCY--IF EITHER CONDITION IS TRUE, OTHER IS FALSE.)
  500 CONTINUE
C
C  NORMAL RETURN.
C
      RETURN
C
C  ERROR RETURNS.
C
 5001 CONTINUE
C     NE.LT.1 RETURN.
      IERR = -1
CNIST CALL XERROR ('CHFDV -- NUMBER OF EVALUATION POINTS LESS THAN ONE'
CNIST*           , 50, IERR, 1)
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5011)
 5011 FORMAT('****** ERROR IN CHFDV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5012)
 5012 FORMAT('       THE NUMBER OF EVALUATION POINTS IS LESS THAN ONE.')
      CALL DPWRST('XXX','BUG ')
      RETURN
C
 5002 CONTINUE
C     X1.EQ.X2 RETURN.
      IERR = -2
CNIST CALL XERROR ('CHFDV -- INTERVAL ENDPOINTS EQUAL'
CNIST*           , 33, IERR, 1)
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5011)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5022)
 5022 FORMAT('       THE INTERVAL ENDPOINTS ARE EQUAL.')
      CALL DPWRST('XXX','BUG ')
      RETURN
C------------- LAST LINE OF CHFDV FOLLOWS ------------------------------
      END
      REAL FUNCTION CHFIV(X1,X2,F1,F2,D1,D2,A,B,IERR)
C***BEGIN PROLOGUE  CHFIV
C***REFER TO  PCHIA
C***ROUTINES CALLED  XERROR
C***REVISION DATE  870707   (YYMMDD)
C***END PROLOGUE  CHFIV
C
C  DECLARE ARGUMENTS.
C
      INTEGER  IERR
      REAL  X1, X2, F1, F2, D1, D2, A, B
C
C  DECLARE LOCAL VARIABLES.
C
      REAL  DTERM, FOUR, FTERM, H, HALF, PHIA1, PHIA2, PHIB1, PHIB2,
     *      PSIA1, PSIA2, PSIB1, PSIB2, TA1, TA2, TB1, TB2, THREE, TWO,
     *      UA1, UA2, UB1, UB2
C
      INCLUDE 'DPCOP2.INC'
C
C  INITIALIZE.
C
      DATA  HALF /0.5/,  TWO /2./,  THREE /3./,  FOUR /4./,  SIX /6./
C
C  VALIDITY CHECK INPUT.
C
C***FIRST EXECUTABLE STATEMENT  CHFIV
      CHFIV=CPUMIN
      IF (X1 .EQ. X2)  GO TO 5001
      IERR = 0
C
C  COMPUTE INTEGRAL.
C
      H = X2 - X1
      TA1 = (A - X1) / H
      TA2 = (X2 - A) / H
      TB1 = (B - X1) / H
      TB2 = (X2 - B) / H
C
      UA1 = TA1**3
      PHIA1 = UA1 * (TWO - TA1)
      PSIA1 = UA1 * (THREE*TA1 - FOUR)
      UA2 = TA2**3
      PHIA2 =  UA2 * (TWO - TA2)
      PSIA2 = -UA2 * (THREE*TA2 - FOUR)
C
      UB1 = TB1**3
      PHIB1 = UB1 * (TWO - TB1)
      PSIB1 = UB1 * (THREE*TB1 - FOUR)
      UB2 = TB2**3
      PHIB2 =  UB2 * (TWO - TB2)
      PSIB2 = -UB2 * (THREE*TB2 - FOUR)
C
      FTERM =   F1*(PHIA2 - PHIB2) + F2*(PHIB1 - PHIA1)
      DTERM = ( D1*(PSIA2 - PSIB2) + D2*(PSIB1 - PSIA1) )*(H/SIX)
C
C  RETURN VALUE.
C
      CHFIV = (HALF*H) * (FTERM + DTERM)
      RETURN
C
C  ERROR RETURN.
C
 5001 CONTINUE
      IERR = -1
CNIST CALL XERROR ('CHFIV -- X1 EQUAL TO X2'
CNIST*           , 23, IERR, 1)
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5011)
 5011 FORMAT('****** ERROR IN CHFIV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5012)
 5012 FORMAT('       X1 EQUAL TO X2.')
      CALL DPWRST('XXX','BUG ')
      RETURN
C------------- LAST LINE OF CHFIV FOLLOWS ------------------------------
      END
      SUBROUTINE CHM(A,B,X,HG,IERROR)
C
C       ===================================================
C       Purpose: Compute confluent hypergeometric function
C                M(a,b,x)
C       Input  : a  --- Parameter
C                b  --- Parameter ( b <> 0,-1,-2,... )
C                x  --- Argument
C       Output:  HG --- M(a,b,x)
C                IERROR REPORT ERROR CONDITIONS
C       ===================================================
C
        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
        CHARACTER*4 IERROR
C
        IERROR='NO'
        Y1=0.0D0
        LA=0
C
        PI=3.141592653589793D0
        A0=A
        A1=A
        X0=X
        HG=0.0D0
        IF (B.EQ.0.0D0.OR.B.EQ.-ABS(INT(B))) THEN
           HG=1.0D+300
        ELSE IF (A.EQ.0.0D0.OR.X.EQ.0.0D0) THEN
           HG=1.0D0
        ELSE IF (A.EQ.-1.0D0) THEN
           HG=1.0D0-X/B
        ELSE IF (A.EQ.B) THEN
           HG=DEXP(X)
        ELSE IF (A-B.EQ.1.0D0) THEN
           HG=(1.0D0+X/B)*DEXP(X)
        ELSE IF (A.EQ.1.0D0.AND.B.EQ.2.0D0) THEN
           HG=(DEXP(X)-1.0D0)/X
        ELSE IF (A.EQ.INT(A).AND.A.LT.0.0D0) THEN
           M=INT(-A)
           R=1.0D0
           HG=1.0D0
           DO 10 K=1,M
              R=R*(A+K-1.0D0)/K/(B+K-1.0D0)*X
              HG=HG+R
10         CONTINUE
        ENDIF
        IF (HG.NE.0.0D0) RETURN
        IF (X.LT.0.0D0) THEN
           A=B-A
           A0=A
           X=DABS(X)
        ENDIF
        IF (A.LT.2.0D0) NL=0
        IF (A.GE.2.0D0) THEN
           NL=1
           LA=INT(A)
           A=A-LA-1.0D0
        ENDIF
        DO 30 N=0,NL
           IF (A0.GE.2.0D0) A=A+1.0D0
           IF (X.LE.30.0D0+DABS(B).OR.A.LT.0.0D0) THEN
              HG=1.0D0
              RG=1.0D0
              DO 15 J=1,500
                 RG=RG*(A+J-1.0D0)/(J*(B+J-1.0D0))*X
                 HG=HG+RG
                 IF (DABS(RG/HG).LT.1.0D-15) GO TO 25
15            CONTINUE
           ELSE
              TA=DGAMMA(A)
              TB=DGAMMA(B)
              XG=B-A
              TBA=DGAMMA(XG)
              SUM1=1.0D0
              SUM2=1.0D0
              R1=1.0D0
              R2=1.0D0
              DO 20 I=1,8
                 R1=-R1*(A+I-1.0D0)*(A-B+I)/(X*I)
                 R2=-R2*(B-A+I-1.0D0)*(A-I)/(X*I)
                 SUM1=SUM1+R1
                 SUM2=SUM2+R2
20            CONTINUE
              HG1=TB/TBA*X**(-A)*DCOS(PI*A)*SUM1
              HG2=TB/TA*DEXP(X)*X**(A-B)*SUM2
              HG=HG1+HG2
           ENDIF
25         CONTINUE
           IF (N.EQ.0) Y0=HG
           IF (N.EQ.1) Y1=HG
30      CONTINUE
        IF (A0.GE.2.0D0) THEN
           DO 35 I=1,LA-1
              HG=((2.0D0*A-B+X)*Y1+(B-A)*Y0)/A
              Y0=Y1
              Y1=HG
              A=A+1.0D0
35         CONTINUE
        ENDIF
        IF (X0.LT.0.0D0) HG=HG*DEXP(X0)
        A=A1
        X=X0
        RETURN
        END
      SUBROUTINE CHPDF(X,ANU,PDF)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY
C              FUNCTION VALUE FOR THE CHI DISTRIBUTION
C              WITH POSITIVE DEGREES OF FREEDOM PARAMETER = NU.
C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X.
C              THE PROBABILITY DENSITY FUNCTION IS GIVEN
C              IN THE REFERENCES BELOW.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
C                                WHICH THE CUMULATIVE DISTRIBUTION
C                                FUNCTION IS TO BE EVALUATED.
C                                X SHOULD BE NON-NEGATIVE.
C                     --ANU    = THE POSITIVE NUMBER OF DEGREES
C                                OF FREEDOM.
C     OUTPUT ARGUMENTS--PDF    = THE SINGLE PRECISION CUMULATIVE
C                                DISTRIBUTION FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION
C             FUNCTION VALUE PDF FOR THE CHI DISTRIBUTION
C             WITH DEGREES OF FREEDOM PARAMETER = ANU.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE.
C                 --NU SHOULD BE A POSITIVE INTEGER VARIABLE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NORPDF.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DEXP.
C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1994, PAGE 417.
C               --"STATISTICAL DISTRIBUTIONS", EVANS, HASTINGS,
C                 PEACOCK.  WILEY, 1993.
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     LANGUAGE--ANSI FORTRAN (1966)
C     VERSION NUMBER--95/4
C     ORIGINAL VERSION--APRIL     1995.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOMC.INC'
C
      DOUBLE PRECISION DTERM1, DTERM2, DTERM3, DTERM4, DTERM5
      DOUBLE PRECISION DARG1, DARG2
      DOUBLE PRECISION DPDF
      DOUBLE PRECISION DLNGAM
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----DATA STATEMENTS-------------------------------------------------
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(ANU.LE.0.0)THEN
        WRITE(ICOUT,15)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,47)ANU
        CALL DPWRST('XXX','BUG ')
        PDF=0.0
        GOTO9999
      ENDIF
   15 FORMAT('***** ERROR--THE SECOND INPUT ARGUMENT TO CHPDF ',
     1'IS NON-POSITIVE')
      IF(X.LT.0.0)THEN
        WRITE(ICOUT,4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)X
        CALL DPWRST('XXX','BUG ')
        PDF=0.0
        GOTO9999
      ENDIF
    4 FORMAT('***** ERROR--THE FIRST INPUT ARGUMENT TO CHPDF ',
     1'IS NEGATIVE')
   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
C
      DARG1=DBLE(X)
      DARG2=DBLE(ANU)
C
      DTERM1=(DARG2-1.0D0)*DLOG(DARG1)
      DTERM2=-DARG1*DARG1/2.0D0
C
      IF(DABS(DTERM2).GE.DLOG(D1MACH(2)))THEN
        PDF=0.0
        GOTO9999
      ENDIF
C
      DTERM3=(DARG2/2.0D0-1.0D0)*DLOG(2.0D0)
      DTERM4=DLNGAM(DARG2/2.0D0)
      DTERM5=DTERM1+DTERM2-DTERM3-DTERM4
      IF(DTERM5.GE.DLOG(D1MACH(2)))THEN
        WRITE(ICOUT,101)X,ANU
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)X
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)ANU
        CALL DPWRST('XXX','BUG ')
        PDF=LOG(R1MACH(2))
        GOTO9999
      ELSE
        DPDF=DEXP(DTERM5)
      ENDIF
      PDF=REAL(DPDF)
      GOTO9999
 101  FORMAT('***** ERROR--THE CHPDF ROUTINE OVERFLOWS.  PDF ',
     1 'SET TO LOG OF LARGEST VALUE.')
C
 9999 CONTINUE
      RETURN
      END
      SUBROUTINE CHPPF(P,NU,PPF)
C
C     PURPOSE   --PERCENT POINT FUNCTION FOR THE CHI
C                 DISTRIBUTION.  USES A BISECTION METHOD.
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--95/4
C     ORIGINAL VERSION--APRIL     1995.
C     UPDATED         --OCTOBER   2006. CONVERT TO DOUBLE PRECISION
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      REAL NU
C
      DOUBLE PRECISION DNU
      DOUBLE PRECISION DP
      DOUBLE PRECISION EPS
      DOUBLE PRECISION SIG
      DOUBLE PRECISION ZERO
      DOUBLE PRECISION DMEAN
      DOUBLE PRECISION DSD
      DOUBLE PRECISION XL
      DOUBLE PRECISION XR
      DOUBLE PRECISION XINC
      DOUBLE PRECISION CDFL
      DOUBLE PRECISION CDFR
      DOUBLE PRECISION FXL
      DOUBLE PRECISION FXR
      DOUBLE PRECISION FCS
      DOUBLE PRECISION P1
      DOUBLE PRECISION DX
      DOUBLE PRECISION DCDF
C
      DOUBLE PRECISION DGAMMA
      EXTERNAL DGAMMA
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
      DATA EPS /0.000001/
      DATA SIG /1.0D-7/
      DATA ZERO /0.0D0/
      DATA MAXIT /1000/
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      PPF=0.0
      IF(P.LT.0.0.OR.P.GE.1.0)THEN
        WRITE(ICOUT,1)
    1   FORMAT('***** ERROR--THE FIRST ARGUMENT TO CHPPF ',
     1       'IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)P
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ELSEIF(NU.LE.0.0)THEN
        WRITE(ICOUT,11)
   11   FORMAT('***** ERROR--THE SECOND ARGUMENT TO CHPPF ',
     1         'IS LESS THAN OR EQUAL TO 0.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)NU
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
C
   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
C
C  FIND BRACKETING INTERVAL.
C
C  1) USE 0 AS THE LOWER LIMIT
C  2) START WITH THE MEAN AS THE UPPER LIMIT AND INCREMENT
C     BY 1 SD.
C
C     MEAN = SQRT(2)*GAMMA((NU+1)/2)/GAMMA(NU/2)
C     VARI = NU - MEAN**2
C
      IF(P.EQ.0.0)THEN
        PPF=0.0
        GOTO9999
      ENDIF
C
      DNU=DBLE(NU)
      DP=DBLE(P)
      DMEAN=DSQRT(2.0D0)*DGAMMA((DNU+1.0D0)/2.0D0)/DGAMMA(DNU/2.0D0)
      DSD=DNU - DMEAN**2
      IF(DSD.GT.0.0D0)THEN
        DSD=DSQRT(DSD)
      ELSE
        DSD=20.0D0
      ENDIF
C
      XL=0.0D0
      XINC=DSD
      ICOUNT=0
      MAXCNT=10000
C
   91 CONTINUE
      XR=XL+XINC
      IF(XL.LE.0.0D0)XL=0.0D0
      IF(XR.LE.0.0D0)XR=XL+1.0D0
      CALL CHCDF2(XL,DNU,CDFL)
      CALL CHCDF2(XR,DNU,CDFR)
      IF(CDFL.LT.DP .AND. CDFR.LT.DP)THEN
        XL=XR
      ELSEIF(CDFL.GT.DP .AND. CDFR.GT.DP)THEN
        XL=XL-XINC
      ELSE
        GOTO99
      ENDIF
      ICOUNT=ICOUNT+1
      IF(ICOUNT.GT.MAXCNT)THEN
        WRITE(ICOUT,96)
        CALL DPWRST('XXX','BUG ')
        PPF=0.0
        GOTO9999
      ENDIF
   96 FORMAT('***** ERROR--CHPPF UNABLE TO FIND BRACKETING ',
     *       'INTERVAL.')
      GOTO91
C
C  BISECTION METHOD
C
   99 CONTINUE
      IC = 0
      FXL = -DP
      FXR = 1.0D0 - DP
  105 CONTINUE
      DX = (XL+XR)*0.5D0
      CALL CHCDF2(DX,DNU,DCDF)
      P1=DCDF
      PPF=REAL(DX)
      FCS = P1 - DP
      IF(FCS*FXL.GT.ZERO)THEN
        XL = DX
        FXL = FCS
      ELSE
        XR = DX
        FXR = FCS
      ENDIF
      XRML = XR - XL
      IF(XRML.LE.SIG .AND. ABS(FCS).LE.EPS)GOTO9999
      IC = IC + 1
      IF(IC.LE.MAXIT)GOTO105
      WRITE(ICOUT,130)
      CALL DPWRST('XXX','BUG ')
  130 FORMAT('***** ERROR--CHPPF ROUTINE DID NOT CONVERGE.')
      GOTO9999
C
 9999 CONTINUE
      RETURN
      END
      SUBROUTINE CHRAN(N,ANU,ISEED,X)
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE CHI DISTRIBUTION
C              WITH TAIL LENGTH PARAMETER VALUE = ANU.
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
C                                OF RANDOM NUMBERS TO BE
C                                GENERATED.
C                     --ANU    = THE SINGLE PRECISION VALUE OF THE
C                                DEGREES OF FREEDOM PARAMETER.
C                                ANU SHOULD BE A POSITIVE INTEGER.
C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
C                                (OF DIMENSION AT LEAST N)
C                                INTO WHICH THE GENERATED
C                                RANDOM SAMPLE WILL BE PLACED.
C     OUTPUT--A RANDOM SAMPLE OF SIZE N
C             FROM THE CHI DISTRIBUTION
C             WITH DEGREES OF FREEDOM PARAMETER VALUE = ANU.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C                 --ANU SHOULD BE POSITIVE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
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     LANGUAGE--ANSI FORTRAN (1966)
C     VERSION NUMBER--2003.7
C     ORIGINAL VERSION--JULY      2003.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)THEN
        WRITE(ICOUT, 5)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,47)N
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
      IF(ANU.LE.0.0)THEN
        WRITE(ICOUT,15)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)ANU
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
    5 FORMAT('***** ERROR--THE REQUESTED NUMBER OF CHI RANDOM',
     1       ' NUMBERS IS NON-POSITIVE.')
   15 FORMAT('***** ERROR--THE DEGREES OF FREEDOM PARAMETER FOR',
     1       ' CHI RANDOM NUMBERS IS NON-POSITIVE.')
   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8)
C
C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
C
      CALL UNIRAN(N,ISEED,X)
C
C     GENERATE N CHI DISTRIBUTION RANDOM
C     NUMBERS USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD.
C
      DO100I=1,N
        CALL CHPPF(X(I),ANU,XTEMP)
        X(I)=XTEMP
  100 CONTINUE
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1                  IERROR)
C
C     PURPOSE--CHECK TO SEE IF THE NUMBER OF INPUT ARGUMENTS
C              TO THE CALLING SUBROUTINES IS BETWEEN ALLOWABLE LIMITS.
C     OUTPUT--A VALUE OF 'NO' OR 'YES' IS STORED
C             IN THE HOLLERITH VARIABLE IERROR
C             DEPENDING ON WHETHER THE NUMBER OF ARGUMENTS
C             IS WITHIN ALLOWABLE LIMITS
C             OR OUTSIDE OF ALLOWABLE LIMITS, RESPECTIVELY.
C     NOTE--THIS CHECKING SUBROUTINE IS PARTICULARLY
C           USEFUL FOR THOSE SUBROUTINES WHICH
C           WOULD RESULT IN A TERMINATION IF THE ANALYST
C           FORGOT TO ENTER ANY ARGUMENTS AT ALL
C           FOR A COMMAND WHICH REQUIRES AT LEAST 1
C           (LIKE HISTOGRAM, NORMAL PROBABILITY PLOT, ETC.).
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER 28, 1977.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --FEBRUARY  1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IANS
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IANS(*)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      IF(MINNA.LE.NUMARG.AND.NUMARG.LE.MAXNA)GOTO1200
C
      WRITE(ICOUT,1102)ISUBN1,ISUBN2
 1102 FORMAT('***** ERROR IN ',A4,A4,'--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1104)
 1104 FORMAT('      THE NUMBER OF ARGUMENTS ACCOMPANYING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1106)
 1106 FORMAT('      THE LAST COMMAND WAS IMPROPER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)NUMARG
 1112 FORMAT('      THE ENTERED NUMBER OF ARGUMENTS WAS ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1108)
 1108 FORMAT('      A VALID NUMBER OF ARGUMENTS FOR THIS COMMAND ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1110)MINNA,MAXNA
 1110 FORMAT('      IS BETWEEN ',I6,' AND ',I6,' (INCLUSIVELY).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,1126)(IANS(I),I=1,MIN(100,IWIDTH))
 1126   FORMAT('      ',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      RETURN
C
 1200 CONTINUE
      IERROR='NO'
      RETURN
C
      END
      SUBROUTINE CHECKF(IHWORD,IHWOR2,IHWUSE,
     1                  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,
     1                  NUMNAM,MAXNAM,
     1                  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,ITYPE)
C
C     PURPOSE--CHECK TO SEE IF THE HOLLERITH NAME IN (IHWORD,IHWOR2)
C              EXISTS IN THE CURRENT TABLE OF AVAILABLE NAMES AND RETURN
C              THE TYPE (PARAMETER, VARIABLE, STRING, OR MATRIX).
C     OUTPUT--ITYPE = THE TYPE.
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2002/7
C     ORIGINAL VERSION--JULY      2002.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHWORD
      CHARACTER*4 IHWOR2
      CHARACTER*4 IHWUSE
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 MESSAG
      CHARACTER*4 IANS
C
      CHARACTER*8 ITYPE
C
C---------------------------------------------------------------------
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IN(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
C
      DIMENSION IANS(*)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      IF(ISUBG4.EQ.'ECKF')THEN
        WRITE(ICOUT,61)IHWUSE,MESSAG,ISUBN1,ISUBN2,MAXNAM,IWIDTH
   61   FORMAT('IHWUSE,MESSAG,ISUBN1,ISUBN2,MAXNAM,IWIDTH = ',
     1         4(A4,2X),2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,63)IANS(1),IANS(2),IANS(3),IANS(4)
   63   FORMAT('IANS(1),IANS(2),IANS(3),IANS(4) = ',3(A4,2X),A4)
        CALL DPWRST('XXX','BUG ')
        DO67I=1,NUMNAM
          WRITE(ICOUT,68)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I),
     1                   VALUE(I)
   68     FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I)',
     1           'VALUE(I) = ',I8,2X,A4,A4,2X,A4,2I8,G15.7)
          CALL DPWRST('XXX','BUG ')
   67   CONTINUE
      ENDIF
C
C     NOTE: RETURNING ITYPE = "NONE" MEANS NAME NOT FOUND IN CURRENT
C           NAME LIST TABLE.
C
      ITYPE='NONE'
      ILOC=0
C
      DO150I=1,NUMNAM
        I2=I
        IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I))THEN
          ILOC=I2
          IF(IUSE(I).EQ.'P')THEN
            ITYPE='PARAMETE'
          ELSEIF(IUSE(I).EQ.'V')THEN
            ITYPE='VARIBLE'
          ELSEIF(IUSE(I).EQ.'F')THEN
            ITYPE='STRING'
          ELSEIF(IUSE(I).EQ.'M')THEN
            ITYPE='MATRIX'
          ELSE
            ITYPE='UNKN'
          ENDIF
          GOTO9000
        ENDIF
  150 CONTINUE
C
 9000 CONTINUE
      IF(MESSAG.EQ.'ON')THEN
        WRITE(ICOUT,51)IHNAME(ILOC),IHNAM2(ILOC),ITYPE
   51   FORMAT('***** VARIABLE ',A4,A4,' FOUND AS A ',A8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
C
      END
      SUBROUTINE CHECKN(IHWORD,IHWOR2,IHWUSE,
     1                  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,
     1                  NUMNAM,MAXNAM,
     1                  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
C
C     PURPOSE--CHECK TO SEE IF THE HOLLERITH NAME IN (IHWORD,IHWOR2)
C              EXISTS IN THE CURRENT TABLE OF AVAILABLE PARAMETER AND
C              VARIABLE NAMES AS GIVEN IN IHNAME(.) AND IHNAM2(I).
C     OUTPUT--THE LOCATION (THAT IS, THE LINE OR ROW) IN THE TABLE
C             WHERE THE NAME WAS FOUND (IF FOUND).
C             THIS LOCATION IS STORED IN THE VARIABLE ILOC.
C             ALSO, A VALUE OF 'YES' OR 'NO' IS STORED
C             IN THE HOLLERITH VARIABLE IERROR
C             DEPENDING ON WHETHER THE NAME WAS NOT FOUND
C             OR WAS FOUND, RESPECTIVELY.
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER 28, 1977.
C     UPDATED         --JUNE 8, 1978.
C     UPDATED         --NOVEMBER  1980.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1988. (UPDATED ERROR MESSAGES)
C     UPDATED         --JANUARY   2010. CHECK FOR MATRIX
C     UPDATED         --JANUARY   2019. CHECK FOR CHARACTER VARIABLE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHWORD
      CHARACTER*4 IHWOR2
      CHARACTER*4 IHWUSE
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 MESSAG
      CHARACTER*4 IANS
      CHARACTER*4 IERROR
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
C
C---------------------------------------------------------------------
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IN(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
C
      DIMENSION IANS(*)
C
      INCLUDE 'DPCOPA.INC'
C
CCCCC CHARACTER*80 IFILE2
      CHARACTER (LEN=MAXFNC) :: IFILE2
      CHARACTER*12 ISTAT2
      CHARACTER*12 IFORM2
      CHARACTER*12 IACCE2
      CHARACTER*12 IPROT2
      CHARACTER*12 ICURS2
      CHARACTER*4  IREWI2
      CHARACTER*4  IERRF2
      CHARACTER*4  ISUBN0
      CHARACTER*8  IH
C
      INCLUDE 'DPCOFO.INC'
      INCLUDE 'DPCOF2.INC'
      INCLUDE 'DPCOBE.INC'
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      IF(ISUBG4.EQ.'ECKN')THEN
        WRITE(ICOUT,61)MAXNAM,IWIDTH
   61   FORMAT('MAXNAM,IWIDTH = ',2I8)
        CALL DPWRST('XXX','BUG ')
        DO67I=1,NUMNAM
          WRITE(ICOUT,68)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I),
     1                   VALUE(I)
   68     FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I)',
     1           'VALUE(I) = ',I8,2X,2A4,2X,A4,2I8,G15.7)
          CALL DPWRST('XXX','BUG ')
   67   CONTINUE
        WRITE(ICOUT,69)IANS(1),IANS(2),IANS(3),IANS(4)
   69   FORMAT('IANS(1),IANS(2),IANS(3),IANS(4) = ',3(A4,2X),A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IERROR='NO'
      IF(NUMNAM.LE.0)THEN
        ILOC=0
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(IHWUSE.EQ.'C' .OR. IHWUSE.EQ.'VC  ')THEN
        IOUNI2=IZCHNU
        IFILE2=IZCHNA
        ISTAT2=IZCHST
        IFORM2=IZCHFO
        IACCE2=IZCHAC
        IPROT2=IZCHPR
        ICURS2=IZCHCS
        IFLAGC=1
C
        ISUBN0='WRIT'
        IERRF2='NO'
        IBUGS2='OFF'
        ISUBRO='XXXX'
        IFLAGC=1
        CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,
     1              ICURS2,
     1              IREWI2,ISUBN0,IERRF2,IBUGS2,ISUBRO,IERROR)
        IF(IERRF2.EQ.'YES')THEN
          IFLAGC=0
          ILOC=0
          IERROR='YES'
          GOTO9000
        ELSE
          REWIND(IOUNI2)
          READ(IOUNI2,'(I8)',END=71,ERR=71)NCVAR
          IFLAGC=1
          GOTO79
C
   71     CONTINUE
          IFLAGC=0
          IF(IHWUSE.EQ.'C')THEN
            ILOC=0
            IERROR='YES'
          ENDIF
   79     CONTINUE
        ENDIF
        IF(IHWUSE.EQ.'C')GOTO159
      ENDIF
C
      DO150I=1,NUMNAM
C
        I2=I
C
        IF(IHWUSE.EQ.'P')THEN
          IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I).AND.
     1       IUSE(I).EQ.'P')GOTO800
          IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I))THEN
            IF(MESSAG.EQ.'YES')THEN
              WRITE(ICOUT,111)IHWORD,IHWOR2
  111         FORMAT('     A COMMAND OR EXPRESSION EXPECTED THE NAME ',
     1               2A4,' TO BE USED ')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,113)
  113         FORMAT('     AS A PARAMETER.  THE NAME WAS FOUND IN THE ',
     1               'INTERNAL TABLE,')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,114)
  114         FORMAT('     BUT NOT AS A PARAMETER.  PLEASE RECHECK ',
     1               'THE COMMAND SYNTAX.')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,999)
  999         FORMAT(1X)
              CALL DPWRST('XXX','BUG ')
            ENDIF
            ILOC=0
            IERROR='YES'
            GOTO9000
          ENDIF
C
        ELSEIF(IHWUSE.EQ.'V' .OR. IHWUSE.EQ.'VC')THEN
          IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I).AND.
     1      IUSE(I).EQ.'V')GOTO800
          IF(IHWUSE.EQ.'VC')GOTO159
          IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I))THEN
C
            IF(MESSAG.EQ.'YES')THEN
              WRITE(ICOUT,211)IHWORD,IHWOR2
  211         FORMAT('     A COMMAND OR EXPRESSION EXPECTED THE NAME ',
     1               2A4,' TO BE USED')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,213)
  213         FORMAT('     AS A VARIABLE.  THE NAME WAS FOUND IN THE ',
     1               'INTERNAL TABLE,')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,214)
  214         FORMAT('     BUT NOT AS A VARIABLE.  PLEASE RECHECK THE ',
     1               'COMMAND SYNTAX.')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','BUG ')
            ENDIF
            ILOC=0
            IERROR='YES'
            GOTO9000
          ENDIF
C
        ELSEIF(IHWUSE.EQ.'EITH' .OR. IHWUSE.EQ.'PORV' .OR.
     1         IHWUSE.EQ.'VORP' .OR. IHWUSE.EQ.'PV'   .OR.
     1         IHWUSE.EQ.'VP')THEN
          IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I).AND.
     1       IUSE(I).EQ.'P')GOTO800
          IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I).AND.
     1       IUSE(I).EQ.'V')GOTO800
          IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I))THEN
            IF(MESSAG.EQ.'YES')THEN
              WRITE(ICOUT,311)IHWORD,IHWOR2
  311         FORMAT('     A COMMAND OR EXPRESSION EXPECTED THE NAME ',
     1               2A4,' TO BE USED')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,313)
  313         FORMAT('     AS A PARAMETER OR VARIABLE.  THE NAME ',
     1               'WAS FOUND IN THE INTERNAL TABLE,')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,314)
  314         FORMAT('     BUT NEITHER AS A PARAMETER NOR A VARIABLE.')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,315)
  315         FORMAT('     PLEASE RECHECK THE COMMAND SYNTAX.')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','BUG ')
            ENDIF
            ILOC=0
            IERROR='YES'
            GOTO9000
          ENDIF
C
        ELSEIF(IHWUSE.EQ.'M')THEN
          IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I).AND.
     1      IUSE(I).EQ.'M')GOTO800
          IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I))THEN
C
            IF(MESSAG.EQ.'YES')THEN
              WRITE(ICOUT,411)IHWORD,IHWOR2
  411         FORMAT('     A COMMAND OR EXPRESSION EXPECTED THE NAME ',
     1               2A4,' TO BE USED')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,413)
  413         FORMAT('     AS A MATRIX.  THE NAME WAS FOUND IN THE ',
     1               'INTERNAL TABLE,')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,414)
  414         FORMAT('     BUT NOT AS A MATRIX.  PLEASE RECHECK THE ',
     1               'COMMAND SYNTAX.')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','BUG ')
            ENDIF
            ILOC=0
            IERROR='YES'
            GOTO9000
          ENDIF
C
        ELSEIF(IHWUSE.EQ.'F')THEN
          IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I).AND.
     1       IUSE(I).EQ.'F')GOTO800
          IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I))THEN
            IF(MESSAG.EQ.'YES')THEN
              WRITE(ICOUT,111)IHWORD,IHWOR2
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,513)
  513         FORMAT('     AS A STRING.  THE NAME WAS FOUND IN THE ',
     1               'INTERNAL TABLE,')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,514)
  514         FORMAT('     BUT NOT AS A STRING.  PLEASE RECHECK ',
     1               'THE COMMAND SYNTAX.')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','BUG ')
            ENDIF
            ILOC=0
            IERROR='YES'
            GOTO9000
          ENDIF
C
        ELSEIF(IHWUSE.EQ.'C')THEN
C
C         CHECK FOR CHARACTER VARIABLE
C
        ENDIF
C
  150 CONTINUE
      IF(IHWUSE.EQ.'VC')GOTO159
      GOTO700
  159 CONTINUE
C
C     FOR 'C' OR 'VC' OPTION CHECK FOR CHARACTER VARIABLE
C
      REWIND(IOUNI2)
      READ(IOUNI2,'(I8)',END=691,ERR=691)NCVAR
      DO610KK=1,NCVAR
        READ(IOUNI2,'(A8)',END=691,ERR=691)IH
        IF(IHWORD.EQ.IH(1:4) .AND. IHWOR2.EQ.IH(5:8))THEN
C
C         FOR CHARACTER VARIABLE, USE "-" TO INDICATE LOCATION OF
C         CHARACTER VARIABLE RATHER THAN NUMERIC VARIABLE.
C
          ILOC=-KK
          IERROR='NO'
          GOTO9000
        ENDIF
  610 CONTINUE
  691 CONTINUE
C
      IF(MESSAG.EQ.'YES')THEN
        WRITE(ICOUT,211)IHWORD,IHWOR2
        CALL DPWRST('XXX','BUG ')
        IF(IHWUSE.EQ.'C')THEN
          WRITE(ICOUT,613)
  613     FORMAT('     AS A CHARACTER VARIABLE.  THE NAME WAS NOT ',
     1           'FOUND IN THE LIST')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,614)
  614     FORMAT('     OF CHARACTER VARIABLE NAMES.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ELSE
          WRITE(ICOUT,623)
  623     FORMAT('     AS A NUMERIC OR CHARACTER VARIABLE.  THE NAME ',
     1           'WAS NOT FOUND IN THE LIST')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,624)
  624     FORMAT('     OF NUMERIC AND CHARACTER VARIABLE NAMES.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ENDIF
      ILOC=0
      IERROR='YES'
      GOTO9000
C
  700 CONTINUE
      IF(MESSAG.EQ.'YES')THEN
        WRITE(ICOUT,702)ISUBN1,ISUBN2
  702   FORMAT('***** ERROR IN CHECKN AS CALLED FROM ',2A4,'--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,703)
  703   FORMAT('      A VARIABLE, PARAMETER, OR MATRIX NAME USED ',
     1         '(OR NEEDED)')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,704)
  704   FORMAT('      IN A COMMAND OR AN EXPRESSION WAS NOT FOUND ',
     1         'IN THE CURRENT')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,706)
  706   FORMAT('      LIST OF AVAILABLE PARAMETER AND VARIABLE NAMES.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,707)IHWORD,IHWOR2
  707   FORMAT('      THE VARIABLE OR PARAMETER IN QUESTION WAS ',2A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      ILOC=0
      IERROR='YES'
      GOTO9000
C
  800 CONTINUE
      ILOC=I2
      IERROR='NO'
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE CHECN2(IHTEST,IHTES2,ITTEST,
     1                  IHNAME,IHNAM2,IUSE,IVALUE,VALUE,IN,NUMNAM,
     1                  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,
     1                  JVALUE,AVALUE,JUSE,JN,
     1                  IOLDNA,IOLDN2,IOLDNI,
     1                  IFOUND,IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--SEARCH THE INTERNAL LIST IHNAME(.)
C              FOR THE NAME GIVEN BY IHTEST.
C              CHECK FOR PRESENCE IN LIST.
C              CHECK FOR VARIABLES HAVING SAME LENGTH.
C              CHECK FOR VARIABLES HAVING POSITIVE LENGTH.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IHTEST
      CHARACTER*4 IHTES2
      CHARACTER*4 ITTEST
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 MESSAG
      CHARACTER*4 IANS
      CHARACTER*4 JUSE
      CHARACTER*4 IOLDNA
      CHARACTER*4 IOLDN2
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
      DIMENSION IUSE(*)
      DIMENSION IN(*)
      DIMENSION IANS(*)
C
C-----COMMON VARIABLES (GENERAL)-----------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
      I=(-999)
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'ECN2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF CHECN2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA3,ISUBRO,NUMNAM,IWIDTH
   52   FORMAT('IBUGA3,ISUBRO,NUMNAM,IWIDTH = ',2(A4,2X),2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)IHTEST,IHTES2,ITTEST
   53   FORMAT('IHTEST,IHTES2,ITTEST = ',2(A4,2X),A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,62)(IANS(I),I=1,MIN(100,IWIDTH))
   62   FORMAT('IANS(.) = ',100A1)
        CALL DPWRST('XXX','BUG ')
        DO67I=1,NUMNAM
          WRITE(ICOUT,68)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I),
     1                   VALUE(I)
   68     FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I)',
     1           'VALUE(I) = ',I8,2X,A4,A4,2X,A4,2I8,G15.7)
          CALL DPWRST('XXX','BUG ')
   67   CONTINUE
      ENDIF
C
      IF(NUMNAM.LE.0)GOTO1010
      DO1000I=1,NUMNAM
      I2=I
      IF(IHTEST.EQ.IHNAME(I).AND.IHTES2.EQ.IHNAM2(I))GOTO1100
      GOTO1000
C
 1100 CONTINUE
      IFOUND='YES'
      ILOC=I2
      IF(ITTEST.EQ.'P')GOTO1200
      IF(ITTEST.EQ.'V')GOTO1300
      IF(ITTEST.EQ.'PV')GOTO1400
      IF(ITTEST.EQ.'VP')GOTO1400
      IF(ITTEST.EQ.'EITH')GOTO1400
      IF(ITTEST.EQ.'BOTH')GOTO1400
C
 1200 CONTINUE
      IF(IUSE(ILOC).EQ.'P')GOTO1210
      GOTO1220
C
 1210 CONTINUE
      JVALUE=IVALUE(ILOC)
      AVALUE=VALUE(ILOC)
      JUSE=IUSE(ILOC)
      JN=IN(ILOC)
      GOTO9000
C
 1220 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1231
      IF(IPRINT.EQ.'OFF')GOTO1231
      IF(MESSAG.EQ.'NO')GOTO1231
      WRITE(ICOUT,1221)ISUBN1,ISUBN2
 1221 FORMAT('***** ERROR IN ',A4,A4,'--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1222)
 1222 FORMAT('      A NAME WHICH SHOULD BE A PARAMETER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1223)
 1223 FORMAT('      HAS BEEN FOUND IN THE NAME LIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1224)
 1224 FORMAT('      BUT AS A DIFFERENT TYPE THAN A PARAMETER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1225)IHTEST,IHTES2
 1225 FORMAT('NAME = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      IF(IUSE(ILOC).EQ.'V')WRITE(ICOUT,1226)
 1226 FORMAT('TYPE = VARIABLE')
      IF(IUSE(ILOC).EQ.'V')CALL DPWRST('XXX','BUG ')
      IF(IUSE(ILOC).EQ.'F')WRITE(ICOUT,1227)
 1227 FORMAT('TYPE = FUNCTION')
      IF(IUSE(ILOC).EQ.'F')CALL DPWRST('XXX','BUG ')
      IF(IUSE(ILOC).NE.'V'.AND.IUSE(ILOC).NE.'F')WRITE(ICOUT,1228)
     1IUSE(ILOC)
 1228 FORMAT('TYPE = ',A4)
      IF(IUSE(ILOC).NE.'V'.AND.IUSE(ILOC).NE.'F')
     1CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1229)
 1229 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1230)(IANS(J),J=1,IWIDTH)
 1230 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
 1231 CONTINUE
      IERROR='YES'
      GOTO9000
C
 1300 CONTINUE
      IF(IUSE(ILOC).EQ.'V')GOTO1310
      GOTO1320
C
 1310 CONTINUE
      JVALUE=IVALUE(ILOC)
      AVALUE=VALUE(ILOC)
      JUSE=IUSE(ILOC)
      JN=IN(ILOC)
C
      IF(IOLDNI.NE.-999.AND.JN.NE.IOLDNI)GOTO1340
      IF(JN.LE.0)GOTO1360
      IOLDNA=IHTEST
      IOLDN2=IHTES2
      IOLDNI=JN
      GOTO9000
C
 1320 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1331
      IF(IPRINT.EQ.'OFF')GOTO1331
      IF(MESSAG.EQ.'NO')GOTO1331
      WRITE(ICOUT,1321)ISUBN1,ISUBN2
 1321 FORMAT('***** ERROR IN ',A4,A4,'--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1322)
 1322 FORMAT('      A NAME WHICH SHOULD BE A VARIABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1323)
 1323 FORMAT('      HAS BEEN FOUND IN THE NAME LIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1324)
 1324 FORMAT('      BUT AS A TYPE OTHER THAN A VARIABLE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1325)IHTEST,IHTES2
 1325 FORMAT('NAME = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      IF(IUSE(ILOC).EQ.'P')WRITE(ICOUT,1326)
 1326 FORMAT('TYPE = PARAMETER')
      IF(IUSE(ILOC).EQ.'P')CALL DPWRST('XXX','BUG ')
      IF(IUSE(ILOC).EQ.'F')WRITE(ICOUT,1327)
 1327 FORMAT('TYPE = FUNCTION')
      IF(IUSE(ILOC).EQ.'F')CALL DPWRST('XXX','BUG ')
      IF(IUSE(ILOC).NE.'P'.AND.IUSE(ILOC).NE.'F')WRITE(ICOUT,1328)
     1IUSE(ILOC)
 1328 FORMAT('TYPE = ',A4)
      IF(IUSE(ILOC).NE.'P'.AND.IUSE(ILOC).NE.'F')
     1CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1329)
 1329 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1330)(IANS(J),J=1,IWIDTH)
 1330 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
 1331 CONTINUE
      IERROR='YES'
      GOTO9000
C
 1340 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1351
      IF(IPRINT.EQ.'OFF')GOTO1351
      IF(MESSAG.EQ.'NO')GOTO1351
      WRITE(ICOUT,1341)ISUBN1,ISUBN2
 1341 FORMAT('***** ERROR IN ',A4,A4,'--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1342)
 1342 FORMAT('      ALL VARIABLES USED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1343)
 1343 FORMAT('      ON THE RIGHT-HAND SIDE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1344)
 1344 FORMAT('      MUST HAVE LENGTH GREATER THAN (OR EQUAL TO) 1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1345)
 1345 FORMAT('      (NUMBER OF ELEMNTS IS AT LEAST 1);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1346)
 1346 FORMAT('      SUCH WAS NOT THE CASE HERE FOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1347)IHTEST,IHTES2,IN(ILOC)
 1347 FORMAT('      VARIABLE ',A4,A4,' WITH ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1349)
 1349 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1350)(IANS(J),J=1,IWIDTH)
 1350 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
 1351 CONTINUE
      IERROR='YES'
      GOTO9000
C
 1360 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1371
      IF(IPRINT.EQ.'OFF')GOTO1371
      IF(MESSAG.EQ.'NO')GOTO1371
      WRITE(ICOUT,1361)ISUBN1,ISUBN2
 1361 FORMAT('***** ERROR IN ',A4,A4,'--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1362)
 1362 FORMAT('      ALL VARIABLES USED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1363)
 1363 FORMAT('      ON THE RIGHT-HAND SIDE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1364)
 1364 FORMAT('      MUST HAVE THE SAME LENGTH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1365)
 1365 FORMAT('      (NUMBER OF ELEMENTS);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1366)
 1366 FORMAT('      SUCH WAS NOT THE CASE HERE FOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1367)IHTEST,IHTES2,JN
 1367 FORMAT('      VARIABLE ',A4,A4,' WITH ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1368)IOLDNA,IOLDN2,IOLDNI
 1368 FORMAT('      VARIABLE ',A4,A4,' WITH ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1369)
 1369 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1370)(IANS(J),J=1,IWIDTH)
 1370 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
 1371 CONTINUE
      IERROR='YES'
      GOTO9000
C
 1400 CONTINUE
      IF(ITTEST.EQ.'P'.AND.IUSE(ILOC).NE.'P')GOTO1420
      IF(ITTEST.EQ.'V'.AND.IUSE(ILOC).NE.'V')GOTO1420
      IF(IUSE(ILOC).EQ.'P')GOTO1405
      IF(IUSE(ILOC).EQ.'V')GOTO1410
      GOTO1420
C
 1405 CONTINUE
      JVALUE=IVALUE(ILOC)
      AVALUE=VALUE(ILOC)
      JUSE=IUSE(ILOC)
      JN=IN(ILOC)
      GOTO9000
C
 1410 CONTINUE
      JVALUE=IVALUE(ILOC)
      AVALUE=VALUE(ILOC)
      JUSE=IUSE(ILOC)
      JN=IN(ILOC)
C
      IF(IOLDNI.NE.-999.AND.JN.NE.IOLDNI)GOTO1440
      IF(JN.LE.0)GOTO1460
      IOLDNA=IHTEST
      IOLDN2=IHTES2
      IOLDNI=JN
      GOTO9000
C
 1420 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1432
      IF(IPRINT.EQ.'OFF')GOTO1432
      IF(MESSAG.EQ.'NO')GOTO1432
      WRITE(ICOUT,1421)ISUBN1,ISUBN2
 1421 FORMAT('***** ERROR IN ',A4,A4,'--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1422)
 1422 FORMAT('      A NAME WHICH SHOULD BE A VARIABLE ',
     1'OR PARAMETER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1423)
 1423 FORMAT('      HAS BEEN FOUND IN THE NAME LIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1424)
 1424 FORMAT('      BUT AS A TYPE OTHER THAN A VARIABLE ',
     1'OR PARAMETER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1425)IHTEST,IHTES2
 1425 FORMAT('NAME = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      IF(IUSE(ILOC).EQ.'P')WRITE(ICOUT,1426)
 1426 FORMAT('TYPE = PARAMETER')
      IF(IUSE(ILOC).EQ.'P')CALL DPWRST('XXX','BUG ')
      IF(IUSE(ILOC).EQ.'V')WRITE(ICOUT,1427)
 1427 FORMAT('TYPE = VARIABLE')
      IF(IUSE(ILOC).EQ.'V')CALL DPWRST('XXX','BUG ')
      IF(IUSE(ILOC).EQ.'F')WRITE(ICOUT,1428)
 1428 FORMAT('TYPE = FUNCTION')
      IF(IUSE(ILOC).EQ.'F')CALL DPWRST('XXX','BUG ')
      IF(IUSE(ILOC).NE.'P'.AND.IUSE(ILOC).NE.'V'.
     1AND.IUSE(ILOC).NE.'F')WRITE(ICOUT,1429)IUSE(ILOC)
 1429 FORMAT('TYPE = ',A4)
      IF(IUSE(ILOC).NE.'P'.AND.IUSE(ILOC).NE.'V'.
     1AND.IUSE(ILOC).NE.'F')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1430)
 1430 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1431)(IANS(J),J=1,IWIDTH)
 1431 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
 1432 CONTINUE
      IERROR='YES'
      GOTO9000
C
 1440 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1451
      IF(IPRINT.EQ.'OFF')GOTO1451
      IF(MESSAG.EQ.'NO')GOTO1451
      WRITE(ICOUT,1441)ISUBN1,ISUBN2
 1441 FORMAT('***** ERROR IN ',A4,A4,'--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1442)
 1442 FORMAT('      ALL VARIABLES USED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1443)
 1443 FORMAT('      ON THE RIGHT-HAND SIDE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1444)
 1444 FORMAT('      MUST HAVE LENGTH GREATER THAN (OR EQUAL TO) 1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1445)
 1445 FORMAT('      (NUMBER OF ELEMENTS IS AT LEAST 1);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1446)
 1446 FORMAT('      SUCH WAS NOT THE CASE HERE FOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1447)IHTEST,IHTES2,IN(ILOC)
 1447 FORMAT('      VARIABLE ',A4,A4,' WITH ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1449)
 1449 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1450)(IANS(J),J=1,IWIDTH)
 1450 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
 1451 CONTINUE
      IERROR='YES'
      GOTO9000
C
 1460 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1471
      IF(IPRINT.EQ.'OFF')GOTO1471
      IF(MESSAG.EQ.'NO')GOTO1471
      WRITE(ICOUT,1461)ISUBN1,ISUBN2
 1461 FORMAT('***** ERROR IN ',A4,A4,'--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1462)
 1462 FORMAT('      ALL VARIABLES USED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1463)
 1463 FORMAT('      ON THE RIGHT-HAND SIDE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1464)
 1464 FORMAT('      MUST HAVE THE SAME LENGTH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1465)
 1465 FORMAT('      (NUMBER OF ELEMENTS);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1466)
 1466 FORMAT('      SUCH WAS NOT THE CASE HERE FOR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1467)IHTEST,IHTES2,JN
 1467 FORMAT('      VARIABLE ',A4,A4,' WITH ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1468)IOLDNA,IOLDN2,IOLDNI
 1468 FORMAT('      VARIABLE ',A4,A4,' WITH ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1469)
 1469 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1470)(IANS(J),J=1,IWIDTH)
 1470 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
 1471 CONTINUE
      IERROR='YES'
      GOTO9000
C
 1000 CONTINUE
C
 1010 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1021
      IF(IPRINT.EQ.'OFF')GOTO1021
      IF(MESSAG.EQ.'NO')GOTO1021
      WRITE(ICOUT,1011)ISUBN1,ISUBN2
 1011 FORMAT('***** ERROR IN ',A4,A4,'--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1012)
 1012 FORMAT('      A VARIABLE OR PARAMETER NAME USED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1013)
 1013 FORMAT('      ON THE RIGHT-HAND SIDE IS NOT YET DEFINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1014)IHTEST,IHTES2
 1014 FORMAT('      VARIABLE OR PARAMETER NAME = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1015)
 1015 FORMAT('      CURRENT LIST OF DEFINED VARIABLES AND ',
     1'PARAMETERS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1016I2=1,NUMNAM
      IF(IUSE(I).EQ.'P'.OR.IUSE(I).EQ.'V')
     1WRITE(ICOUT,1017)IHNAME(I2),IHNAM2(I2),IUSE(I2),IVALUE(I2),
     1VALUE(I2),IN(ILOC)
 1017 FORMAT(A4,2X,A4,2X,A4,2X,I8,2X,E15.6,I8)
      IF(IUSE(I).EQ.'P'.OR.IUSE(I).EQ.'V')
     1CALL DPWRST('XXX','BUG ')
 1016 CONTINUE
      WRITE(ICOUT,1019)
 1019 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1020)(IANS(J),J=1,IWIDTH)
 1020 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
 1021 CONTINUE
      IERROR='YES'
      GOTO9000
C
 9000 CONTINUE
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'ECN2')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF CHECN2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOC
 9012 FORMAT('ILOC = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)JVALUE,AVALUE,JUSE,JN
 9013 FORMAT('JVALUE,AVALUE,JUSE,JN = ',I8,F15.7,3X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IOLDNA,IOLDN2,IOLDNI,IFOUND,IBUGA3,IERROR
 9014 FORMAT('IOLDNA,IOLDN2,IOLDNI,IFOUND,IBUGA3,IERROR = ',
     1A4,2X,A4,2X,I8,2X,A4,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE CHECN3(IHWORD,IHWOR2,IHWUSE,
     1                  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,
     1                  NUMNAM,MAXNAM,
     1                  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
C
C     PURPOSE--CHECK TO SEE IF THE HOLLERITH NAME IN (IHWORD,IHWOR2)
C              EXISTS IN THE CURRENT TABLE OF AVAILABLE PARAMETER AND
C              VARIABLE NAMES AS GIVEN IN IHNAME(.) AND IHNAM2(I).
C     NOTE--THIS IS A SLIGHT VARIANT OF CHECKN.  IT DISTINGUISHES
C           BETWEEN THE CASE WHERE THE NAME IS NOT FOUND (ILOC=0)
C           AND WHERE THE NAME IS FOUND BUT IS OF THE WRONG TYPE
C           (ILOC=-1).
C     OUTPUT--THE LOCATION (THAT IS, THE LINE OR ROW) IN THE TABLE
C             WHERE THE NAME WAS FOUND (IF FOUND).
C             THIS LOCATION IS STORED IN THE VARIABLE ILOC.
C             ALSO, A VALUE OF 'YES' OR 'NO' IS STORED
C             IN THE HOLLERITH VARIABLE IERROR
C             DEPENDING ON WHETHER THE NAME WAS NOT FOUND
C             OR WAS FOUND, RESPECTIVELY.
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2007/5
C     ORIGINAL VERSION--MAY 2007.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHWORD
      CHARACTER*4 IHWOR2
      CHARACTER*4 IHWUSE
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 MESSAG
      CHARACTER*4 IANS
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IN(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
C
      DIMENSION IANS(*)
C
      INCLUDE 'DPCOBE.INC'
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      IF(ISUBG4.EQ.'ECN3')THEN
        WRITE(ICOUT,61)MAXNAM,IWIDTH
   61   FORMAT('MAXNAM,IWIDTH = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,63)(IANS(I),I=1,MIN(100,IWIDTH))
   63   FORMAT('IANS(.) = ',100A1)
        CALL DPWRST('XXX','BUG ')
        DO67I=1,NUMNAM
          WRITE(ICOUT,68)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I),
     1                   VALUE(I)
   68     FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I)',
     1           'VALUE(I) = ',I8,2X,A4,A4,2X,A4,2I8,G15.7)
          CALL DPWRST('XXX','BUG ')
   67   CONTINUE
      ENDIF
C
      IF(IHWUSE.EQ.'P')GOTO100
      IF(IHWUSE.EQ.'V')GOTO200
      IF(IHWUSE.EQ.'EITH')GOTO300
      IF(IHWUSE.EQ.'PORV')GOTO300
      IF(IHWUSE.EQ.'VORP')GOTO300
C
  100 CONTINUE
      DO150I=1,NUMNAM
      I2=I
      IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO800
      IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I))GOTO110
  150 CONTINUE
      GOTO700
C
  110 CONTINUE
      IF(MESSAG.EQ.'NO')GOTO119
      WRITE(ICOUT,111)IHWORD,IHWOR2
  111 FORMAT('     A COMMAND OR EXPRESSION EXPECTED THE NAME ',2A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,112)
  112 FORMAT('     TO BE USED AS A PARAMETER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,113)
  113 FORMAT('     THE NAME WAS FOUND IN THE INTERNAL TABLE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,114)
  114 FORMAT('     BUT NOT AS A PARAMETER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,115)
  115 FORMAT('     PLEASE RECHECK THE COMMAND SYNTAX.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
  119 CONTINUE
      GOTO750
C
  200 CONTINUE
      DO250I=1,NUMNAM
      I2=I
      IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO800
      IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I))GOTO210
  250 CONTINUE
      GOTO700
C
  210 CONTINUE
      IF(MESSAG.EQ.'NO')GOTO219
      WRITE(ICOUT,211)IHWORD,IHWOR2
  211 FORMAT('     A COMMAND OR EXPRESSION EXPECTED THE NAME ',2A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,212)
  212 FORMAT('     TO BE USED AS A VARIABLE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,213)
  213 FORMAT('     THE NAME WAS FOUND IN THE INTERNAL TABLE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,214)
  214 FORMAT('     BUT NOT AS A VARIABLE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,215)
  215 FORMAT('     PLEASE RECHECK THE COMMAND SYNTAX.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
  219 CONTINUE
      GOTO750
C
  300 CONTINUE
      DO350I=1,NUMNAM
      I2=I
      IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO800
      IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO800
      IF(IHWORD.EQ.IHNAME(I).AND.IHWOR2.EQ.IHNAM2(I))GOTO310
  350 CONTINUE
      GOTO700
C
  310 CONTINUE
      IF(MESSAG.EQ.'NO')GOTO319
      WRITE(ICOUT,311)IHWORD,IHWOR2
  311 FORMAT('     A COMMAND OR EXPRESSION EXPECTED THE NAME ',2A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('     TO BE USED AS A PARAMETER OR VARIABLE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('     THE NAME WAS FOUND IN THE INTERNAL TABLE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('     BUT NEITHER AS A PARAMETER NOR A VARIABLE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)
  315 FORMAT('     PLEASE RECHECK THE COMMAND SYNTAX.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
  319 CONTINUE
      GOTO750
C
  700 CONTINUE
      IF(MESSAG.EQ.'NO')GOTO709
      WRITE(ICOUT,702)ISUBN1,ISUBN2
  702 FORMAT('***** ERROR IN CHECN3 AS CALLED FROM ',2A4,'--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,703)
  703 FORMAT('      A VARIABLE OR PARAMETER NAME USED (OR NEEDED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,704)
  704 FORMAT('      IN A COMMAND OR AN EXPRESSION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,705)
  705 FORMAT('      WAS NOT FOUND IN THE CURRENT LIST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,706)
  706 FORMAT('      OF AVAILABLE PARAMETER AND VARIABLE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,707)IHWORD,IHWOR2
  707 FORMAT('      THE VARIABLE OR PARAMETER IN QUESTION WAS ',2A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
  709 CONTINUE
      GOTO760
C
  750 CONTINUE
      ILOC=-1
      IERROR='YES'
      RETURN
C
  760 CONTINUE
      ILOC=0
      IERROR='YES'
      RETURN
C
  800 CONTINUE
      ILOC=I2
      IERROR='NO'
      RETURN
C
      END
      SUBROUTINE CHLHSN(NR,N,A,EPSM,SX,UDIAG)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C PURPOSE
C -------
C FIND THE L(L-TRANSPOSE) [WRITTEN LL+] DECOMPOSITION OF THE PERTURBED
C MODEL HESSIAN MATRIX A+MU*I(WHERE MU\0 AND I IS THE IDENTITY MATRIX)
C WHICH IS SAFELY POSITIVE DEFINITE.  IF A IS SAFELY POSITIVE DEFINITE
C UPON ENTRY, THEN MU=0.
C
C PARAMETERS
C ----------
C NR           --> ROW DIMENSION OF MATRIX
C N            --> DIMENSION OF PROBLEM
C A(N,N)      <--> ON ENTRY; "A" IS MODEL HESSIAN (ONLY LOWER
C                  TRIANGULAR PART AND DIAGONAL STORED)
C                  ON EXIT:  A CONTAINS L OF LL+ DECOMPOSITION OF
C                  PERTURBED MODEL HESSIAN IN LOWER TRIANGULAR
C                  PART AND DIAGONAL AND CONTAINS HESSIAN IN UPPER
C                  TRIANGULAR PART AND UDIAG
C EPSM         --> MACHINE EPSILON
C SX(N)        --> DIAGONAL SCALING MATRIX FOR X
C UDIAG(N)    <--  ON EXIT: CONTAINS DIAGONAL OF HESSIAN
C
C INTERNAL VARIABLES
C ------------------
C TOL              TOLERANCE
C DIAGMN           MINIMUM ELEMENT ON DIAGONAL OF A
C DIAGMX           MAXIMUM ELEMENT ON DIAGONAL OF A
C OFFMAX           MAXIMUM OFF-DIAGONAL ELEMENT OF A
C OFFROW           SUM OF OFF-DIAGONAL ELEMENTS IN A ROW OF A
C EVMIN            MINIMUM EIGENVALUE OF A
C EVMAX            MAXIMUM EIGENVALUE OF A
C
C DESCRIPTION
C -----------
C 1. IF "A" HAS ANY NEGATIVE DIAGONAL ELEMENTS, THEN CHOOSE MU>0
C SUCH THAT THE DIAGONAL OF A:=A+MU*I IS ALL POSITIVE
C WITH THE RATIO OF ITS SMALLEST TO LARGEST ELEMENT ON THE
C ORDER OF SQRT(EPSM).
C
C 2. "A" UNDERGOES A PERTURBED CHOLESKY DECOMPOSITION WHICH
C RESULTS IN AN LL+ DECOMPOSITION OF A+D, WHERE D IS A
C NON-NEGATIVE DIAGONAL MATRIX WHICH IS IMPLICITLY ADDED TO
C "A" DURING THE DECOMPOSITION IF "A" IS NOT POSITIVE DEFINITE.
C "A" IS RETAINED AND NOT CHANGED DURING THIS PROCESS BY
C COPYING L INTO THE UPPER TRIANGULAR PART OF "A" AND THE
C DIAGONAL INTO UDIAG.  THEN THE CHOLESKY DECOMPOSITION ROUTINE
C IS CALLED.  ON RETURN, ADDMAX CONTAINS MAXIMUM ELEMENT OF D.
C
C 3. IF ADDMAX=0, "A" WAS POSITIVE DEFINITE GOING INTO STEP 2
C AND RETURN IS MADE TO CALLING PROGRAM.  OTHERWISE,
C THE MINIMUM NUMBER SDD WHICH MUST BE ADDED TO THE
C DIAGONAL OF A TO MAKE IT SAFELY STRICTLY DIAGONALLY DOMINANT
C IS CALCULATED.  SINCE A+ADDMAX*I AND A+SDD*I ARE SAFELY
C POSITIVE DEFINITE, CHOOSE MU=MIN(ADDMAX,SDD) AND DECOMPOSE
C A+MU*I TO OBTAIN L.
C
      DIMENSION A(NR,1),SX(N),UDIAG(N)
C
C SCALE HESSIAN
C PRE- AND POST- MULTIPLY "A" BY INV(SX)
C
      DO 20 J=1,N
        DO 10 I=J,N
          A(I,J)=A(I,J)/(SX(I)*SX(J))
   10   CONTINUE
   20 CONTINUE
C
C STEP1
C -----
C NOTE:  IF A DIFFERENT TOLERANCE IS DESIRED THROUGHOUT THIS
C ALGORITHM, CHANGE TOLERANCE HERE:
      TOL=SQRT(EPSM)
C
      DIAGMX=A(1,1)
      DIAGMN=A(1,1)
      IF(N.EQ.1) GO TO 35
      DO 30 I=2,N
        IF(A(I,I).LT.DIAGMN) DIAGMN=A(I,I)
        IF(A(I,I).GT.DIAGMX) DIAGMX=A(I,I)
   30 CONTINUE
   35 POSMAX=MAX(DIAGMX,0.D0)
C
C DIAGMN .LE. 0
C
      IF(DIAGMN.GT.POSMAX*TOL) GO TO 100
C     IF(DIAGMN.LE.POSMAX*TOL)
C     THEN
        AMU=TOL*(POSMAX-DIAGMN)-DIAGMN
        IF(AMU.NE.0.) GO TO 60
C       IF(AMU.EQ.0.)
C       THEN
C
C FIND LARGEST OFF-DIAGONAL ELEMENT OF A
          OFFMAX=0.D0
          IF(N.EQ.1) GO TO 50
          DO 45 I=2,N
            IM1=I-1
            DO 40 J=1,IM1
              IF(ABS(A(I,J)).GT.OFFMAX) OFFMAX=ABS(A(I,J))
   40       CONTINUE
   45     CONTINUE
   50     AMU=OFFMAX
          IF(AMU.NE.0.D0) GO TO 55
C         IF(AMU.EQ.0.D0)
C         THEN
            AMU=1.0D0
            GO TO 60
C         ELSE
   55       AMU=AMU*(1.0D0+TOL)
C         ENDIF
C       ENDIF
C
C A=A + MU*I
C
   60   DO 65 I=1,N
          A(I,I)=A(I,I)+AMU
   65   CONTINUE
        DIAGMX=DIAGMX+AMU
C     ENDIF
C
C STEP2
C -----
C COPY LOWER TRIANGULAR PART OF "A" TO UPPER TRIANGULAR PART
C AND DIAGONAL OF "A" TO UDIAG
C
  100 CONTINUE
      DO 110 J=1,N
        UDIAG(J)=A(J,J)
        IF(J.EQ.N) GO TO 110
        JP1=J+1
        DO 105 I=JP1,N
          A(J,I)=A(I,J)
  105   CONTINUE
  110 CONTINUE
C
      CALL CHOLDC(NR,N,A,DIAGMX,TOL,ADDMAX)
C
C
C STEP3
C -----
C IF ADDMAX=0, "A" WAS POSITIVE DEFINITE GOING INTO STEP 2,
C THE LL+ DECOMPOSITION HAS BEEN DONE, AND WE RETURN.
C OTHERWISE, ADDMAX>0.  PERTURB "A" SO THAT IT IS SAFELY
C DIAGONALLY DOMINANT AND FIND LL+ DECOMPOSITION
C
      IF(ADDMAX.LE.0.) GO TO 170
C     IF(ADDMAX.GT.0.)
C     THEN
C
C RESTORE ORIGINAL "A" (LOWER TRIANGULAR PART AND DIAGONAL)
C
        DO 120 J=1,N
          A(J,J)=UDIAG(J)
          IF(J.EQ.N) GO TO 120
          JP1=J+1
          DO 115 I=JP1,N
            A(I,J)=A(J,I)
  115     CONTINUE
  120   CONTINUE
C
C FIND SDD SUCH THAT A+SDD*I IS SAFELY POSITIVE DEFINITE
C NOTE:  EVMIN<0 SINCE A IS NOT POSITIVE DEFINITE;
C
        EVMIN=0.
        EVMAX=A(1,1)
        DO 150 I=1,N
          OFFROW=0.D0
          IF(I.EQ.1) GO TO 135
          IM1=I-1
          DO 130 J=1,IM1
            OFFROW=OFFROW+ABS(A(I,J))
  130     CONTINUE
  135     IF(I.EQ.N) GO TO 145
          IP1=I+1
          DO 140 J=IP1,N
            OFFROW=OFFROW+ABS(A(J,I))
  140     CONTINUE
  145     EVMIN=MIN(EVMIN,A(I,I)-OFFROW)
          EVMAX=MAX(EVMAX,A(I,I)+OFFROW)
  150   CONTINUE
        SDD=TOL*(EVMAX-EVMIN)-EVMIN
C
C PERTURB "A" AND DECOMPOSE AGAIN
C
        AMU=MIN(SDD,ADDMAX)
        DO 160 I=1,N
          A(I,I)=A(I,I)+AMU
          UDIAG(I)=A(I,I)
  160   CONTINUE
C
C "A" NOW GUARANTEED SAFELY POSITIVE DEFINITE
C
        CALL CHOLDC(NR,N,A,0.0D0,TOL,ADDMAX)
C     ENDIF
C
C UNSCALE HESSIAN AND CHOLESKY DECOMPOSITION MATRIX
C
  170 DO 190 J=1,N
        DO 175 I=J,N
          A(I,J)=SX(I)*A(I,J)
  175   CONTINUE
        IF(J.EQ.1) GO TO 185
        JM1=J-1
        DO 180 I=1,JM1
          A(I,J)=SX(I)*SX(J)*A(I,J)
  180   CONTINUE
  185   UDIAG(J)=UDIAG(J)*SX(J)*SX(J)
  190 CONTINUE
      RETURN
      END
      SUBROUTINE CHOLDC(NR,N,A,DIAGMX,TOL,ADDMAX)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C PURPOSE
C -------
C FIND THE PERTURBED L(L-TRANSPOSE) [WRITTEN LL+] DECOMPOSITION
C OF A+D, WHERE D IS A NON-NEGATIVE DIAGONAL MATRIX ADDED TO A IF
C NECESSARY TO ALLOW THE CHOLESKY DECOMPOSITION TO CONTINUE.
C
C PARAMETERS
C ----------
C NR           --> ROW DIMENSION OF MATRIX
C N            --> DIMENSION OF PROBLEM
C A(N,N)      <--> ON ENTRY: MATRIX FOR WHICH TO FIND PERTURBED
C                       CHOLESKY DECOMPOSITION
C                  ON EXIT:  CONTAINS L OF LL+ DECOMPOSITION
C                  IN LOWER TRIANGULAR PART AND DIAGONAL OF "A"
C DIAGMX       --> MAXIMUM DIAGONAL ELEMENT OF "A"
C TOL          --> TOLERANCE
C ADDMAX      <--  MAXIMUM AMOUNT IMPLICITLY ADDED TO DIAGONAL OF "A"
C                  IN FORMING THE CHOLESKY DECOMPOSITION OF A+D
C INTERNAL VARIABLES
C ------------------
C AMINL    SMALLEST ELEMENT ALLOWED ON DIAGONAL OF L
C AMNLSQ   =AMINL**2
C OFFMAX   MAXIMUM OFF-DIAGONAL ELEMENT IN COLUMN OF A
C
C
C DESCRIPTION
C -----------
C THE NORMAL CHOLESKY DECOMPOSITION IS PERFORMED.  HOWEVER, IF AT ANY
C POINT THE ALGORITHM WOULD ATTEMPT TO SET L(I,I)=SQRT(TEMP)
C WITH TEMP < TOL*DIAGMX, THEN L(I,I) IS SET TO SQRT(TOL*DIAGMX)
C INSTEAD.  THIS IS EQUIVALENT TO ADDING TOL*DIAGMX-TEMP TO A(I,I)
C
C
      DIMENSION A(NR,1)
C
      ADDMAX=0.D0
      AMINL=SQRT(DIAGMX*TOL)
      AMNLSQ=AMINL*AMINL
C
C FORM COLUMN J OF L
C
      DO 100 J=1,N
C FIND DIAGONAL ELEMENTS OF L
        SUM=0.D0
        IF(J.EQ.1) GO TO 20
        JM1=J-1
        DO 10 K=1,JM1
          SUM=SUM + A(J,K)*A(J,K)
   10   CONTINUE
   20   TEMP=A(J,J)-SUM
        IF(TEMP.LT.AMNLSQ) GO TO 30
C       IF(TEMP.GE.AMINL**2)
C       THEN
          A(J,J)=SQRT(TEMP)
          GO TO 40
C       ELSE
C
C FIND MAXIMUM OFF-DIAGONAL ELEMENT IN COLUMN
   30     OFFMAX=0.D0
          IF(J.EQ.N) GO TO 37
          JP1=J+1
          DO 35 I=JP1,N
            IF(ABS(A(I,J)).GT.OFFMAX) OFFMAX=ABS(A(I,J))
   35     CONTINUE
   37     IF(OFFMAX.LE.AMNLSQ) OFFMAX=AMNLSQ
C
C ADD TO DIAGONAL ELEMENT  TO ALLOW CHOLESKY DECOMPOSITION TO CONTINUE
          A(J,J)=SQRT(OFFMAX)
          ADDMAX=MAX(ADDMAX,OFFMAX-TEMP)
C       ENDIF
C
C FIND I,J ELEMENT OF LOWER TRIANGULAR MATRIX
   40   IF(J.EQ.N) GO TO 100
        JP1=J+1
        DO 70 I=JP1,N
          SUM=0.0D0
          IF(J.EQ.1) GO TO 60
          JM1=J-1
          DO 50 K=1,JM1
            SUM=SUM+A(I,K)*A(J,K)
   50     CONTINUE
   60     A(I,J)=(A(I,J)-SUM)/A(J,J)
   70   CONTINUE
  100 CONTINUE
      RETURN
      END
      SUBROUTINE CHOLNV(N, CHOINV)
*
*     Inverts a lower triangular matrix in situ
*
      INTEGER I, II, J, JJ, K, KK, N
      DOUBLE PRECISION CHOINV(*), T
      DOUBLE PRECISION S
      II = 0
      DO 100 I = 1,N
         T = 1/CHOINV(II+I)
         JJ = 0
         DO 200 J = 1,I-1
            S = 0
            JJ = JJ + J
            KK = JJ
            DO 300 K = J,I-1
               S = S + CHOINV(II+K)*CHOINV(KK)
               KK = KK + K
  300       CONTINUE
            CHOINV(II+J) = -S*T
  200    CONTINUE
         II = II + I
         CHOINV(II) = T
 100  CONTINUE
C
      RETURN
      END
      SUBROUTINE CHOLPD(N, CHOPRD)
*
*     Multiplies Choleski factors in situ
*
      INTEGER I, II, J, K, KK, N, NN
      DOUBLE PRECISION CHOPRD(*), S
      NN = (N*(N+1))/2
      KK = NN
      DO 100 K = N,1,-1
         KK = KK - K
         II = NN
         DO 200 I = N,K,-1
            II = II - I
            S = 0
            DO 300 J = 1,K
               S = S + CHOPRD(II+J)*CHOPRD(KK+J)
  300       CONTINUE
            CHOPRD(II+K) = S
  200    CONTINUE
  100 CONTINUE
C
      RETURN
      END
      SUBROUTINE CHOLPI(N, CHOPDI)
*
*     Multiplies Choleski inverse factors in situ
*
      INTEGER I, II, J, JJ, K, KK, N
      DOUBLE PRECISION CHOPDI(*)
      DOUBLE PRECISION S
      II = 0
      DO 100 I = 1,N
         DO 200 J = 1,I
            S = 0
            JJ = II + I
            KK = II + J
            DO 300 K = I,N
               S = S + CHOPDI(KK)*CHOPDI(JJ)
               JJ = JJ + K
               KK = KK + K
  300       CONTINUE
            CHOPDI(II+J) = S
  200    CONTINUE
         II = II + I
  100 CONTINUE
C
      RETURN
      END
      SUBROUTINE CHOLSK(N, CHOFAC)
*
*     Computes Choleski factor in situ
*
      INTEGER I, II, J, JJ, K, N
      DOUBLE PRECISION CHOFAC(*), T
      DOUBLE PRECISION S, ZERO
      PARAMETER ( ZERO = 0 )
C
      T=0.0
      S=0.0
      JJ = 0
C
      DO 100 J = 1,N
         II = JJ
         DO 200 I = J,N
            S = CHOFAC(II+J)
            DO 300 K = 1,J-1
               S = S - CHOFAC(II+K)*CHOFAC(JJ+K)
  300       CONTINUE
            IF ( I .EQ. J ) THEN
               T = SQRT( MAX( S, ZERO ) )
               CHOFAC(II+J) = T
            ELSE
               CHOFAC(II+J) = S/T
            ENDIF
            II = II + I
  200    CONTINUE
         JJ = JJ + J
  100 CONTINUE
C
      RETURN
      END
      SUBROUTINE CHSCDF(X,NU,CDF)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE FOR THE CHI-SQUARED DISTRIBUTION
C              WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU.
C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X.
C              THE PROBABILITY DENSITY FUNCTION IS GIVEN
C              IN THE REFERENCES BELOW.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
C                                WHICH THE CUMULATIVE DISTRIBUTION
C                                FUNCTION IS TO BE EVALUATED.
C                                X SHOULD BE NON-NEGATIVE.
C                     --NU     = THE INTEGER NUMBER OF DEGREES
C                                OF FREEDOM.
C                                NU SHOULD BE POSITIVE.
C     OUTPUT ARGUMENTS--CDF    = THE SINGLE PRECISION CUMULATIVE
C                                DISTRIBUTION FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION
C             FUNCTION VALUE CDF FOR THE CHI-SQUARED DISTRIBUTION
C             WITH DEGREES OF FREEDOM PARAMETER = NU.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE.
C                 --NU SHOULD BE A POSITIVE INTEGER VARIABLE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NORCDF.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DEXP.
C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 941, FORMULAE 26.4.4 AND 26.4.5.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGE 176,
C                 FORMULA 28, AND PAGE 180, FORMULA 33.1.
C               --OWEN, HANDBOOK OF STATISTICAL TABLES,
C                 1962, PAGES 50-55.
C               --PEARSON AND HARTLEY, BIOMETRIKA TABLES
C                 FOR STATISTICIANS, VOLUME 1, 1954,
C                 PAGES 122-131.
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     LANGUAGE--ANSI FORTRAN (1966)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JUNE      1972.
C     UPDATED         --MAY       1974.
C     UPDATED         --SEPTEMBER 1975.
C     UPDATED         --NOVEMBER  1975.
C     UPDATED         --OCTOBER   1976.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DX,PI,CHI,SUM,TERM,AI,DCDFN
      DOUBLE PRECISION DNU
      DOUBLE PRECISION DSQRT,DEXP
      DOUBLE PRECISION DLOG
      DOUBLE PRECISION DFACT,DPOWER
      DOUBLE PRECISION DW
      DOUBLE PRECISION D1,D2,D3
      DOUBLE PRECISION TERM0,TERM1,TERM2,TERM3,TERM4
      DOUBLE PRECISION B11
      DOUBLE PRECISION B21
      DOUBLE PRECISION B31,B32
      DOUBLE PRECISION B41,B42,B43
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA NUCUT/1000/
      DATA PI/3.14159265358979D0/
      DATA DPOWER/0.33333333333333D0/
      DATA B11/0.33333333333333D0/
      DATA B21/-0.02777777777778D0/
      DATA B31/-0.00061728395061D0/
      DATA B32/-13.0D0/
      DATA B41/0.00018004115226D0/
      DATA B42/6.0D0/
      DATA B43/17.0D0/
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(NU.LE.0)GOTO50
      IF(X.LT.0.0)GOTO55
      GOTO90
   50 WRITE(ICOUT,15)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,47)NU
      CALL DPWRST('XXX','BUG ')
      CDF=0.0
      RETURN
   55 WRITE(ICOUT,4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,46)X
      CALL DPWRST('XXX','BUG ')
      CDF=0.0
      RETURN
   90 CONTINUE
    4 FORMAT('***** NON-FATAL DIAGNOSTIC--THE 1ST INPUT ARGUMENT ',
     1'TO THE CHSCDF SUBROUTINE IS NEGATIVE *****')
   15 FORMAT('***** FATAL ERROR--THE 2ND INPUT ARGUMENT TO THE ',
     1'CHSCDF SUBROUTINE IS NON-POSITIVE *****')
   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8   ,' *****')
C
      DX=X
      ANU=NU
      DNU=NU
C
C     IF X IS NON-POSITIVE, SET CDF = 0.0 AND RETURN.
C     IF NU IS SMALLER THAN 10 AND X IS MORE THAN 200
C     STANDARD DEVIATIONS BELOW THE MEAN,
C     SET CDF = 0.0 AND RETURN.
C     IF NU IS 10 OR LARGER AND X IS MORE THAN 100
C     STANDARD DEVIATIONS BELOW THE MEAN,
C     SET CDF = 0.0 AND RETURN.
C     IF NU IS SMALLER THAN 10 AND X IS MORE THAN 200
C     STANDARD DEVIATIONS ABOVE THE MEAN,
C     SET CDF = 1.0 AND RETURN.
C     IF NU IS 10 OR LARGER AND X IS MORE THAN 100
C     STANDARD DEVIATIONS ABOVE THE MEAN,
C     SET CDF = 1.0 AND RETURN.
C
      IF(X.LE.0.0)GOTO105
      AMEAN=ANU
      SD=SQRT(2.0*ANU)
      Z=(X-AMEAN)/SD
      IF(NU.LT.10.AND.Z.LT.-200.0)GOTO105
      IF(NU.GE.10.AND.Z.LT.-100.0)GOTO105
      IF(NU.LT.10.AND.Z.GT.200.0)GOTO107
      IF(NU.GE.10.AND.Z.GT.100.0)GOTO107
      GOTO109
  105 CDF=0.0
      RETURN
  107 CDF=1.0
      RETURN
  109 CONTINUE
C
C     DISTINGUISH BETWEEN 3 SEPARATE REGIONS
C     OF THE (X,NU) SPACE.
C     BRANCH TO THE PROPER COMPUTATIONAL METHOD
C     DEPENDING ON THE REGION.
C     NUCUT HAS THE VALUE 1000.
C
      IF(NU.LT.NUCUT)GOTO1000
      IF(NU.GE.NUCUT.AND.X.LE.ANU)GOTO2000
      IF(NU.GE.NUCUT.AND.X.GT.ANU)GOTO3000
      IBRAN=1
      WRITE(ICOUT,99)IBRAN
   99 FORMAT('*****INTERNAL ERROR IN CHSCDF SUBROUTINE--',
     1'IMPOSSIBLE BRANCH CONDITION AT BRANCH POINT = ',I8)
      CALL DPWRST('XXX','BUG ')
      RETURN
C
C     TREAT THE SMALL AND MODERATE DEGREES OF FREEDOM CASE
C     (THAT IS, WHEN NU IS SMALLER THAN 1000).
C     METHOD UTILIZED--EXACT FINITE SUM
C     (SEE AMS 55, PAGE 941, FORMULAE 26.4.4 AND 26.4.5).
C
 1000 CONTINUE
      CHI=DSQRT(DX)
      IEVODD=NU-2*(NU/2)
      IF(IEVODD.EQ.0)GOTO120
C
      SUM=0.0D0
      TERM=1.0/CHI
      IMIN=1
      IMAX=NU-1
      GOTO130
C
  120 SUM=1.0D0
      TERM=1.0D0
      IMIN=2
      IMAX=NU-2
C
  130 IF(IMIN.GT.IMAX)GOTO160
      DO100I=IMIN,IMAX,2
      AI=I
      TERM=TERM*(DX/AI)
      SUM=SUM+TERM
  100 CONTINUE
  160 CONTINUE
C
      SUM=SUM*DEXP(-DX/2.0D0)
      IF(IEVODD.EQ.0)GOTO170
      SUM=(DSQRT(2.0D0/PI))*SUM
      SPCHI=CHI
      CALL NORCDF(SPCHI,CDFN)
      DCDFN=CDFN
      SUM=SUM+2.0D0*(1.0D0-DCDFN)
  170 CDF=1.0D0-SUM
      RETURN
C
C     TREAT THE CASE WHEN NU IS LARGE
C     (THAT IS, WHEN NU IS EQUAL TO OR GREATER THAN 1000)
C     AND X IS LESS THAN OR EQUAL TO NU.
C     METHOD UTILIZED--WILSON-HILFERTY APPROXIMATION
C     (SEE JOHNSON AND KOTZ, VOLUME 1, PAGE 176, FORMULA 28).
C
 2000 CONTINUE
      DFACT=4.5D0*DNU
      U=(((DX/DNU)**DPOWER)-1.0D0+(1.0D0/DFACT))*DSQRT(DFACT)
      CALL NORCDF(U,CDFN)
      CDF=CDFN
      RETURN
C
C     TREAT THE CASE WHEN NU IS LARGE
C     (THAT IS, WHEN NU IS EQUAL TO OR GREATER THAN 1000)
C     AND X IS LARGER THAN NU.
C     METHOD UTILIZED--HILL'S ASYMPTOTIC EXPANSION
C     (SEE JOHNSON AND KOTZ, VOLUME 1, PAGE 180, FORMULA 33.1).
C
 3000 CONTINUE
      DW=DSQRT(DX-DNU-DNU*DLOG(DX/DNU))
      DANU=DSQRT(2.0D0/DNU)
      D1=DW
      D2=DW**2
      D3=DW**3
      TERM0=DW
      TERM1=B11*DANU
      TERM2=B21*D1*(DANU**2)
      TERM3=B31*(D2+B32)*(DANU**3)
      TERM4=B41*(B42*D3+B43*D1)*(DANU**4)
      U=TERM0+TERM1+TERM2+TERM3+TERM4
      CALL NORCDF(U,CDFN)
      CDF=CDFN
      RETURN
C
      END
      SUBROUTINE CHSPDF(X,NU,PDF)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY
C              FUNCTION VALUE FOR THE CHI-SQUARED DISTRIBUTION
C              WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU.
C              THIS DISTRIBUTION IS DEFINED FOR ALL X.
C              THE PROBABILITY DENSITY FUNCTION IS GIVEN
C              IN THE REFERENCES BELOW.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
C                                WHICH THE PROBABILITY DENSITY
C                                FUNCTION IS TO BE EVALUATED.
C                                X SHOULD BE NON-NEGATIVE.
C                     --NU     = THE INTEGER NUMBER OF DEGREES
C                                OF FREEDOM.
C                                NU SHOULD BE POSITIVE.
C     OUTPUT ARGUMENTS--PDF    = THE SINGLE PRECISION PROBABILITY
C                                DENSITY FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY
C             FUNCTION VALUE PDF FOR THE THE CHI-SQUARED DISTRIBUTION
C             WITH DEGREES OF FREEDOM PARAMETER = NU.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
C     RESTRICTIONS--NU SHOULD BE A POSITIVE INTEGER VARIABLE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DATAN.
C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 941, FORMULAE 26.4.1.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGE XXX,
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     LANGUAGE--ANSI FORTRAN (1966)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DX
      DOUBLE PRECISION DNU
      DOUBLE PRECISION DNUH
      DOUBLE PRECISION DGF
      DOUBLE PRECISION DPOWER
      DOUBLE PRECISION DCONST
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DTERM2
      DOUBLE PRECISION DTERM
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(NU.LE.0)GOTO150
      GOTO190
  150 CONTINUE
      WRITE(ICOUT,115)
  115 FORMAT('***** FATAL ERROR--THE 2ND INPUT ARGUMENT ',
     1'TO THE   CHSPDF   SUBROUTINE IS NON-POSITIVE *****')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,147)NU
  147 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,
     1' *****')
      CALL DPWRST('XXX','BUG ')
      PDF=0.0
      GOTO9000
  190 CONTINUE
C
C               **********************************************************
C               **  STEP 2--                                            **
C               **  COMPUTE THE CONSTANT = 1/((GAMMA(NU/2))*2**(NU/2))  **
C               **********************************************************
C
C
      DX=X
      DNU=NU
      DNUH=DNU/2.0D0
      CALL DGAMMF(DNUH,DGF)
      DPOWER=2.0D0**DNUH
      DCONST=1.0D0/(DPOWER*DGF)
C
C               ************************************
C               **  STEP 3--                      **
C               **  COMPUTE THE DENSITY FUNCTION  **
C               ************************************
C
      IF(X.LE.0.0)PDF=0.0
      IF(X.LE.0.0)GOTO9000
C
      DTERM1=DX**(DNUH-1.0D0)
      DTERM2=DEXP(-(DX/2.0D0))
      DTERM=DTERM1*DTERM2
      PDF=DCONST*DTERM
      GOTO9000
C
 9000 CONTINUE
CCCCC WRITE(ICOUT,9011)DX,DNUH,DNUH,DGF,DPOWER,DCONST
C9011 FORMAT('DX,DNUH,DNUH,DGF,DPOWER,DCONST = ',6D12.4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9012)DTERM1,DTERM2,DTERM,PDF
C9012 FORMAT('DTERM1,DTERM2,DTERM,PDF = ',3D12.4,E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
      RETURN
      END
      SUBROUTINE CHSPPF(P,NU,PPF)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE FOR THE CHI-SQUARED DISTRIBUTION
C              WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU.
C              THE CHI-SQUARED DISTRIBUTION USED
C              HEREIN IS DEFINED FOR ALL NON-NEGATIVE X,
C              AND ITS PROBABILITY DENSITY FUNCTION IS GIVEN
C              IN REFERENCES 2, 3, AND 4 BELOW.
C              NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION
C              IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE
C              DISTRIBUTION FUNCTION OF THE DISTRIBUTION.
C     INPUT  ARGUMENTS--P      = THE SINGLE PRECISION VALUE
C                                (BETWEEN 0.0 (INCLUSIVELY)
C                                AND 1.0 (EXCLUSIVELY))
C                                AT WHICH THE PERCENT POINT
C                                FUNCTION IS TO BE EVALUATED.
C                     --NU     = THE INTEGER NUMBER OF DEGREES
C                                OF FREEDOM.
C                                NU SHOULD BE POSITIVE.
C     OUTPUT ARGUMENTS--PPF    = THE SINGLE PRECISION PERCENT
C                                POINT FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION PERCENT POINT FUNCTION .
C             VALUE PPF FOR THE CHI-SQUARED DISTRIBUTION
C             WITH DEGREES OF FREEDOM PARAMETER = NU.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
C     RESTRICTIONS--NU SHOULD BE A POSITIVE INTEGER VARIABLE.
C                 --P SHOULD BE BETWEEN 0.0 (INCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--DEXP, DLOG.
C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     ACCURACY--(ON THE UNIVAC 1108, EXEC 8 SYSTEM AT NBS)
C               COMPARED TO THE KNOWN NU = 2 (EXPONENTIAL)
C               RESULTS, AGREEMENT WAS HAD OUT TO 6 SIGNIFICANT
C               DIGITS FOR ALL TESTED P IN THE RANGE P = .001 TO
C               P = .999.  FOR P = .95 AND SMALLER, THE AGREEMENT
C               WAS EVEN BETTER--7 SIGNIFICANT DIGITS.
C               (NOTE THAT THE TABULATED VALUES GIVEN IN THE WILK,
C               GNANADESIKAN, AND HUYETT REFERENCE BELOW, PAGE 20,
C               ARE IN ERROR FOR AT LEAST THE GAMMA = 1 CASE--
C               THE WORST DETECTED ERROR WAS AGREEMENT TO ONLY 3
C               SIGNIFICANT DIGITS (IN THEIR 8 SIGNIFICANT DIGIT TABLE)
C               FOR P = .999.)
C     REFERENCES--WILK, GNANADESIKAN, AND HUYETT, 'PROBABILITY
C                 PLOTS FOR THE GAMMA DISTRIBUTION',
C                 TECHNOMETRICS, 1962, PAGES 1-15,
C                 ESPECIALLY PAGES 3-5.
C               --NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 257, FORMULA 6.1.41,
C                 AND PAGES 940-943.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 166-206.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGES 46-51.
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     LANGUAGE--ANSI FORTRAN (1966)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--SEPTEMBER 1975.
C     UPDATED         --NOVEMBER  1975.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JUNE      1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DP,DGAMMA
CCCCC DOUBLE PRECISION Z,Z2,Z3,Z4,Z5,DEN,A,B,C,D,G
      DOUBLE PRECISION Z,Z2,DEN,A,B,C,D
      DOUBLE PRECISION XMIN0,XMIN,AI,XMAX,DX,PCALC,XMID
      DOUBLE PRECISION XLOWER,XUPPER,XDEL
      DOUBLE PRECISION SUM,TERM,CUT1,CUT2,AJ,CUTOFF,T
      DOUBLE PRECISION DLG,DLT,DLX,DLPCAL
      DOUBLE PRECISION DLP,DLGAMM,DLXMI0
      DOUBLE PRECISION Z2INV
      DOUBLE PRECISION DEXP,DLOG
C
      DIMENSION D(10)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA C/ .918938533204672741D0/
      DATA D(1),D(2),D(3),D(4),D(5)
     1                 /+.833333333333333333D-1,-.277777777777777778D-2,
     1+.793650793650793651D-3,-.595238095238095238D-3,+.8417508417508417
     151D-3/
      DATA D(6),D(7),D(8),D(9),D(10)
     1     /-.191752691752691753D-2,+.641025641025641025D-2,-.2955065359
     147712418D-1,+.179644372368830573D0,-.139243221690590111D1/
C
C-----START POINT-----------------------------------------------------
C
      XMID=0.0
      XLOWER=0.0
      XUPPER=0.0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      PPF=0.0
      IF(P.LT.0.0.OR.P.GE.1.0)THEN
        WRITE(ICOUT,1)
    1   FORMAT('***** ERROR IN CHSPPF--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2)
    2   FORMAT('      THE FIRST ARGUMENT TO CHSPPF IS OUTSIDE ',
     1         'THE ALLOWABLE (0,1) INTERVAL')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)P
   46   FORMAT('      THE VALUE OF THE ARGUMENT IS ',G15.7)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ELSEIF(NU.LT.1)THEN
        WRITE(ICOUT,1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,15)
   15   FORMAT('      THE DEGREES OF FREEDOM ARGUMENT IS NON-POSITIVE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,47)NU
   47   FORMAT('      THE VALUE OF THE ARGUMENT IS ',I8)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
C     EXPRESS THE CHI-SQUARED DISTRIBUTION PERCENT POINT
C     FUNCTION IN TERMS OF THE EQUIVALENT GAMMA
C     DISTRIBUTION PERCENT POINT FUNCTION,
C     AND THEN EVALUATE THE LATTER.
C
      DP=P
      DNU=NU
      DGAMMA=DNU/2.0D0
      MAXIT=10000
C
C     COMPUTE THE GAMMA FUNCTION USING THE ALGORITHM IN THE
C     NBS APPLIED MATHEMATICS SERIES REFERENCE.
C     THIS GAMMA FUNCTION NEED BE CALCULATED ONLY ONCE.
C     IT IS USED IN THE CALCULATION OF THE CDF BASED ON
C     THE TENTATIVE VALUE OF THE PPF IN THE ITERATION.
C
      Z=DGAMMA
      DEN=1.0D0
  150 IF(Z.GE.10.0D0)GOTO160
      DEN=DEN*Z
      Z=Z+1.0D0
      GOTO150
  160 Z2=Z*Z
CCCCC Z3=Z*Z2
CCCCC Z4=Z2*Z2
CCCCC Z5=Z2*Z3
      A=(Z-0.5D0)*DLOG(Z)-Z+C
CCCCC B=D(1)/Z+D(2)/Z3+D(3)/Z5+D(4)/(Z2*Z5)+D(5)/(Z4*Z5)+
CCCCC1D(6)/(Z*Z5*Z5)+D(7)/(Z3*Z5*Z5)+D(8)/(Z5*Z5*Z5)+D(9)/(Z2*Z5*Z5*Z5)
      Z2INV=1.0D0/Z2
      B=D(9)
      B=Z2INV*B+D(8)
      B=Z2INV*B+D(7)
      B=Z2INV*B+D(6)
      B=Z2INV*B+D(5)
      B=Z2INV*B+D(4)
      B=Z2INV*B+D(3)
      B=Z2INV*B+D(2)
      B=Z2INV*B+D(1)
      B=(1.0D0/Z)*B
CCCCC G=DEXP(A+B)/DEN
      DLG=(A+B)-DLOG(DEN)
C
C     DETERMINE LOWER AND UPPER LIMITS ON THE DESIRED 100P
C     PERCENT POINT.
C
      ILOOP=1
CCCCC XMIN0=(DP*DGAMMA*G)**(1.0D0/DGAMMA)
      DLP=DLOG(DP)
      DLGAMM=DLOG(DGAMMA)
      DLXMI0=(1.0D0/DGAMMA)*(DLP+DLGAMM+DLG)
      XMIN0=DEXP(DLXMI0)
      XMIN=XMIN0
      ICOUNT=1
  350 AI=ICOUNT
      XMAX=AI*XMIN0
      DX=XMAX
      GOTO1000
  360 IF(PCALC.GE.DP)GOTO370
      XMIN=XMAX
      ICOUNT=ICOUNT+1
      IF(ICOUNT.LE.30000)GOTO350
  370 XMID=(XMIN+XMAX)/2.0D0
C
C     NOW ITERATE BY BISECTION UNTIL THE DESIRED ACCURACY IS ACHIEVED.
C
      ILOOP=2
      XLOWER=XMIN
      XUPPER=XMAX
      ICOUNT=0
  550 DX=XMID
      GOTO1000
  560 IF(PCALC.EQ.DP)GOTO570
      IF(PCALC.GT.DP)GOTO580
      XLOWER=XMID
      XMID=(XMID+XUPPER)/2.0D0
      GOTO590
  580 XUPPER=XMID
      XMID=(XMID+XLOWER)/2.0D0
  590 XDEL=XMID-XLOWER
      IF(XDEL.LT.0.0D0)XDEL=-XDEL
      ICOUNT=ICOUNT+1
      IF(XDEL.LT.0.0000000001D0.OR.ICOUNT.GT.100)GOTO570
      GOTO550
  570 PPF=2.0D0*XMID
      RETURN
C
C********************************************************************
C     THIS SECTION BELOW IS LOGICALLY SEPARATE FROM THE ABOVE.
C     THIS SECTION COMPUTES A CDF VALUE FOR ANY GIVEN TENTATIVE
C     PERCENT POINT X VALUE AS DEFINED IN EITHER OF THE 2
C     ITERATION LOOPS IN THE ABOVE CODE.
C
C     COMPUTE T-SUB-Q AS DEFINED ON PAGE 4 OF THE WILK, GNANADESIKAN,
C     AND HUYETT REFERENCE
C
 1000 SUM=1.0D0/DGAMMA
      TERM=1.0D0/DGAMMA
      CUT1=DX-DGAMMA
      CUT2=DX*10000000000.0D0
      DO700J=1,MAXIT
      AJ=J
      TERM=DX*TERM/(DGAMMA+AJ)
      SUM=SUM+TERM
      CUTOFF=CUT1+(CUT2*TERM/SUM)
      IF(AJ.GT.CUTOFF)GOTO750
  700 CONTINUE
      WRITE(ICOUT,705)MAXIT
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,706)P
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,707)NU
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,708)
      CALL DPWRST('XXX','BUG ')
      PPF=0.0
      RETURN
C
  750 T=SUM
      DLT=DLOG(T)
      DLX=DLOG(DX)
CCCCC WRITE(ICOUT,777)DX,DGAMMA,T,DLT,G,DLG
CC777 FORMAT('DX,DGAMMA,T,DLT,G,DLG = ',6D15.7)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC PCALC=(DX**DGAMMA)*(DEXP(-DX))*T/G
      DLPCAL=DGAMMA*DLX-DX+DLT-DLG
      PCALC=DEXP(DLPCAL)
      IF(ILOOP.EQ.1)GOTO360
      GOTO560
C
  705 FORMAT('*****ERROR IN INTERNAL OPERATIONS IN THE CHSPPF ',
     1'SUBROUTINE--THE NUMBER OF ITERATIONS EXCEEDS ',I7)
  706 FORMAT(33H     THE INPUT VALUE OF P     IS ,E15.8)
  707 FORMAT(33H     THE INPUT VALUE OF NU    IS ,I8)
  708 FORMAT(48H     THE OUTPUT VALUE OF PPF HAS BEEN SET TO 0.0)
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE CHSRAN(N,ANU,ISEED,X)
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE CHI-SQUARED DISTRIBUTION
C              WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU.
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
C                                OF RANDOM NUMBERS TO BE
C                                GENERATED.
C                     --NU     = THE INTEGER DEGREES OF FREEDOM
C                                (PARAMETER) FOR THE CHI-SQUARED
C                                DISTRIBUTION.
C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
C                                (OF DIMENSION AT LEAST N)
C                                INTO WHICH THE GENERATED
C                                RANDOM SAMPLE WILL BE PLACED.
C     OUTPUT--A RANDOM SAMPLE OF SIZE N
C             FROM THE CHI-SQUARED DISTRIBUTION
C             WITH DEGREES OF FREEDOM PARAMETER = NU.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C                 --NU SHOULD BE A POSITIVE INTEGER VARIABLE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--LOG, SQRT, SIN, COS.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--TOCHER, THE ART OF SIMULATION,
C                 1963, PAGES 34-35.
C               --MOOD AND GRABLE, INTRODUCTION TO THE
C                 THEORY OF STATISTICS, 1963, PAGES 226-227.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGE 171.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGE 48.
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--FEBRUARY  1975.
C     UPDATED         --SEPTEMBER 1975.
C     UPDATED         --NOVEMBER  1975.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MAY       2004. ALLOW REAL VALUES FOR DEGREES
C                                       OF FREEDOM PARAMETER
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
      DIMENSION Y(2),Z(2)
C
      CHARACTER*4 ICASE
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA PI/3.14159265359/
      DATA EPS/0.00001/
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)THEN
        WRITE(ICOUT,5)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,47)N
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
    5 FORMAT('***** ERROR--THE REQUESTED NUMBER OF CHI-SQUARE ',
     1'RANDOM NUMBERS IS NON-POSITIVE.')
      IF(ANU.LE.0.0)THEN
        WRITE(ICOUT,15)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,48)ANU
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
   15 FORMAT('***** ERROR--THE DEGREES OF FREEDOM PARAMETER FOR ',
     1'CHI-SQUARE RANDOM NUMBERS IS NON-POSITIVE.')
   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8)
   48 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
C
      NU=INT(ANU+0.1)
      ANU2=REAL(NU)
      IF(ABS(ANU-ANU2).LE.EPS)THEN
        ICASE='INTE'
        IF(NU.EQ.0)THEN
          ICASE='REAL'
          ANU=EPS
        ENDIF
      ELSE
        ICASE='REAL'
      ENDIF
C
C     CASE 1: INTEGER DEGREES OF FREEDOM
C
      IF(ICASE.EQ.'INTE')THEN
C
C       GENERATE N CHI-SQUARED RANDOM NUMBERS
C       USING THE DEFINITION THAT
C       A CHI-SQUARED VARIATE WITH NU DEGREES OF FREEDOM
C       EQUALS THE SUM OF NU SQUARED NORMAL VARIATES.
C       FIRST GENERATE 2 UNIFORM (0,1) RANDOM NUMBERS,
C       THEN GENERATE 2 NORMAL RANDOM NUMBERS,
C       THEN FORM THE SUM OF SQUARED NORMAL RANDOM NUMBERS.
C
        DO100I=1,N
          SUM=0.0
          DO200J=1,NU,2
            CALL UNIRAN(2,ISEED,Y)
            ARG1=-2.0*LOG(Y(1))
            ARG2=2.0*PI*Y(2)
            Z(1)=(SQRT(ARG1))*(COS(ARG2))
            Z(2)=(SQRT(ARG1))*(SIN(ARG2))
            SUM=SUM+Z(1)*Z(1)
            IF(J.EQ.NU)GOTO200
            SUM=SUM+Z(2)*Z(2)
  200     CONTINUE
          X(I)=SUM
  100   CONTINUE
C
C     CASE 2: REAL DEGREES OF FREEDOM
C
C     GENERATE CHI-SQUARE RANDOM NUMBERS USING RELATIONSHIP
C     TO GAMMA DISTRIBUTION.
C
      ELSE
        GAMMA=ANU/2.0
        CALL GAMRAN(N,GAMMA,ISEED,X)
        DO300I=1,N
          X(I)=2.0*X(I)
  300   CONTINUE
C
      ENDIF
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE CKARIT(IFOUNZ,IBEGIN,IANS,IWIDTH,ICASAR,
     1                  IBUGA3,ISUBRO)
C
C     PURPOSE--FOR THE LET COMMAND,
C              DETERMINE IF AN ARITHMETIC OPERATOR
C              EXISTS ANYWHERE FROM THE BEGINNING
C              OF THE COMMAND LINE TO SUBSET/EXCEPT/FOR OR END OF LINE.
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/1
C     ORIGINAL VERSION--JANUARY   1989.
C     UPDATED         --JULY      1989.  COMMENT OUT IERROR
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IFOUNZ
      CHARACTER*4 IANS
      CHARACTER*4 ICASAR
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION IFOUNZ(*)
      DIMENSION IBEGIN(*)
      DIMENSION IANS(*)
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'ARIT')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPARIT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IFOUNZ(11),IBEGIN(11),IFOUNZ(21),IBEGIN(21)
   52   FORMAT('IFOUNZ(11),IBEGIN(11),IFOUNZ(21),IBEGIN(21) = ',
     1         2(A4,I8))
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,61)IWIDTH
   61   FORMAT('IWIDTH = ',I8)
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,62)(IANS(I),I=1,MIN(80,IWIDTH))
   62     FORMAT('IANS(.) = ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ENDIF
C
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT JULY 1989
CCCCC IERROR='NO'
      ICASAR='NO'
C
      IMAX=IWIDTH
      IF(IFOUNZ(11).EQ.'YES')IMAX=IBEGIN(11)
      IF(IFOUNZ(21).EQ.'YES')IMAX=IBEGIN(21)
C
      IF(IMAX.LE.0)GOTO9000
      DO1100I=1,IMAX
      IF(IANS(I).EQ.'+')GOTO1150
      IF(IANS(I).EQ.'-')GOTO1150
      IF(IANS(I).EQ.'*')GOTO1150
      IF(IANS(I).EQ.'/')GOTO1150
 1100 CONTINUE
      ICASAR='NO'
      GOTO9000
 1150 CONTINUE
      ICASAR='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'ARIT')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPARIT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)ICASAR
 9012   FORMAT('ICASAR = ',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE CKCENS(TAG,XTEMP,N,IDIST,
     1                  ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE CHECKS TO SEE IF THE INPUT VARIABLE
C              IS A VALID CENSORING VARIABLE.  IT SHOULD CONTAIN
C              AT MOST 2 DISTINCT VALUES.  THESE VALUES WILL
C              BE SET TO 0 AND 1 (IF THEY ARE NOT ALREADY).
C
C     WRITTEN BY--ALAN HECKERT
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2010/4
C     ORIGINAL VERSION--APRIL     2010. EXTRACTED AS A DISTINCT
C                                       SUBROUTINE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*40 IDIST
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      DIMENSION TAG(*)
      DIMENSION XTEMP(*)
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='CHKC'
      ISUBN2='EN  '
      IERROR='NO'
      IWRITE='OFF'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'CENS')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF CKCENS--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,IDIST
   55   FORMAT('N,IDIST = ',I8,2X,A40)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,TAG(I)
   57     FORMAT('I,TAG(I) = ',I8,G15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ******************************************
C               **  STEP 2--                            **
C               **  CHECK CENSORING VARIABLE            **
C               ******************************************
C
      CALL DISTIN(TAG,N,IWRITE,XTEMP,NDIST,IBUGA3,IERROR)
      IF(NDIST.EQ.1)THEN
        IF(XTEMP(1).NE.0.0 .AND. XTEMP(1).NE.1.0)THEN
          DO2102I=1,N
            TAG(I)=1.0
 2102     CONTINUE
        ENDIF
      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 CHECKING CENSORING VARIABLE--')
        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
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'CENS')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('**** AT THE END OF CKCENS--')
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--FOR THE DISTRIBUTIONAL FITTING ROUTINES, THIS
C              SUBROUTINE PERFORMS THE FOLLOWING ERROR CHECKS:
C
C                 1) IS THE MINIMUM NUMBER OF OBSERVATIONS
C                    AVAILABLE?
C
C                 2) ARE ALL ELEMENTS IN THE RESPONSE VARIABLE
C                    THE SAME?
C
C                 3) ARE THE REQUESTED PERCENTILES WITHIN RANGE?
C
C     WRITTEN BY--ALAN HECKERT
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2010/7
C     ORIGINAL VERSION--JULY      2010. EXTRACTED AS A SEPARATE
C                                       SUBROUTINE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      DIMENSION Y(*)
      DIMENSION QP(*)
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
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='CKDI'
      ISUBN2='ST  '
C
      IERROR='NO'
      IWRITE='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DIST')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF CKDIST--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,Y(1)
   52   FORMAT('IBUGA3,ISUBRO,N,Y(1) = ',2(A4,2X),I8,G15.7)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DIST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.NMIN)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN CKDIST--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)NMIN
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE RESPONSE ',
     1         'VARIABLE IS LESS THAN ',I5,'.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C     FOR MLE ESTIMATION, ALL RESPONSE VALUES THE SAME NOT
C     NECESSARILY AN ERROR (ESPECIALLY FOR DISCRETE DISTRIBUTIONS).
C
CCCCC HOLD=Y(1)
CCCCC DO1135I=2,N
CCCCC   IF(Y(I).NE.HOLD)GOTO1139
C1135 CONTINUE
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','WRIT')
CCCCC WRITE(ICOUT,1111)
CCCCC CALL DPWRST('XXX','WRIT')
CCCCC WRITE(ICOUT,1133)HOLD
C1133 FORMAT('      THE RESPONSE VARIABLE HAS ALL ELEMENTS = ',G15.7)
CCCCC CALL DPWRST('XXX','WRIT')
CCCCC IERROR='YES'
CCCCC GOTO9000
C1139 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 CKDIST--')
            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
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DIST')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('**** AT THE END OF CKDIST--')
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,QP,NPERC,NTOT,
     1                  ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--FOR GROUPED DATA WHERE THE DATA ARE GIVEN AS EQUI-SPACED
C              BINS, THIS SUBROUTINE PERFORMS THE FOLLOWING ERROR CHECKS:
C
C                 1) IS THE MINIMUM NUMBER OF OBSERVATIONS
C                    AVAILABLE?
C
C                 2) ARE THE BIN MID-POINTS ALL DISTINCT?
C
C                 3) ARE THE BIN MID-POINTS SORTED?
C
C                 4) FOR MAXIMUM LIKELIHOOD CASE, CHECK THAT
C                    REQUESTED PERCENTILES ARE IN AN APPROPRIATE
C                    RANGE.
C
C              ALSO RETURN "NTOT" (THE TOTAL SAMPLE SIZE).
C
C     WRITTEN BY--ALAN HECKERT
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2010/8
C     ORIGINAL VERSION--AUGUST    2010. EXTRACTED AS A SEPARATE SUBROUTINE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION TEMP1(*)
      DIMENSION QP(*)
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
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='CKDI'
      ISUBN2='S2  '
C
      IERROR='NO'
      IWRITE='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DIS2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF CKDIS2--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3,ISUBRO,N
   52   FORMAT('IBUGA3,ISUBRO,N = ',A4,2X,A4,2X,I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DIS2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C     CHECK THAT THERE ARE AT LEAST TWO GROUPS.
C
      IF(N.LE.1 .OR. N.GT.MAXGRP)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,146)
  146   FORMAT('***** ERROR IN CKDIS2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,147)
  147   FORMAT('      THE NUMBER OF GROUPS WAS LESS THAN OR EQUAL TO ',
     1         'ONE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,148)MAXGRP
  148   FORMAT('      OR GREATER THAN ',I8,'.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,149)N
  149   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C     CHECK THAT THE BIN MID-POINTS ARE ALL DISTINCT
C
      CALL DISTIN(X,N,IWRITE,TEMP1,NDIST,IBUGA3,IERROR)
      IF(N.NE.NDIST)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,146)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,172)
  172   FORMAT('      THE CLASS VARIABLE ELEMENTS ARE NOT ALL ',
     1         'DISTINCT.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C     CHECK THAT THE BIN MID-POINTS ARE IN SORTED ORDER
C
      DO183I=1,N-1
        IF(X(I).GE.X(I+1))THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,146)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,182)I
  182     FORMAT('      ELEMENT ',I8,' OF THE BIN MID-POINTS ',
     1           'VARIABLE IS')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,185)I+1
  185     FORMAT('      LARGER THAN ELEMENT ',I8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
  183 CONTINUE
C
C     CHECK THAT ALL FREQUENCIES ARE NON-NEGATIVE AND COMPUTE
C     TOTAL NUMBER OF OBSERVATIONS
C
      NTOT=0
      DO193I=1,N
        IF(Y(I).LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,146)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,192)I
  192     FORMAT('      THE FREQUENCY FOR ELEMENT ',I8,' IS NEGATIVE.')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,195)X(I)
  195     FORMAT('      BIN MID-POINT     = ',G15.7)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,197)Y(I)
  197     FORMAT('      FREQUENCY         = ',G15.7)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSE
          ITEMP=INT(Y(I)+0.5)
          Y(I)=REAL(ITEMP)
          NTOT=NTOT+ITEMP
        ENDIF
  193 CONTINUE
C
      IF(NTOT.LE.NMIN)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,146)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,217)NTOT,NMIN
  217   FORMAT('      THE NUMBER OF OBSERVATIONS, (',I5,
     1         ') IS LESS THAN ',I5)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C     FOR MAXIMUM LIKELIHOOD ROUTINES, CHECK THAT REQUESTED
C     PERCENTILES ARE WITHIN RANGE
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 CKDIS2--')
            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
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DIS2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('**** AT THE END OF CKDIS2--')
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE CKDIS3(Y,X1,X2,TEMP1,N,MAXGRP,NMIN,QP,NPERC,NTOT,
     1                  ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--FOR GROUPED DATA WHERE THE DATA ARE GIVEN WITH
C              BIN LOWER BOUNDARIES AND BIN UPPER BOUNDARIES,
C              THIS SUBROUTINE PERFORMS THE FOLLOWING ERROR CHECKS:
C
C                 1) IS THE MINIMUM NUMBER OF OBSERVATIONS
C                    AVAILABLE?
C
C                 2) ARE THE BIN BOUNDARIES ALL DISTINCT?
C
C                 3) ARE THE BIN BOUNDARIES SORTED?
C
C                 4) FOR MAXIMUM LIKELIHOOD CASE, CHECK THAT
C                    REQUESTED PERCENTILES ARE IN AN APPROPRIATE
C                    RANGE.
C
C              ALSO RETURN "NTOT" (THE TOTAL SAMPLE SIZE).
C
C     WRITTEN BY--ALAN HECKERT
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2010/8
C     ORIGINAL VERSION--AUGUST    2010. EXTRACTED AS A SEPARATE SUBROUTINE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      DIMENSION Y(*)
      DIMENSION X1(*)
      DIMENSION X2(*)
      DIMENSION TEMP1(*)
      DIMENSION QP(*)
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
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='CKDI'
      ISUBN2='S3  '
C
      IERROR='NO'
      IWRITE='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DIS3')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF CKDIS3--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3,ISUBRO,N
   52   FORMAT('IBUGA3,ISUBRO,N = ',A4,2X,A4,2X,I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DIS3')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C     CHECK THAT THERE ARE AT LEAST TWO GROUPS.
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,146)
  146   FORMAT('***** ERROR IN CKDIS3--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,147)
  147   FORMAT('      THE NUMBER OF GROUPS WAS LESS THAN OR EQUAL TO ',
     1         'ONE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,148)MAXGRP
  148   FORMAT('      OR GREATER THAN ',I8,'.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,149)N
  149   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C     CHECK THAT THE BIN BOUNDARIES ARE ALL DISTINCT
C
      CALL DISTIN(X1,N,IWRITE,TEMP1,NDIST,IBUGA3,IERROR)
      IF(N.NE.NDIST)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,146)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,172)
  172   FORMAT('      THE BIN LOWER LIMITS ARE NOT ALL DISTINCT.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      CALL DISTIN(X2,N,IWRITE,TEMP1,NDIST,IBUGA3,IERROR)
      IF(N.NE.NDIST)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,146)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,177)
  177   FORMAT('      THE BIN UPPER LIMITS ARE NOT ALL DISTINCT.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C     CHECK THAT LOWER LIMIT IS LESS THAN UPPER LIMIT
C
      DO181I=1,N
        IF(X1(I).GE.X2(I))THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,146)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,186)I
  186     FORMAT('      FOR BIN ',I8,', THE LOWER CLASS LIMIT IS ',
     1           'GREATER THAN THE UPPER CLASS LIMIT.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,187)X1(I)
  187     FORMAT('      LOWER LIMIT   = ',G15.7)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,188)X2(I)
  188     FORMAT('      UPPER LIMIT   = ',G15.7)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
  181 CONTINUE
C
C     CHECK THAT BIN LIMITS ARE IN SORTED ORDER
C
      DO191I=1,N-1
        IF(X1(I).GE.X1(I+1))THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,146)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,192)I
  192     FORMAT('      ELEMENT ',I8,' OF THE BIN LOWER CLASS ',
     1           'LIMITS VARIABLE IS')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,193)I+1
  193     FORMAT('      LARGER THAN ELEMENT ',I8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          IERROR='YES'
          GOTO9000
        ENDIF
  191 CONTINUE
C
      DO196I=1,N-1
        IF(X2(I).GE.X2(I+1))THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,146)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,197)I
  197     FORMAT('      ELEMENT ',I8,' OF THE BIN UPPER CLASS ',
     1           'LIMITS VARIABLE IS')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,198)I+1
  198     FORMAT('      LARGER THAN ELEMENT ',I8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          IERROR='YES'
          GOTO9000
        ENDIF
  196 CONTINUE
C
C     CHECK THAT ALL FREQUENCIES ARE NON-NEGATIVE AND COMPUTE
C     TOTAL NUMBER OF OBSERVATIONS
C
      NTOT=0
      DO203I=1,N
        IF(Y(I).LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,146)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,202)I
  202     FORMAT('      THE FREQUENCY FOR ELEMENT ',I8,' IS NEGATIVE.')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,205)X1(I)
  205     FORMAT('      BIN LOWER LIMIT   = ',G15.7)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,206)X2(I)
  206     FORMAT('      BIN UPPER LIMIT   = ',G15.7)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,207)Y(I)
  207     FORMAT('      FREQUENCY         = ',G15.7)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSE
          ITEMP=INT(Y(I)+0.5)
          Y(I)=REAL(ITEMP)
          NTOT=NTOT+ITEMP
        ENDIF
  203 CONTINUE
C
      IF(NTOT.LE.NMIN)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,146)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,217)NTOT,NMIN
  217   FORMAT('      THE NUMBER OF OBSERVATIONS, (',I5,
     1         ') IS LESS THAN ',I5)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C     FOR MAXIMUM LIKELIHOOD ROUTINES, CHECK THAT REQUESTED
C     PERCENTILES ARE WITHIN RANGE
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 CKDIS3--')
            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
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DIS3')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('**** AT THE END OF CKDIS3--')
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE CKCPMA(ENGUSL,ENGLSL,TARGET,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--CHECK THE PARAMETERS NEEDED
C              FOR THE CPM STATISTIC.

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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/11
C     ORIGINAL VERSION--NOVEMBER  1998.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='CKCP'
      ISUBN2='MA  '
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'CPMA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF CKCPMA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR
   52 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C     --------------------------
C
      IHP='USL '
      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')GOTO1110
      ENGUSL=VALUE(ILOCP)
      GOTO1119
C
 1110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN CKCPMA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      IN COMPUTING THE CPM,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
 1114 FORMAT('      THE VALUE OF THE UPPER SPEC LIMIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)
 1115 FORMAT('      (PARAMETER USL) MUST BE PRE-DEFINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1116)
 1116 FORMAT('      USE THE LET COMMAND TO PRE-DEFINE USL,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1117)
 1117 FORMAT('      AS IN         LET USL = 1100')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
C     --------------------------
C
      IHP='LSL '
      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')GOTO2110
      ENGLSL=VALUE(ILOCP)
      GOTO2119
C
 2110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2111)
 2111 FORMAT('***** ERROR IN CKCPMA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2112)
 2112 FORMAT('      IN COMPUTING THE CPM STATISTIC,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2114)
 2114 FORMAT('      THE VALUE OF THE LOWER SPEC LIMIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2115)
 2115 FORMAT('      (PARAMETER LSL) MUST BE PRE-DEFINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2116)
 2116 FORMAT('      USE THE LET COMMAND TO PRE-DEFINE LSL,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2117)
 2117 FORMAT('      AS IN         LET LSL = 900')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2119 CONTINUE
C
C     --------------------------
C
      IHP='TARG'
      IHP2='ET  '
      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')GOTO3110
      TARGET=VALUE(ILOCP)
      GOTO3119
C
 3110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3111)
 3111 FORMAT('***** ERROR IN CKCPMA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3112)
 3112 FORMAT('      IN COMPUTING THE CPM STATISTIC,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3114)
 3114 FORMAT('      THE VALUE OF THE TARGET SPEC LIMIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3115)
 3115 FORMAT('      (PARAMETER TARGET) MUST BE PRE-DEFINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3116)
 3116 FORMAT('      USE THE LET COMMAND TO PRE-DEFINE TARGET,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3117)
 3117 FORMAT('      AS IN         LET TARGET = 10000')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3119 CONTINUE
C
C     --------------------------
C
      IF(ENGLSL.LT.ENGUSL)GOTO4129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4111)
 4111 FORMAT('***** ERROR IN CKCPMA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4112)
 4112 FORMAT('      IN COMPUTING THE CPM STATISTIC,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4114)
 4114 FORMAT('      THE VALUE OF THE LOWER SPEC LIMIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4115)
 4115 FORMAT('      (PARAMETER LSL) MUST BE STRICTLY')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4116)
 4116 FORMAT('      LESS THAN THE VALUE OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4117)
 4117 FORMAT('      UPPER SPEC LIMIT (PARAMETER USL).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4118)
 4118 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4119)ENGLSL
 4119 FORMAT('            LSL = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4120)ENGUSL
 4120 FORMAT('            USL = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 4129 CONTINUE
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'ELPA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF CKCPMA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG3,ISUBRO,IERROR
 9012 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ENGUSL,ENGLSL,TARGET
 9013 FORMAT('ENGUSL,ENGLSL,TARGET = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE CKCPPA(ENGUSL,ENGLSL,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--CHECK THE PARAMETERS NEEDED
C              FOR THE CP STATISTIC,
C              FOR THE CPK STATISTIC, AND
C              FOR THE PERCENT DEFECTIVE STATISTIC..

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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/6
C     ORIGINAL VERSION--MAY       1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
CCCCC CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
CCCCC CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='CKCP'
      ISUBN2='PA  '
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'CPPA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF CKCPPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR
   52 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C     --------------------------
C
      IHP='USL '
      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')GOTO1110
      ENGUSL=VALUE(ILOCP)
      GOTO1119
C
 1110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN CKCPPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      IN COMPUTING THE CP, THE CPK,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      AND THE PERCENT DEFECTIVE STATISTICS,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
 1114 FORMAT('      THE VALUE OF THE UPPER SPEC LIMIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)
 1115 FORMAT('      (PARAMETER USL) MUST BE PRE-DEFINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1116)
 1116 FORMAT('      USE THE LET COMMAND TO PRE-DEFINE USL,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1117)
 1117 FORMAT('      AS IN         LET USL = 1100')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
C     --------------------------
C
      IHP='LSL '
      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')GOTO2110
      ENGLSL=VALUE(ILOCP)
      GOTO2119
C
 2110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2111)
 2111 FORMAT('***** ERROR IN CKCPPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2112)
 2112 FORMAT('      IN COMPUTING THE CP, THE CPK,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2113)
 2113 FORMAT('      AND THE PERCENT DEFECTIVE STATISTICS,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2114)
 2114 FORMAT('      THE VALUE OF THE LOWER SPEC LIMIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2115)
 2115 FORMAT('      (PARAMETER LSL) MUST BE PRE-DEFINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2116)
 2116 FORMAT('      USE THE LET COMMAND TO PRE-DEFINE LSL,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2117)
 2117 FORMAT('      AS IN         LET LSL = 900')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2119 CONTINUE
C
C     --------------------------
C
      IF(ENGLSL.LT.ENGUSL)GOTO3129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3111)
 3111 FORMAT('***** ERROR IN CKCPPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3112)
 3112 FORMAT('      IN COMPUTING THE CP, THE CPK,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3113)
 3113 FORMAT('      AND THE PERCENT DEFECTIVE STATISTICS,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3114)
 3114 FORMAT('      THE VALUE OF THE LOWER SPEC LIMIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3115)
 3115 FORMAT('      (PARAMETER LSL) MUST BE STRICTLY')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3116)
 3116 FORMAT('      LESS THAN THE VALUE OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3117)
 3117 FORMAT('      UPPER SPEC LIMIT (PARAMETER USL).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3118)
 3118 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3119)ENGLSL
 3119 FORMAT('            LSL = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3120)ENGUSL
 3120 FORMAT('            USL = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3129 CONTINUE
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'CPPA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF CKCPPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG3,ISUBRO,IERROR
 9012 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ENGUSL,ENGLSL
 9013 FORMAT('ENGUSL,ENGLSL = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE CKELPA(ENGUSL,ENGLSL,COSUSL,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--CHECK THE PARAMETERS NEEDED
C              FOR THE EXPECTED LOSS STATISTIC.

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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/6
C     ORIGINAL VERSION--MAY       1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
CCCCC CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
CCCCC CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='CKEL'
      ISUBN2='PA  '
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'ELPA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF CKELPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR
   52 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C     --------------------------
C
      IHP='USL '
      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')GOTO1110
      ENGUSL=VALUE(ILOCP)
      GOTO1119
C
 1110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN CKELPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      IN COMPUTING THE EXPECTED LOSS STATISTIC,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
 1114 FORMAT('      THE VALUE OF THE UPPER SPEC LIMIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)
 1115 FORMAT('      (PARAMETER USL) MUST BE PRE-DEFINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1116)
 1116 FORMAT('      USE THE LET COMMAND TO PRE-DEFINE USL,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1117)
 1117 FORMAT('      AS IN         LET USL = 1100')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
C     --------------------------
C
      IHP='LSL '
      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')GOTO2110
      ENGLSL=VALUE(ILOCP)
      GOTO2119
C
 2110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2111)
 2111 FORMAT('***** ERROR IN CKELPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2112)
 2112 FORMAT('      IN COMPUTING THE EXPECTED LOSS STATISTIC,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2114)
 2114 FORMAT('      THE VALUE OF THE LOWER SPEC LIMIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2115)
 2115 FORMAT('      (PARAMETER LSL) MUST BE PRE-DEFINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2116)
 2116 FORMAT('      USE THE LET COMMAND TO PRE-DEFINE LSL,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2117)
 2117 FORMAT('      AS IN         LET LSL = 900')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2119 CONTINUE
C
C     --------------------------
C
      IHP='COST'
      IHP2='USL '
      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')GOTO3110
      COSUSL=VALUE(ILOCP)
      GOTO3119
C
 3110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3111)
 3111 FORMAT('***** ERROR IN CKELPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3112)
 3112 FORMAT('      IN COMPUTING THE EXPECTED LOSS STATISTIC,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3114)
 3114 FORMAT('      THE VALUE OF THE    COST AT UPPER SPEC LIMIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3115)
 3115 FORMAT('      (PARAMETER COSTUSL) MUST BE PRE-DEFINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3116)
 3116 FORMAT('      USE THE LET COMMAND TO PRE-DEFINE COSTUSL,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3117)
 3117 FORMAT('      AS IN         LET COSTUSL = 10000')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3119 CONTINUE
C
C     --------------------------
C
      IF(ENGLSL.LT.ENGUSL)GOTO4129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4111)
 4111 FORMAT('***** ERROR IN CKELPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4112)
 4112 FORMAT('      IN COMPUTING THE EXPECTED LOSS STATISTIC,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4114)
 4114 FORMAT('      THE VALUE OF THE LOWER SPEC LIMIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4115)
 4115 FORMAT('      (PARAMETER LSL) MUST BE STRICTLY')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4116)
 4116 FORMAT('      LESS THAN THE VALUE OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4117)
 4117 FORMAT('      UPPER SPEC LIMIT (PARAMETER USL).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4118)
 4118 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4119)ENGLSL
 4119 FORMAT('            LSL = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4120)ENGUSL
 4120 FORMAT('            USL = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 4129 CONTINUE
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'ELPA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF CKELPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG3,ISUBRO,IERROR
 9012 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ENGUSL,ENGLSL,COSUSL
 9013 FORMAT('ENGUSL,ENGLSL,COSUSL = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE CKFIT(ICASFI,ILOCFI,IBUGA3,IFOUND,IERROR)
C
C     PURPOSE--CHECK TO SEE THE TYPE OF FIT COMMAND
C              THAT HAS BEEN GIVEN
C              (E.G., WHAT DEGREE).
C     OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO')
C                     --IERROR ('YES' OR 'NO')
C                     --ICASFI ('FIT', '1FIT', '2FIT', '3FIT', ETC.)
C                     --ILOCFI (AN INTEGER VALUE WHICH GIVES
C                              THE ARGUMENT NUMBER (1, 2, 3, ...)
C                              OF THE WORD    FIT     .
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--AUGUST    1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JUNE      1987.
C     UPDATED         --JULY      2019. RECODE FOR BETTER READABILITY
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASFI
      CHARACTER*4 IBUGA3
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
C               *************************
C               **  CHECK FOR FITTING  **
C               *************************
C
      IFOUND='NO'
      IERROR='NO'
      ICASFI='UNKN'
      ILOCFI=-99
C
      IF(IBUGA3.EQ.'ON')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF CKFIT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA3,ICOM,ICOM2,NUMARG
   52   FORMAT('IBUGA3,ICOM,ICOM2,NUMARG = ',3(A4,2X),I8)
        CALL DPWRST('XXX','BUG ')
        DO55I=1,NUMARG
          WRITE(ICOUT,56)I,IHARG(I),IHARG2(I)
   56     FORMAT('I,IHARG(I),IHARG2(I) = ',I8,2(A4,2X))
          CALL DPWRST('XXX','BUG ')
   55   CONTINUE
      ENDIF
C
C               *********************************
C               **  STEP 1.1--                 **
C               **  SEARCH FOR FIT             **
C               **  (WITH UNSPECIFIED DEGREE), **
C               **  OR SEARCH FOR              **
C               **  MULTILINEAR FIT            **
C               **  FIT COMMAND WITH NO PREFIX **
C               **  BUT WITH NO EQUAL SIGNS    **
C               **  AFTER                      **
C               *********************************
C
      ICASFI='    '
      ILASTC=0
C
      IF(ICOM.EQ.'FIT')THEN
        ICASFI='FIT'
        IF(NUMARG.GT.0)THEN
          DO1110I=1,NUMARG
            IF(IHARG(I).EQ.'=')THEN
              ICASFI='FIT'
              ILASTC=0
              GOTO1119
            ELSEIF((IHARG(I).EQ.'SUBS'.AND.IHARG2(I).EQ.'ET  ') .OR.
     1             (IHARG(I).EQ.'EXCE'.AND.IHARG2(I).EQ.'PT  ') .OR.
     1             (IHARG(I).EQ.'FOR '.AND.IHARG2(I).EQ.'    '))THEN
              ICASFI='MFIT'
              ILASTC=0
              GOTO1119
            ENDIF
 1110     CONTINUE
          ICASFI='MFIT'
          ILASTC=0
 1119     CONTINUE
        ENDIF
C
C               *********************************
C               **  STEP 1.2--                 **
C               **  SEARCH FOR ROBUST FITTING  **
C               *********************************
C
C
      ELSEIF(NUMARG.GE.2 .AND. ICOM.EQ.'ROBU' .AND.
     1       IHARG(2).EQ.'FIT')THEN
        ICASFI='RFIT'
        ILASTC=2
C
C               *******************************************
C               **  STEP 1.20--                          **
C               **  SEARCH FOR 0-TH DEGREE    FITTING    **
C               *******************************************
C
C
      ELSEIF(NUMARG.GE.3 .AND. ICOM.EQ.'0' .AND. IHARG(1).EQ.'TH' .AND.
     1       IHARG(2).EQ.'DEGR' .AND. IHARG(3).EQ.'FIT')THEN
        ICASFI='0FIT'
        ILASTC=3
      ELSEIF(NUMARG.GE.2 .AND.
     1      (ICOM.EQ.'0TH' .OR. ICOM.EQ.'ZERO' .OR. ICOM.EQ.'0') .AND.
     1       IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')THEN
        ICASFI='0FIT'
        ILASTC=2
      ELSEIF(NUMARG.GE.2 .AND. ICOM.EQ.'DEGR' .AND.
     1      (IHARG(1).EQ.'0' .OR. IHARG(1).EQ.'ZERO') .AND.
     1       IHARG(2).EQ.'FIT')THEN
        ICASFI='0FIT'
        ILASTC=2
      ELSEIF(NUMARG.GE.1.AND.
     1      (ICOM.EQ.'CONS' .OR. ICOM.EQ.'RECT' .OR.
     1       ICOM.EQ.'FLAT') .AND. IHARG(1).EQ.'FIT')THEN
        ICASFI='0FIT'
        ILASTC=1
C
C               *******************************************
C               **  STEP 1.21--                          **
C               **  SEARCH FOR 1-ST DEGREE    FITTING    **
C               *******************************************
C
C
      ELSEIF(NUMARG.GE.3 .AND. ICOM.EQ.'1' .AND. IHARG(1).EQ.'ST' .AND.
     1       IHARG(2).EQ.'DEGR' .AND. IHARG(3).EQ.'FIT')THEN
        ICASFI='1FIT'
        ILASTC=3
      ELSEIF(NUMARG.GE.2 .AND.
     1      (ICOM.EQ.'1ST' .OR. ICOM.EQ.'FIRS' .OR. ICOM.EQ.'1' .OR.
     1       ICOM.EQ.'ONE') .AND.
     1       IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')THEN
        ICASFI='1FIT'
        ILASTC=2
      ELSEIF(NUMARG.GE.2 .AND. ICOM.EQ.'DEGR' .AND.
     1      (IHARG(1).EQ.'1' .OR. IHARG(1).EQ.'ONE') .AND.
     1       IHARG(2).EQ.'FIT')THEN
        ICASFI='1FIT'
        ILASTC=2
      ELSEIF(NUMARG.GE.1 .AND. ICOM.EQ.'LINE' .AND.
     1       IHARG(1).EQ.'FIT')THEN
        ICASFI='1FIT'
        ILASTC=1
C
C               *******************************************
C               **  STEP 1.22--                          **
C               **  SEARCH FOR 2-ND DEGREE    FITTING    **
C               *******************************************
C
      ELSEIF(NUMARG.GE.3 .AND. ICOM.EQ.'2' .AND. IHARG(1).EQ.'ND' .AND.
     1       IHARG(2).EQ.'DEGR' .AND. IHARG(3).EQ.'FIT')THEN
        ICASFI='2FIT'
        ILASTC=3
      ELSEIF(NUMARG.GE.2 .AND.
     1      (ICOM.EQ.'2ND' .OR. ICOM.EQ.'SECO' .OR. ICOM.EQ.'2' .OR.
     1       ICOM.EQ.'TWO') .AND.
     1       IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')THEN
        ICASFI='2FIT'
        ILASTC=2
      ELSEIF(NUMARG.GE.2 .AND. ICOM.EQ.'DEGR' .AND.
     1      (IHARG(1).EQ.'2' .OR. IHARG(1).EQ.'TWO') .AND.
     1       IHARG(2).EQ.'FIT')THEN
        ICASFI='2FIT'
        ILASTC=2
      ELSEIF(NUMARG.GE.1 .AND. ICOM.EQ.'QUAD' .AND.
     1       IHARG(1).EQ.'FIT')THEN
        ICASFI='2FIT'
        ILASTC=1
C
C               *******************************************
C               **  STEP 1.23--                          **
C               **  SEARCH FOR 3-RD DEGREE    FITTING    **
C               *******************************************
C
      ELSEIF(NUMARG.GE.3 .AND. ICOM.EQ.'3' .AND. IHARG(1).EQ.'RD' .AND.
     1       IHARG(2).EQ.'DEGR' .AND. IHARG(3).EQ.'FIT')THEN
        ICASFI='3FIT'
        ILASTC=3
      ELSEIF(NUMARG.GE.2 .AND.
     1      (ICOM.EQ.'3RD' .OR. ICOM.EQ.'THIR' .OR. ICOM.EQ.'3' .OR.
     1       ICOM.EQ.'THRE') .AND.
     1       IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')THEN
        ICASFI='3FIT'
        ILASTC=2
      ELSEIF(NUMARG.GE.2 .AND. ICOM.EQ.'DEGR' .AND.
     1      (IHARG(1).EQ.'3' .OR. IHARG(1).EQ.'THRE') .AND.
     1       IHARG(2).EQ.'FIT')THEN
        ICASFI='3FIT'
        ILASTC=2
      ELSEIF(NUMARG.GE.1 .AND. ICOM.EQ.'CUBI' .AND.
     1       IHARG(1).EQ.'FIT')THEN
        ICASFI='3FIT'
        ILASTC=1
C
C               *******************************************
C               **  STEP 1.24--                          **
C               **  SEARCH FOR 4-TH DEGREE    FITTING    **
C               *******************************************
C
      ELSEIF(NUMARG.GE.3 .AND. ICOM.EQ.'4' .AND. IHARG(1).EQ.'TH' .AND.
     1       IHARG(2).EQ.'DEGR' .AND. IHARG(3).EQ.'FIT')THEN
        ICASFI='4FIT'
        ILASTC=3
      ELSEIF(NUMARG.GE.2 .AND.
     1      (ICOM.EQ.'4TH' .OR. ICOM.EQ.'FOUR' .OR. ICOM.EQ.'4') .AND.
     1       IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')THEN
        ICASFI='4FIT'
        ILASTC=2
      ELSEIF(NUMARG.GE.2 .AND. ICOM.EQ.'DEGR' .AND.
     1      (IHARG(1).EQ.'4' .OR. IHARG(1).EQ.'FOUR') .AND.
     1       IHARG(2).EQ.'FIT')THEN
        ICASFI='4FIT'
        ILASTC=2
      ELSEIF(NUMARG.GE.1 .AND. ICOM.EQ.'QUAR' .AND.
     1       IHARG(1).EQ.'FIT')THEN
        ICASFI='4FIT'
        ILASTC=1
C
C               *******************************************
C               **  STEP 1.25--                          **
C               **  SEARCH FOR 5-TH DEGREE    FITTING    **
C               *******************************************
C
      ELSEIF(NUMARG.GE.3 .AND. ICOM.EQ.'5' .AND. IHARG(1).EQ.'TH' .AND.
     1       IHARG(2).EQ.'DEGR' .AND. IHARG(3).EQ.'FIT')THEN
        ICASFI='5FIT'
        ILASTC=3
      ELSEIF(NUMARG.GE.2 .AND.
     1      (ICOM.EQ.'5TH' .OR. ICOM.EQ.'FIFT' .OR. ICOM.EQ.'5' .OR.
     1       ICOM.EQ.'FIVE') .AND.
     1       IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')THEN
        ICASFI='5FIT'
        ILASTC=2
      ELSEIF(NUMARG.GE.2 .AND. ICOM.EQ.'DEGR' .AND.
     1      (IHARG(1).EQ.'5' .OR. IHARG(1).EQ.'FIVE') .AND.
     1       IHARG(2).EQ.'FIT')THEN
        ICASFI='5FIT'
        ILASTC=2
      ELSEIF(NUMARG.GE.1 .AND. ICOM.EQ.'QUIN' .AND.
     1       IHARG(1).EQ.'FIT')THEN
        ICASFI='5FIT'
        ILASTC=1
C
C               *******************************************
C               **  STEP 1.26--                          **
C               **  SEARCH FOR 6-TH DEGREE    FITTING    **
C               *******************************************
C
      ELSEIF(NUMARG.GE.3 .AND. ICOM.EQ.'6' .AND. IHARG(1).EQ.'TH' .AND.
     1       IHARG(2).EQ.'DEGR' .AND. IHARG(3).EQ.'FIT')THEN
        ICASFI='6FIT'
        ILASTC=3
      ELSEIF(NUMARG.GE.2 .AND.
     1      (ICOM.EQ.'6TH' .OR. ICOM.EQ.'SIXT' .OR. ICOM.EQ.'6' .OR.
     1       ICOM.EQ.'SIX') .AND.
     1       IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')THEN
        ICASFI='6FIT'
        ILASTC=2
      ELSEIF(NUMARG.GE.2 .AND. ICOM.EQ.'DEGR' .AND.
     1      (IHARG(1).EQ.'6' .OR. IHARG(1).EQ.'SIX') .AND.
     1       IHARG(2).EQ.'FIT')THEN
        ICASFI='6FIT'
        ILASTC=2
      ELSEIF(NUMARG.GE.1 .AND. ICOM.EQ.'SEXT' .AND.
     1       IHARG(1).EQ.'FIT')THEN
        ICASFI='6FIT'
        ILASTC=1
C
C               *******************************************
C               **  STEP 1.27--                          **
C               **  SEARCH FOR 7-TH DEGREE    FITTING    **
C               *******************************************
C
      ELSEIF(NUMARG.GE.3 .AND. ICOM.EQ.'7' .AND. IHARG(1).EQ.'TH' .AND.
     1       IHARG(2).EQ.'DEGR' .AND. IHARG(3).EQ.'FIT')THEN
        ICASFI='7FIT'
        ILASTC=3
      ELSEIF(NUMARG.GE.2 .AND.
     1      (ICOM.EQ.'7TH' .OR. ICOM.EQ.'SEVE' .OR. ICOM.EQ.'7') .AND.
     1       IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')THEN
        ICASFI='7FIT'
        ILASTC=2
      ELSEIF(NUMARG.GE.2 .AND. ICOM.EQ.'DEGR' .AND.
     1      (IHARG(1).EQ.'7' .OR. IHARG(1).EQ.'SEVE') .AND.
     1       IHARG(2).EQ.'FIT')THEN
        ICASFI='7FIT'
        ILASTC=2
      ELSEIF(NUMARG.GE.1 .AND. ICOM.EQ.'SEPT' .AND.
     1       IHARG(1).EQ.'FIT')THEN
        ICASFI='7FIT'
        ILASTC=1
C
C               *******************************************
C               **  STEP 1.28--                          **
C               **  SEARCH FOR 8-TH DEGREE    FITTING    **
C               *******************************************
C
      ELSEIF(NUMARG.GE.3 .AND. ICOM.EQ.'8' .AND. IHARG(1).EQ.'TH' .AND.
     1       IHARG(2).EQ.'DEGR' .AND. IHARG(3).EQ.'FIT')THEN
        ICASFI='8FIT'
        ILASTC=3
      ELSEIF(NUMARG.GE.2 .AND.
     1      (ICOM.EQ.'8TH' .OR. ICOM.EQ.'EIGH' .OR. ICOM.EQ.'8') .AND.
     1       IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')THEN
        ICASFI='8FIT'
        ILASTC=2
      ELSEIF(NUMARG.GE.2 .AND. ICOM.EQ.'DEGR' .AND.
     1      (IHARG(1).EQ.'8' .OR. IHARG(1).EQ.'EIGH') .AND.
     1       IHARG(2).EQ.'FIT')THEN
        ICASFI='8FIT'
        ILASTC=2
      ELSEIF(NUMARG.GE.1 .AND. ICOM.EQ.'OCTI' .AND.
     1       IHARG(1).EQ.'FIT')THEN
        ICASFI='8FIT'
        ILASTC=1
C
C               *******************************************
C               **  STEP 1.29--                          **
C               **  SEARCH FOR 9-TH DEGREE    FITTING    **
C               *******************************************
C
      ELSEIF(NUMARG.GE.3 .AND. ICOM.EQ.'9' .AND. IHARG(1).EQ.'TH' .AND.
     1       IHARG(2).EQ.'DEGR' .AND. IHARG(3).EQ.'FIT')THEN
        ICASFI='9FIT'
        ILASTC=3
      ELSEIF(NUMARG.GE.2 .AND.
     1      (ICOM.EQ.'9TH' .OR. ICOM.EQ.'NINT' .OR. ICOM.EQ.'9' .OR.
     1       ICOM.EQ.'NINE') .AND.
     1       IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')THEN
        ICASFI='9FIT'
        ILASTC=2
      ELSEIF(NUMARG.GE.2 .AND. ICOM.EQ.'DEGR' .AND.
     1      (IHARG(1).EQ.'9' .OR. IHARG(1).EQ.'NINT') .AND.
     1       IHARG(2).EQ.'FIT')THEN
        ICASFI='9FIT'
        ILASTC=2
      ELSEIF(NUMARG.GE.1 .AND. ICOM.EQ.'NONI' .AND.
     1       IHARG(1).EQ.'FIT')THEN
        ICASFI='9FIT'
        ILASTC=1
C
C               *******************************************
C               **  STEP 1.20--                          **
C               **  SEARCH FOR 10-TH DEGREE   FITTING    **
C               *******************************************
C
      ELSEIF(NUMARG.GE.3 .AND. ICOM.EQ.'10' .AND. IHARG(1).EQ.'TH' .AND.
     1       IHARG(2).EQ.'DEGR' .AND. IHARG(3).EQ.'FIT')THEN
        ICASFI='10FI'
        ILASTC=3
      ELSEIF(NUMARG.GE.2 .AND.
     1      (ICOM.EQ.'10TH' .OR. ICOM.EQ.'TENT' .OR. ICOM.EQ.'10' .OR.
     1       ICOM.EQ.'TEN') .AND.
     1       IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')THEN
        ICASFI='10FI'
        ILASTC=2
      ELSEIF(NUMARG.GE.2 .AND. ICOM.EQ.'DEGR' .AND.
     1      (IHARG(1).EQ.'10' .OR. IHARG(1).EQ.'TEN') .AND.
     1       IHARG(2).EQ.'FIT')THEN
        ICASFI='10FI'
        ILASTC=2
      ELSEIF(NUMARG.GE.1 .AND. ICOM.EQ.'DEXI' .AND.
     1       IHARG(1).EQ.'FIT')THEN
        ICASFI='10FI'
        ILASTC=1
      ELSE
C
C               ********************************************
C               **  STEP 1.31--                           **
C               **  SINCE VALID COMMAND NOT FOUND, EXIT.  **
C               ********************************************
C
C
C
        IFOUND='NO'
        GOTO9000
      ENDIF
C
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ILOCFI=ILASTC
      IFOUND='YES'
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF CKFIT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IFOUND,IERROR,ICASFI,ILOCFI
 9012   FORMAT('IFOUND,IERROR,ICASFI,ILOCFI = ',3(A4,2X),I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE CKINTE(X,EPS,ONEMEP,ONEPEP,ICINT,IX)
C
C     PURPOSE--GIVEN A FLOATING POINT VALUE X,
C          (NON-NEGATIVE)
C         DETERMINE IF IT IS WITHIN EPS OF AN INTEGER.
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     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 ICINT
      CHARACTER*4 ISIGN
      CHARACTER*4 IPATH
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'INTE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF CKINTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)X,EPS,ONEMEP,ONEPEP
   52 FORMAT('X,EPS,ONEMEP,ONEPEP = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4,ISUBG4,IERRG4
   59 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      ISIGN='POS'
      IF(X.LT.0.0)ISIGN='NEG'
C
      ABSX=ABS(X)
      INTZZ=INT(ABSX)
      AINT=REAL(INTZZ)
      REM=ABSX-AINT
      ABSREM=ABS(REM)
      IF(ABSREM.LE.EPS)GOTO1110
      IF(ONEMEP.LE.ABSREM.AND.ABSREM.LE.ONEPEP)GOTO1120
      GOTO1130
C
 1110 CONTINUE
      IPATH='1'
      ICINT='YES'
      IX=INT(ABSX)
      GOTO1190
C
 1120 CONTINUE
      IPATH='2'
      ICINT='YES'
      IX=INT(ABSX)
      IX=IX+1
      GOTO1190
C
 1130 CONTINUE
      IPATH='3'
      ICINT='NO'
      IX=INT(ABSX)
      GOTO1190
C
 1190 CONTINUE
      IF(ISIGN.EQ.'NEG')IX=(-IX)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'INTE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF CKINTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)X,EPS,ONEMEP,ONEPEP
 9012 FORMAT('X,EPS,ONEMEP,ONEPEP = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X,ABSX,INTZZ,REM,ABSREM
 9013 FORMAT('X,ABSX,INTZZ,REM,ABSREM = ',2E15.7,I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)EPS,ONEMEP,ONEPEP
 9014 FORMAT('EPS,ONEMEP,ONEPEP = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IPATH,ICINT,ISIGN,IX
 9015 FORMAT('IPATH,ICINT,ISIGN,IX = ',A4,2X,A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4
 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
CCCCC DEBUG TRACE,INIT
CCCCC AT 90
CCCCC TRACE ON
      END
      SUBROUTINE CKLIB1(IA,N,I,IFOUND,NCLF,IBUGCK,IERROR)
C
C     PURPOSE--SEARCH THE 1-CHARACTER PER WORD
C              CHARACTER STRING IN IA(.)
C              STARTING WITH POSITION I
C              AND DETERMINE IF THAT
C              STRING IS A MEMBER OF THE
C              AUGMENTED LIBRARY FUNCTION SET.
C     NOTE--THIS IS PART 1
C           (SEARCHING FOR LIBRARY FUNCTIONS
C           WITH STARTING CHARACTERS OF A TO J)
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED         --FEBRUARY  1981.
C     UPDATED         --JUNE      1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JUNE      1987.    FRACT(.)
C     UPDATED         --SEPTEMBER 1988.    IND(.) = INDICATOR FUNCTION
C     UPDATED         --APRIL     1989.    JULIA(.) = JULIA IND. FUNC.
C     UPDATED         --MAY       1989.    CP(.,.) PROCESS CAPABILITY
C     UPDATED         --MAY       1989.    CPK(.,.) PROCESS CAPABILITY
C     UPDATED         --MAY       1989.    EXPLOS(.,.,.) EXPECTED LOSS
C     UPDATED         --JANUARY   1990.    BINPAT(.,.) BINARY PATTERN
C     UPDATED         --MAY       1990.    IGCDF/PDF/PPF  (INV GAUS)
C     UPDATED         --MAY       1990.    FL-CDF/PDF/PPF  (FAT LIFE)
C     UPDATED         --DECEMBER  1993.    GEP-CDF/PDF/PPF
C                                          (GENERALIZED PARETO)
C     UPDATED         --APRIL     1994.    BIN-CDF/PDF/PPF (BINOMIAL)
C     UPDATED         --APRIL     1994.    CAU-CDF/PDF/PPF (CAUCHY)
C     UPDATED         --APRIL     1994.    DEX-CDF/PDF/PPF (BINOMIAL)
C     UPDATED         --APRIL     1994.    EV1-CDF/PDF/PPF (EV1)
C     UPDATED         --APRIL     1994.    EV2-CDF/PDF/PPF (EV2)
C     UPDATED         --APRIL     1994.    EXP-CDF/PDF/PPF (BINOMIAL)
C     UPDATED         --APRIL     1994.    GAM-CDF/PPF (GAMMA)
C     UPDATED         --APRIL     1994.    GEO-CDF/PDF/PPF (GEOMETRIC)
C     UPDATED         --APRIL     1994.    HFN-CDF/PPF (HALF-NORMAL)
C     UPDATED         --SEPTEMBER 1994.    BET-CDF/PDF/PPF (BETA)
C     UPDATED         --SEPTEMBER 1994.    DIS-CDF/PDF/PPF (DISCRETE
C                                          UNIFORM)
C     UPDATED         --SEPTEMBER 1994.    BETA (BETA FUNCTION)
C     UPDATED         --SEPTEMBER 1994.    BETAI (INCOMPLETE BETA)
C     UPDATED         --SEPTEMBER 1994.    GAMMI (INCOMPLETE GAMMA)
C     UPDATED         --SEPTEMBER 1994.    ADDITIONAL BESSEL FUNCTIONS
C     UPDATED         --SEPTEMBER 1994.    DAWSON, EXPONENTIAL INTEGRAL
C     UPDATED         --SEPTEMBER 1994.    DNF-CDF/PPF (DOUBLY NC F)
C     UPDATED         --SEPTEMBER 1994.    DNT-CDF/PPF (DOUBLY NC T)
C     UPDATED         --SEPTEMBER 1994.    HYP-CDF/PDF/PPF (HYPERGEOM)
C     UPDATED         --SEPTEMBER 1994.    GAMMAR (RECIPROCAL GAMMA)
C     UPDATED         --SEPTEMBER 1994.    DIGAMMA (DIGAMMA)
C     UPDATED         --SEPTEMBER 1994.    GAMMAIC (COMPLEMENTARY
C                                          INCOMPLETE GAMMA)
C     UPDATED         --SEPTEMBER 1994.    ELLIPC,ELLIP1,ELLIP2,ELLIP3
C                                          (LEGENDRE FORM OF ELLIPTIC
C                                          INTEGRALS)
C     UPDATED         --SEPTEMBER 1994.    CHU (LOGARITHMIC CONFLUENT
C                                          HYPERGEOMETRIC FUNCTION)
C     UPDATED         --SEPTEMBER 1994.    COSINT, COSHINT
C     UPDATED         --OCTOBER   1994.    CBESSJR, CBESSJI
C     UPDATED         --OCTOBER   1994.    CBESSYR, CBESSYI
C     UPDATED         --OCTOBER   1994.    CBESSIR, CBESSII
C     UPDATED         --OCTOBER   1994.    CBESSKR, CBESSKI
C     UPDATED         --OCTOBER   1994.    CEXP, CLOG, CSQRT, CABS,
C                                          CSIN, CCOS
C     UPDATED         --NOVEMBER  1994.    FRESNC, FRESNS, FRESNF,
C                                          FRESNG (FRESNEL INTEGRALS)
C     UPDATED         --NOVEMBER  1994.    CN, DN (JACOBIAN ELLIPTIC
C                                          FUNCTIONS)
C     UPDATED         --MARCH     1995.    CEIL, FLOOR, GCD, HEAVE
C     UPDATED         --APRIL     1995.    COSCDF, COSPDF, COSPPF
C     UPDATED         --APRIL     1995.    ALPCDF, ALPPDF, ALPPPF
C     UPDATED         --APRIL     1995.    FNRCDF, FNRPDF, FNRPPF
C     UPDATED         --APRIL     1995.    CHCDF, CHPDF, CHPPF
C     UPDATED         --APRIL     1995.    DLGPDF, DLGCDF, DLGPPF
C     UPDATED         --APRIL     1995.    GGDPDF, GGDCDF, GGDPPF
C     UPDATED         --MAY       1995.    BVNPDF
C     UPDATED         --JULY      1995.    HERMITE, CHEBT, CHEBU,
C                                          JACOBIP (POLYNOMIALS)
C     UPDATED         --SEPTEMBER 1995.    ANGPDF, ANGCDF, ANGPPF
C     UPDATED         --SEPTEMBER 1995.    ARSPDF, ARSCDF, ARSPPF
C     UPDATED         --OCTOBER   1995.    DIPPDF, DIPCDF, DIPPPF
C     UPDATED         --OCTOBER   1995.    HSEPDF, HSECDF, HSEPPF
C     UPDATED         --OCTOBER   1995.    HFCPDF, HFCCDF, HFCPPF
C     UPDATED         --OCTOBER   1995.    HFLPDF, HFLCDF, HFLPPF
C     UPDATED         --OCTOBER   1995.    GOMPDF, GOMCDF, GOMPPF
C     UPDATED         --OCTOBER   1995.    DWEPDF, DWECDF, DWEPPF
C     UPDATED         --OCTOBER   1995.    EWEPDF, EWECDF, EWEPPF
C     UPDATED         --DECEMBER  1995.    GLOPDF, GLOCDF, GLOPPF
C     UPDATED         --JANUARY   1996.    DGAPDF, DGACDF, DGAPPF
C     UPDATED         --JANUARY   1996.    FCAPDF, FCACDF, FCAPPF
C     UPDATED         --FEBRUARY  1996.    BBNPDF, BBNCDF, BBNPPF
C     UPDATED         --FEBRUARY  1996.    BRAPDF, BPACDF, BPAPPF
C     UPDATED         --FEBRUARY  1996.    GEXPDF, GEXCDF, GEXPPF
C     UPDATED         --MARCH     1997.    STRUVE FUNCTIONS (H0,H1,HV)
C     UPDATED         --JULY      1997.    CHM (CONFLUENT M
C                                          HYPERGEOMETRIC FUNCTION)
C     UPDATED         --AUGUST    1997.    CGAMMA, CGAMMAI
C     UPDATED         --AUGUST    1997.    CLNGAM, CLNGAMI
C     UPDATED         --AUGUST    1997.    CPSI, CPSII
C     UPDATED         --AUGUST    1997.    HYPERGEO (HYPERGEOMETRIC FUNCTION)
C     UPDATED         --AUGUST    1997.    CBETA, CLBETA
C     UPDATED         --SEPTEMBER 1997.    BER, BERI, BER1, BERI1
C     UPDATED         --SEPTEMBER 1997.    KER, KERI, KER1, KERI1
C     UPDATED         --SEPTEMBER 1997.    BN, EN, ETA, CATLAN, BINOM
C     UPDATED         --APRIL     1998.    EXPHAZ, EXPCHA
C     UPDATED         --APRIL     1998.    GEPHAZ, GEPCHA
C     UPDATED         --APRIL     1998.    EV1HAZ, EV1CHA
C     UPDATED         --APRIL     1998.    EV2HAZ, EV2CHA
C     UPDATED         --APRIL     1998.    GAMHAZ, GAMCHA
C     UPDATED         --APRIL     1998.    GGDHAZ, GGDCHA
C     UPDATED         --APRIL     1998.    IGACDF, IGAPDF, IGAPPF
C     UPDATED         --APRIL     1998.    IGAHAZ, IGACHA
C     UPDATED         --APRIL     1998.    IGHAZ, IGCHA
C     UPDATED         --APRIL     1998.    FLHAZ, FLCHA
C     UPDATED         --APRIL     1998.    ALPHAZ, ALPCHAZ
C     UPDATED         --MAY       1998.    EWEHAZ, EWECHAZ
C     UPDATED         --MARCH     1999.    ABRAM
C     UPDATED         --MARCH     1999.    CLAUSN
C     UPDATED         --MARCH     1999.    DEBYE
C     UPDATED         --MARCH     1999.    EXP3
C     UPDATED         --MARCH     1999.    GOODST
C     UPDATED         --AUGUST    2001.    GLDCDF, GLDPDF, GLDPPF
C                                          GLDCHK, GLDLLM, GLDULM
C                                          GLDSGN
C     UPDATED         --SEPTEMBER 2001.    IWECDF, IWEPDF, IWEPPF
C     UPDATED         --NOVEMBER  2001.    IWEHAZ, IWECHAZ
C     UPDATED         --SEPTEMBER 2001.    LDECDF, LDEPDF, LDEPPF
C     UPDATED         --SEPTEMBER 2001.    JSBCDF, JSBPDF, JSBPPF
C     UPDATED         --SEPTEMBER 2001.    JSUCDF, JSUPDF, JSUPPF
C     UPDATED         --NOVEMBER  2001.    GEECDF, GEEPDF, GEEPPF,
C                                          GEEHAZ, GEECHAZ
C     UPDATED         --MAY       2002.    BWECDF, BWEPDF, BWEPPF,
C                                          BWEHAZ, BWECHAZ
C     UPDATED         --JANUARY   2003.    GHCDF,  GHPDF,  GHPPF
C     UPDATED         --MAY       2003.    IBCDF,  IBPDF,  IBPPF
C     UPDATED         --MAY       2003.    ERRCDF, ERRPDF, ERRPPF
C     UPDATED         --JUNE      2003.    GTRCDF, GTRPDF, GTRPPF
C     UPDATED         --NOVEMBER  2003.    FTCDF,  FTPDF,  FTPPF
C     UPDATED         --DECEMBER  2003.    GIGCDF, GIGPDF, GIGPPF
C     UPDATED         --MARCH     2004.    HERCDF, HERPDF, HERPPF
C     UPDATED         --APRIL     2004.    GWACDF, GWAPDF, GWAPPF
C     UPDATED         --JUNE      2004.    ADECDF, ADEPDF, ADEPPF
C     UPDATED         --JUNE      2004.    GALCDF, GALPDF, GALPPF
C     UPDATED         --JUNE      2004.    FERCDF, FERPDF, FERPPF
C     UPDATED         --AUGUST    2004.    BEICDF, BEIPDF, BEIPPF
C     UPDATED         --AUGUST    2004.    BEKCDF, BEKPDF, BEKPPF
C     UPDATED         --SEPTEMBER 2004.    GMCCDF, GMCPDF, GMCPPF
C     UPDATED         --SEPTEMBER 2004.    HBOCDF, HBOPDF, HBOPPF
C     UPDATED         --MARCH     2005.    EXPAFR
C     UPDATED         --MAY       2005.    GEVCHAZ, GEVHAZ
C     UPDATED         --NOVEMBER  2005.  AIRINT
C     UPDATED         --NOVEMBER  2005.  AIRYGI
C     UPDATED         --NOVEMBER  2005.  AIRYHI
C     UPDATED         --NOVEMBER  2005.  ATNINT
C     UPDATED         --NOVEMBER  2005.  BIRINT
C     UPDATED         --NOVEMBER  2005.  I0INT
C     UPDATED         --NOVEMBER  2005.  I0ML0
C     UPDATED         --NOVEMBER  2005.  I1ML1
C     UPDATED         --NOVEMBER  2005.  J0INT
C     UPDATED         --FEBRUARY  2006.  GL2CDF, GL2PDF, GL2PPF
C     UPDATED         --FEBRUARY  2006.  GL3CDF, GL3PDF, GL3PPF
C     UPDATED         --FEBRUARY  2006.  GL4CDF, GL4PDF, GL4PPF
C     UPDATED         --FEBRUARY  2006.  GL5CDF, GL5PDF, GL5PPF
C     UPDATED         --MARCH     2006.  BNOCDF, BNOPDF, BNOPPF
C     UPDATED         --MARCH     2006.  ALDCDF, ALDPDF, ALDPPF
C     UPDATED         --MAY       2006.  HARMNUMB
C     UPDATED         --MAY       2006.  BGECDF, BGEPDF, BGEPPF
C     UPDATED         --MAY       2006.  BNBCDF, BNBPDF, BNBPPF
C     UPDATED         --MAY       2006.  BTACDF, BTAPDF, BTAPPF
C     UPDATED         --JUNE      2006.  DXGCDF, DXGPDF, DXGPPF
C     UPDATED         --JUNE      2006.  GLSCDF, GLSPDF, GLSPPF
C     UPDATED         --JULY      2006.  GETCDF, GETPDF, GETPPF
C     UPDATED         --JULY      2006.  GNBCDF, GNBPDF, GNBPPF
C     UPDATED         --AUGUST    2006.  CONCDF, CONPDF, CONPPF
C     UPDATED         --NOVEMBER  2006.  DIWCDF, DIWPDF, DIWPPF
C     UPDATED         --NOVEMBER  2006.  GLGCDF, GLGPDF, GLGPPF
C     UPDATED         --JANUARY   2007.  GNTCDF, GNTPDF, GNTPPF
C     UPDATED         --FEBRUARY  2007.  GTLCDF, GTLPDF, GTLPPF
C     UPDATED         --OCTOBER   2007.  BU1CDF, BU1PDF, BU1PPF
C     UPDATED         --OCTOBER   2007.  BU2CDF, BU2PDF, BU2PPF
C     UPDATED         --OCTOBER   2007.  BU3CDF, BU3PDF, BU3PPF
C     UPDATED         --OCTOBER   2007.  BU4CDF, BU4PDF, BU4PPF
C     UPDATED         --OCTOBER   2007.  BU5CDF, BU5PDF, BU5PPF
C     UPDATED         --OCTOBER   2007.  BU6CDF, BU6PDF, BU6PPF
C     UPDATED         --OCTOBER   2007.  BU7CDF, BU7PDF, BU7PPF
C     UPDATED         --OCTOBER   2007.  BU8CDF, BU8PDF, BU8PPF
C     UPDATED         --OCTOBER   2007.  BU9CDF, BU9PDF, BU9PPF
C     UPDATED         --OCTOBER   2007.  B10CDF, B10PDF, B10PPF
C     UPDATED         --OCTOBER   2007.  B11CDF, B11PDF, B11PPF
C     UPDATED         --OCTOBER   2007.  B12CDF, B12PDF, B12PPF
C     UPDATED         --OCTOBER   2007.  DPUCDF, DPUPDF, DPUPPF
C     UPDATED         --MARCH     2008.  BFRCDF, BFRPDF, BFRPPF,
C                                        BFRCHAZ, BFRHAZ
C     UPDATED         --JULY      2010.  EEWCDF, EEWPDF, EEWPPF
C     UPDATED         --AUGUST    2010.  BFWCDF, BFWPDF, BFWPPF
C     UPDATED         --JANUARY   2011.  ATNCDF, ATNPDF, ATNPPF
C     UPDATED         --AUGUST    2011.  AGREE, DISAGREE
C     UPDATED         --OCTOBER   2012.  DPNTLINE (PERPINDICULAR
C                                        DISTANCE BETWEEN POINT AND
C                                        LINE
C     UPDATED         --OCTOBER   2012.  ANGRAD (ANGLE DEFINED BY
C                                        3 POINTS DEFINED IN RADIANS)
C     UPDATED         --MAY       2014.  EXPSURV, EXPISURV
C     UPDATED         --MAY       2014.  EV1SURV, EV1ISURV
C     UPDATED         --MAY       2014.  EV2SURV, EV2ISURV
C     UPDATED         --MAY       2014.  EWESURV, EWEISURV
C     UPDATED         --MAY       2014.  FLSURV,  FLISURV
C     UPDATED         --MAY       2014.  GAMSURV, GAMISURV
C     UPDATED         --MAY       2014.  GEESURV, GEEISURV
C     UPDATED         --MAY       2014.  GEVSURV, GEVISURV
C     UPDATED         --MAY       2014.  GOMSURV, GOMISURV
C     UPDATED         --MAY       2014.  IGSURV,  IGISURV
C     UPDATED         --MAY       2014.  IGASURV, IGAISURV
C     UPDATED         --MAY       2014.  IWESURV, IWEISURV
C     UPDATED         --SEPTEMBER 2014.  GCDF, GPDF, GPPF
C     UPDATED         --AUGUST    2015.  BINOCTAL, BINDEC, DECBIN
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IA
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGCK
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IA(*)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NCLF=-99
C
      NP1=N+1
C
      IF(IBUGCK.EQ.'ON')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('AT THE BEGINNING OF CKLIB1--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)N,I,IBUGCK
   52   FORMAT('N,I,IBUGCK = ',I8,I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
        DO55I2=1,N
         WRITE(ICOUT,56)I2,IA(I2)
   56    FORMAT('I2,IA(I2) = ',I8,2X,A4)
         CALL DPWRST('XXX','BUG ')
   55   CONTINUE
      ENDIF
C
      IF(I.GE.NP1)GOTO9000
C
C               ****************************
C               **  STEP 1--              **
C               **  SEARCH FOR FUNCTIONS  **
C               **  STARTING WITH A--     **
C               **       ABS              **
C               **       AINT             **
C               **       ALOG10           **
C               **       ALOGE            **
C               **       ALOG             **
C               **       AMOD             **
C               **       ARCCOSH          **
C               **       ARCCOS           **
C               **       ARCCOTH          **
C               **       ARCCOT           **
C               **       ARCCSCH          **
C               **       ARCCSC           **
C               **       ARCSECH          **
C               **       ARCSEC           **
C               **       ARCSINH          **
C               **       ARCSIN           **
C               **       ARCTANH          **
C               **       ARCTAN           **
C               **       ATAN2            **
C               **       ATAN             **
C               **  SEPTEMBER 1994:       **
C               **       AIRY             **
C               **  APRIL     1995:       **
C               **       ALPCDF           **
C               **       ALPPDF           **
C               **       ALPPPF           **
C               **  SEPTEMBER 1995:       **
C               **       ANGCDF           **
C               **       ANGPDF           **
C               **       ANGPPF           **
C               **  SEPTEMBER 1995:       **
C               **       ARSCDF           **
C               **       ARSPDF           **
C               **       ARSPPF           **
C               **  APRIL     1998:       **
C               **       ALPHAZ, ALPCHAZ  **
C               **  MARCH     1999:       **
C               **       ABRAM            **
C               **  JUNE      2004:       **
C               **       ADECDF           **
C               **       ADEPDF           **
C               **       ADEPPF           **
C               **  NOVEMBER  2005:       **
C               **       AIRINT           **
C               **  MARCH     2006:       **
C               **       ALDCDF           **
C               **       ALDPDF           **
C               **       ALDPPF           **
C               **  JANUARY   2011:       **
C               **       ATNCDF           **
C               **       ATNPDF           **
C               **       ATNPPF           **
C               **       ATNHAZ           **
C               **       ATNCHAZ          **
C               **  AUGUST    2011:       **
C               **       AGREE            **
C               **  OCTOBER   2012:       **
C               **       ANGRAD           **
C               ****************************
C
      IF(IA(I).EQ.'A')GOTO109
      GOTO190
  109 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'B')GOTO110
      IF(IA(IP1).EQ.'I')GOTO120
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'D')GOTO185
      IF(IA(IP1).EQ.'L')GOTO130
      IF(IA(IP1).EQ.'M')GOTO140
      IF(IA(IP1).EQ.'R')GOTO150
      IF(IA(IP1).EQ.'T'.AND.IA(IP2).EQ.'N')GOTO188
      IF(IA(IP1).EQ.'T')GOTO160
      IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'R'.AND.
     1   IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'D')GOTO7600
      IF(IA(IP1).EQ.'N')GOTO170
      IF(IA(IP1).EQ.'D')GOTO180
      IF(IA(IP1).EQ.'G'.AND.IA(IP2).EQ.'R'.AND.IA(IP3).EQ.'E'.AND.
     1   IA(IP4).EQ.'E')GOTO7500
      GOTO9000
C
  110 CONTINUE
      IF(IA(IP2).EQ.'R'.AND.IA(IP3).EQ.'A'.AND.
     1   IA(IP4).EQ.'M')GOTO7500
      IF(IA(IP2).EQ.'S')GOTO7300
      GOTO9000
C
  120 CONTINUE
      IF(IA(IP2).EQ.'R'.AND.IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'N'.AND.
     1   IA(IP5).EQ.'T')GOTO7600
      IF(IA(IP2).EQ.'R'.AND.IA(IP3).EQ.'Y'.AND.IA(IP4).EQ.'G'.AND.
     1   IA(IP5).EQ.'I')GOTO7600
      IF(IA(IP2).EQ.'R'.AND.IA(IP3).EQ.'Y'.AND.IA(IP4).EQ.'H'.AND.
     1   IA(IP5).EQ.'I')GOTO7600
      IF(IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'T')GOTO7400
      IF(IA(IP2).EQ.'R'.AND.IA(IP3).EQ.'Y')GOTO7400
      GOTO9000
C
  130 CONTINUE
      IF(IA(IP2).EQ.'O'.AND.IA(IP3).EQ.'G'.AND.IA(IP4).EQ.'1'.AND.
     1IA(IP5).EQ.'0')GOTO7600
      IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.
     1IA(IP5).EQ.'Z')GOTO7600
      IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.
     1IA(IP5).EQ.'A'.AND.IA(IP6).EQ.'Z')GOTO7700
      IF(IA(IP2).EQ.'O'.AND.IA(IP3).EQ.'G'.AND.IA(IP4).EQ.'E')GOTO7500
      IF(IA(IP2).EQ.'O'.AND.IA(IP3).EQ.'G')GOTO7400
      IF(IA(IP2).EQ.'N')GOTO7300
      GOTO9000
C
  140 CONTINUE
      IF(IA(IP2).EQ.'O'.AND.IA(IP3).EQ.'D')GOTO7400
      GOTO9000
C
  150 CONTINUE
      IF(IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP2).EQ.'C')GOTO155
      GOTO9000
  155 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'O'.AND.IA(IP5).EQ.'S'.AND.
     1IA(IP6).EQ.'H')GOTO7700
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'O'.AND.IA(IP5).EQ.'S')GOTO7600
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'O'.AND.IA(IP5).EQ.'T'.AND.
     1IA(IP6).EQ.'H')GOTO7700
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'O'.AND.IA(IP5).EQ.'T')GOTO7600
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'S'.AND.IA(IP5).EQ.'C'.AND.
     1IA(IP6).EQ.'H')GOTO7700
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'S'.AND.IA(IP5).EQ.'C')GOTO7600
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'E'.AND.IA(IP5).EQ.'C'.AND.
     1IA(IP6).EQ.'H')GOTO7700
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'E'.AND.IA(IP5).EQ.'C')GOTO7600
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'I'.AND.IA(IP5).EQ.'N'.AND.
     1IA(IP6).EQ.'H')GOTO7700
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'I'.AND.IA(IP5).EQ.'N')GOTO7600
      IF(IA(IP3).EQ.'T'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'N'.AND.
     1IA(IP6).EQ.'H')GOTO7700
      IF(IA(IP3).EQ.'T'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'N')GOTO7600
      GOTO9000
C
  160 CONTINUE
      IF(IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'N'.AND.
     1   IA(IP5).EQ.'T')GOTO7600
      IF(IA(IP2).EQ.'A'.AND.IA(IP3).EQ.'N'.AND.IA(IP4).EQ.'2')GOTO7500
      IF(IA(IP2).EQ.'A'.AND.IA(IP3).EQ.'N')GOTO7400
      GOTO9000
C
  170 CONTINUE
      IF(IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      GOTO9000
  180 CONTINUE
      IF(IA(IP2).EQ.'E'.AND.IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP2).EQ.'E'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP2).EQ.'E'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      GOTO9000
  185 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      GOTO9000
  188 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.
     1IA(IP5).EQ.'Z')GOTO7600
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.
     1IA(IP5).EQ.'A'.AND.IA(IP6).EQ.'Z')GOTO7700
      GOTO9000
  190 CONTINUE
C
C               **********************************
C               **  STEP 2--                    **
C               **  SEARCH FOR FUNCTIONS        **
C               **  STARTING WITH B--           **
C               **       BESS0                  **
C               **       BESS1                  **
C               **  JANUARY 1990:               **
C               **       BINPAT                 **
C               **  APRIL 1994:                 **
C               **       BINCDF, BINPDF, BINPPF **
C               **  SEPTEMBER 1994:             **
C               **       BETCDF, BETPDF, BETPPF **
C               **       BETA, BETAF            **
C               **       BESSY0, BESSY1         **
C               **       BESSI0, BESSI1         **
C               **       BESSI0E, BESSI1E       **
C               **       BESSK0E, BESSK1E       **
C               **       BESSJN, BESSYN         **
C               **       BESSIN, BESSKN         **
C               **       BESSINE, BESSKNE       **
C               **       BAIRY                  **
C               **  OCTOBER 1994:               **
C               **       BVNCDF                 **
C               **  MAY     1995:               **
C               **       BVNPDF                 **
C               **  FEBRUARY 1996:              **
C               **       BBNCDF, BBNPDF, BBNPPF **
C               **       BRACDF, BRAPDF, BRAPPF **
C               **  SEPTEMBER 1997:             **
C               **       BER, BERI, BER1, BERI1 **
C               **       BN, BINOM, BINOMIAL    **
C               **  MAY      2002:              **
C               **       BWECDF, BWEPDF, BWEPPF **
C               **       BWEHAZ, BWECHAZ        **
C               **  MARCH    2004:              **
C               **       BEICDF, BEIPDF, BEIPPF **
C               **       BEKCDF, BEKPDF, BEKPPF **
C               **  NOVEMBER 2005:              **
C               **       BIRINT                 **
C               **  MARCH    2006:              **
C               **       BNOCDF, BNOPDF, BNOPPF **
C               **  MAY      2006:              **
C               **       BGECDF, BGEPDF, BGEPPF **
C               **       BNBCDF, BNBPDF, BNBPPF **
C               **       BTACDF, BTAPDF, BTAPPF **
C               **  OCTOBER  2007:              **
C               **       BU1CDF, BU1PDF, BU1PPF **
C               **       BU2CDF, BU2PDF, BU2PPF **
C               **       BU3CDF, BU3PDF, BU3PPF **
C               **       BU4CDF, BU4PDF, BU4PPF **
C               **       BU5CDF, BU5PDF, BU5PPF **
C               **       BU6CDF, BU6PDF, BU6PPF **
C               **       BU7CDF, BU7PDF, BU7PPF **
C               **       BU8CDF, BU8PDF, BU8PPF **
C               **       BU9CDF, BU9PDF, BU9PPF **
C               **       B10CDF, B10PDF, B10PPF **
C               **       B11CDF, B11PDF, B11PPF **
C               **       B12CDF, B12PDF, B12PPF **
C               **  MARCH    2008:              **
C               **       BFRCDF, BFRPDF, BFRPPF **
C               **       BFRCHAZ, BFRHAZ        **
C               **  AUGUST   2010:              **
C               **       BFWCDF, BFWPDF, BFWPPF **
C               **  AUGUST   2015:              **
C               **       BINOCT, BINDEC         **
C               **********************************
C
      IF(IA(I).EQ.'B')GOTO209
      GOTO290
  209 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'R'.AND.
     1IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'N'.AND.
     1IA(IP5).EQ.'T')GOTO7600
      IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'N'.AND.
     1IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'E'.AND.
     1IA(IP5).EQ.'C')GOTO7600
      IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'N'.AND.
     1IA(IP3).EQ.'O'.AND.IA(IP4).EQ.'C'.AND.
     1IA(IP5).EQ.'T'.AND.IA(IP6).EQ.'A'.AND.
     1IA(IP7).EQ.'L')GOTO7800
      IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'N'.AND.
     1IA(IP3).EQ.'O'.AND.IA(IP4).EQ.'C'.AND.
     1IA(IP5).EQ.'T')GOTO7600
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND.
     1IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'1')GOTO7500
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND.
     1IA(IP3).EQ.'I')GOTO7400
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND.
     1IA(IP3).EQ.'1')GOTO7400
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R')GOTO7300
      IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'O')GOTO221
      IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'B')GOTO221
      IF(IA(IP1).EQ.'T'.AND.IA(IP2).EQ.'A')GOTO221
      IF(IA(IP1).EQ.'N')GOTO7200
C
      IF(IA(IP1).EQ.'E')GOTO210
      IF(IA(IP1).EQ.'I')GOTO211
      IF(IA(IP1).EQ.'A')GOTO212
      IF(IA(IP1).EQ.'W'.AND.IA(IP2).EQ.'E')GOTO250
      IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'1')GOTO250
      IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'2')GOTO250
      IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'3')GOTO250
      IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'4')GOTO250
      IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'5')GOTO250
      IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'6')GOTO250
      IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'7')GOTO250
      IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'8')GOTO250
      IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'9')GOTO250
      IF(IA(IP1).EQ.'1'.AND.IA(IP2).EQ.'0')GOTO250
      IF(IA(IP1).EQ.'1'.AND.IA(IP2).EQ.'1')GOTO250
      IF(IA(IP1).EQ.'1'.AND.IA(IP2).EQ.'2')GOTO250
      IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'N')GOTO221
      IF(IA(IP1).EQ.'G'.AND.IA(IP2).EQ.'E')GOTO221
      IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'A')GOTO221
      IF(IA(IP1).EQ.'F'.AND.IA(IP2).EQ.'R')GOTO250
      IF(IA(IP1).EQ.'F'.AND.IA(IP2).EQ.'W')GOTO250
      IF(IA(IP1).EQ.'V'.AND.IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'C'.AND.
     1IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP1).EQ.'V'.AND.IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'P'.AND.
     1IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      GOTO9000
C
  210 CONTINUE
      IF(IA(IP2).EQ.'S')GOTO220
      IF(IA(IP2).EQ.'T')GOTO250
      IF(IA(IP2).EQ.'I')GOTO250
      IF(IA(IP2).EQ.'K')GOTO250
      GOTO9000
  211 CONTINUE
      IF(IA(IP2).EQ.'N')GOTO221
      GOTO9000
  212 CONTINUE
      IF(IA(IP2).EQ.'I'.AND.IA(IP3).EQ.'R'.AND.
     1   IA(IP4).EQ.'Y')GOTO7500
      GOTO9000
C
  220 CONTINUE
      IF(IA(IP3).EQ.'S')GOTO230
      GOTO9000
  221 CONTINUE
      IF(IA(IP3).EQ.'O'.AND.IA(IP4).EQ.'M'.AND.
     1IA(IP5).EQ.'I'.AND.IA(IP6).EQ.'A'.AND.IA(IP7).EQ.'L')GOTO7800
      IF(IA(IP3).EQ.'O'.AND.IA(IP4).EQ.'M')GOTO7500
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.
     1   IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.
     1   IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.
     1   IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P')GOTO231
      GOTO9000
C
  230 CONTINUE
      IF(IA(IP4).EQ.'0')GOTO7500
      IF(IA(IP4).EQ.'1')GOTO7500
      IF(IA(IP4).EQ.'J'.AND.IA(IP5).EQ.'0')GOTO7600
      IF(IA(IP4).EQ.'J'.AND.IA(IP5).EQ.'1')GOTO7600
      IF(IA(IP4).EQ.'J'.AND.IA(IP5).EQ.'N')GOTO7600
      IF(IA(IP4).EQ.'Y'.AND.IA(IP5).EQ.'0')GOTO7600
      IF(IA(IP4).EQ.'Y'.AND.IA(IP5).EQ.'1')GOTO7600
      IF(IA(IP4).EQ.'Y'.AND.IA(IP5).EQ.'N')GOTO7600
      IF(IA(IP4).EQ.'I'.AND.IA(IP5).EQ.'0'.AND.
     1IA(IP6).EQ.'E')GOTO7700
      IF(IA(IP4).EQ.'I'.AND.IA(IP5).EQ.'0')GOTO7600
      IF(IA(IP4).EQ.'I'.AND.IA(IP5).EQ.'1'.AND.
     1IA(IP6).EQ.'E')GOTO7700
      IF(IA(IP4).EQ.'I'.AND.IA(IP5).EQ.'1')GOTO7600
      IF(IA(IP4).EQ.'I'.AND.IA(IP5).EQ.'N'.AND.
     1IA(IP6).EQ.'E')GOTO7700
      IF(IA(IP4).EQ.'I'.AND.IA(IP5).EQ.'N')GOTO7600
      IF(IA(IP4).EQ.'K'.AND.IA(IP5).EQ.'0'.AND.
     1IA(IP6).EQ.'E')GOTO7700
      IF(IA(IP4).EQ.'K'.AND.IA(IP5).EQ.'0')GOTO7600
      IF(IA(IP4).EQ.'K'.AND.IA(IP5).EQ.'1'.AND.
     1IA(IP6).EQ.'E')GOTO7700
      IF(IA(IP4).EQ.'K'.AND.IA(IP5).EQ.'1')GOTO7600
      IF(IA(IP4).EQ.'K'.AND.IA(IP5).EQ.'N'.AND.
     1IA(IP6).EQ.'E')GOTO7700
      IF(IA(IP4).EQ.'K'.AND.IA(IP5).EQ.'N')GOTO7600
      GOTO9000
  231 CONTINUE
      IF(IA(IP4).EQ.'A')GOTO240
      GOTO9000
C
  240 CONTINUE
      IF(IA(IP5).EQ.'T')GOTO7600
      GOTO9000
C
  250 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.
     1   IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.
     1   IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.
     1   IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.
     1   IA(IP5).EQ.'Z')GOTO7600
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.
     1   IA(IP5).EQ.'A'.AND.IA(IP6).EQ.'Z')GOTO7700
      IF(IA(IP3).EQ.'A'.AND.IA(IP4).EQ.'I')GOTO7500
      IF(IA(IP3).EQ.'A')GOTO7400
      GOTO9000
C
  290 CONTINUE
C
C               ****************************
C               **  STEP 3--              **
C               **  SEARCH FOR FUNCTIONS  **
C               **  STARTING WITH C--     **
C               **       CHEB10           **
C               **       CHEB0            **
C               **       CHEB1            **
C               **       CHEB2            **
C               **       CHEB3            **
C               **       CHEB4            **
C               **       CHEB5            **
C               **       CHEB6            **
C               **       CHEB7            **
C               **       CHEB8            **
C               **       CHEB9            **
C               **       CHSCDF           **
C               **       CHSPDF           **
C               **       CHSPPF           **
C               **       COSH             **
C               **       COS              **
C               **       COTH             **
C               **       COT              **
C               **       CP               **
C               **       CPK              **
C               **       CSCH             **
C               **       CSC              **
C               **  APRIL 1994.           **
C               **       CAUCDF           **
C               **       CAUPDF           **
C               **       CAUPPF           **
C               **       CAUSF            **
C               **  SEPTEMBER 1994.       **
C               **       CHU              **
C               **       COSHINT          **
C               **       COSINT           **
C               **  OCTOBER   1994.       **
C               **       CBESSJR, CBESSJI **
C               **       CBESSYR, CBESSYI **
C               **       CBESSIR, CBESSII **
C               **       CBESSKR, CBESSKI **
C               **       CABS             **
C               **       CCOS, CCOSI      **
C               **       CEXP, CEXPI      **
C               **       CLOG, CLOGI      **
C               **       CSIN, CSINI      **
C               **       CSQRT, CSQRTI    **
C               **  NOVEMBER  1994.       **
C               **       CN               **
C               **  MARCH     1995.       **
C               **       CEIL             **
C               **  APRIL     1995.       **
C               **       COSCDF           **
C               **       COSPDF           **
C               **       COSPPF           **
C               **       CHCDF            **
C               **       CHPDF            **
C               **       CHPPF            **
C               **  JULY      1995.       **
C               **       CHEBT            **
C               **       CHEBU            **
C               **  JULY      1997.       **
C               **       CHM              **
C               **  AUGUST    1997.       **
C               **       CGAMMA           **
C               **       CGAMMAI          **
C               **       CLNGAM           **
C               **       CLNGAMI          **
C               **       CPSI             **
C               **       CPSII            **
C               **       CLNBETA          **
C               **       CLNBETAI         **
C               **       CBETA            **
C               **       CBETAI           **
C               **  SEPTEMBER 1997.       **
C               **       CATLAN           **
C               **  MARCH     1999.       **
C               **       CLAUSN           **
C               **  AUGUST    2006.       **
C               **       CONCDF           **
C               **       CONPDF           **
C               **       CONPPF           **
C               **  MARCH     2007.       **
C               **       CRAMER           **
C               ****************************
C
CCCCC THE FOLLOWING SECTION WAS CHANGED FOR CP AND CPK MAY 1989
      IF(IA(I).EQ.'C')GOTO309
      GOTO390
  309 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'H')GOTO310
      IF(IA(IP1).EQ.'O')GOTO320
      IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'I'.AND.
     1IA(IP4).EQ.'I')GOTO7500
      IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'I')GOTO7400
      IF(IA(IP1).EQ.'P')GOTO330
      IF(IA(IP1).EQ.'N')GOTO7200
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'B'.AND.IA(IP3).EQ.'S')GOTO7400
      IF(IA(IP1).EQ.'C'.AND.IA(IP2).EQ.'O'.AND.IA(IP3).EQ.'S'.AND.
     1IA(IP4).EQ.'I')GOTO7500
      IF(IA(IP1).EQ.'C'.AND.IA(IP2).EQ.'O'.AND.IA(IP3).EQ.'S')GOTO7400
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'I'.AND.IA(IP3).EQ.'L')GOTO7400
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'X'.AND.IA(IP3).EQ.'P'.AND.
     1IA(IP4).EQ.'I')GOTO7500
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'X'.AND.IA(IP3).EQ.'P')GOTO7400
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'G'.AND.
     1IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'M'.AND.IA(IP6).EQ.'I')GOTO7700
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'G'.AND.
     1IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'M')GOTO7600
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'B'.AND.
     1IA(IP4).EQ.'E'.AND.IA(IP5).EQ.'T'.AND.IA(IP6).EQ.'A'.AND.
     1IA(IP7).EQ.'I')GOTO7800
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'B'.AND.
     1IA(IP4).EQ.'E'.AND.IA(IP5).EQ.'T'.AND.IA(IP6).EQ.'A')GOTO7700
      IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'E'.AND.IA(IP3).EQ.'T'.AND.
     1IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'I')GOTO7600
      IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'E'.AND.IA(IP3).EQ.'T'.AND.
     1IA(IP4).EQ.'A')GOTO7500
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'O'.AND.IA(IP3).EQ.'G'.AND.
     1IA(IP4).EQ.'I')GOTO7500
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'O'.AND.IA(IP3).EQ.'G')GOTO7400
      IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'I'.AND.IA(IP3).EQ.'N'.AND.
     1IA(IP4).EQ.'I')GOTO7500
      IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'I'.AND.IA(IP3).EQ.'N')GOTO7400
      IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'Q'.AND.IA(IP3).EQ.'R'.AND.
     1IA(IP4).EQ.'T'.AND.IA(IP5).EQ.'I')GOTO7600
      IF(IA(IP1).EQ.'G'.AND.IA(IP2).EQ.'A'.AND.IA(IP3).EQ.'M'.AND.
     1IA(IP4).EQ.'M'.AND.IA(IP5).EQ.'A'.AND.IA(IP6).EQ.'I')GOTO7700
      IF(IA(IP1).EQ.'G'.AND.IA(IP2).EQ.'A'.AND.IA(IP3).EQ.'M'.AND.
     1IA(IP4).EQ.'M'.AND.IA(IP5).EQ.'A')GOTO7600
      IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'Q'.AND.IA(IP3).EQ.'R'.AND.
     1IA(IP4).EQ.'T')GOTO7500
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'U')GOTO350
      IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'E'.AND.IA(IP3).EQ.'S'.AND.
     1IA(IP4).EQ.'S')GOTO360
      IF(IA(IP1).EQ.'S')GOTO340
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'T'.AND.IA(IP3).EQ.'L'.AND.
     1IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'N')GOTO7600
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'A'.AND.IA(IP3).EQ.'U'.AND.
     1IA(IP4).EQ.'S'.AND.IA(IP5).EQ.'N')GOTO7600
      GOTO9000
C
  310 CONTINUE
      IF(IA(IP2).EQ.'E')GOTO315
      IF(IA(IP2).EQ.'S')GOTO317
      IF(IA(IP2).EQ.'U')GOTO7300
      IF(IA(IP2).EQ.'M')GOTO7300
      IF(IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'F')GOTO7500
      GOTO9000
  315 CONTINUE
      IF(IA(IP3).EQ.'B')GOTO316
      GOTO9000
  316 CONTINUE
      IF(IA(IP4).EQ.'1'.AND.IA(IP5).EQ.'0')GOTO7600
      IF(IA(IP4).EQ.'0')GOTO7500
      IF(IA(IP4).EQ.'1')GOTO7500
      IF(IA(IP4).EQ.'2')GOTO7500
      IF(IA(IP4).EQ.'3')GOTO7500
      IF(IA(IP4).EQ.'4')GOTO7500
      IF(IA(IP4).EQ.'5')GOTO7500
      IF(IA(IP4).EQ.'6')GOTO7500
      IF(IA(IP4).EQ.'7')GOTO7500
      IF(IA(IP4).EQ.'8')GOTO7500
      IF(IA(IP4).EQ.'9')GOTO7500
      IF(IA(IP4).EQ.'T')GOTO7500
      IF(IA(IP4).EQ.'U')GOTO7500
      GOTO9000
  317 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      GOTO9000
C
  320 CONTINUE
      IF(IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'I'.AND.
     1IA(IP5).EQ.'N'.AND.IA(IP6).EQ.'T')GOTO7700
      IF(IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'N'.AND.
     1IA(IP5).EQ.'T')GOTO7600
      IF(IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'H')GOTO7400
      IF(IA(IP2).EQ.'S')GOTO7300
      IF(IA(IP2).EQ.'T'.AND.IA(IP3).EQ.'H')GOTO7400
      IF(IA(IP2).EQ.'T')GOTO7300
      GOTO9000
C
  330 CONTINUE
      IF(IA(IP2).EQ.'K')GOTO7300
      GOTO7200
C
  340 CONTINUE
      IF(IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'H')GOTO7400
      IF(IA(IP2).EQ.'C')GOTO7300
      GOTO9000
C
  350 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'F')GOTO7500
      GOTO9000
C
  360 CONTINUE
      IF(IA(IP5).EQ.'J'.AND.IA(IP6).EQ.'R')GOTO7700
      IF(IA(IP5).EQ.'J'.AND.IA(IP6).EQ.'I')GOTO7700
      IF(IA(IP5).EQ.'Y'.AND.IA(IP6).EQ.'R')GOTO7700
      IF(IA(IP5).EQ.'Y'.AND.IA(IP6).EQ.'I')GOTO7700
      IF(IA(IP5).EQ.'I'.AND.IA(IP6).EQ.'R')GOTO7700
      IF(IA(IP5).EQ.'I'.AND.IA(IP6).EQ.'I')GOTO7700
      IF(IA(IP5).EQ.'K'.AND.IA(IP6).EQ.'R')GOTO7700
      IF(IA(IP5).EQ.'K'.AND.IA(IP6).EQ.'I')GOTO7700
      GOTO9000
C
  390 CONTINUE
C
C               ****************************
C               **  STEP 4--              **
C               **  SEARCH FOR FUNCTIONS  **
C               **  STARTING WITH D--     **
C               **       DECOCT           **
C               **       DIM              **
C               **  APRIL 1994:           **
C               **       DEXCDF           **
C               **       DEXPDF           **
C               **       DEXPPF           **
C               **       DEXSF            **
C               **  SEPTEMBER 1994:       **
C               **       DISCDF           **
C               **       DISPDF           **
C               **       DISPPF           **
C               **       DAWSON           **
C               **       DNFCDF, DNFPPF   **
C               **       DNTCDF, DNTPPF   **
C               **       DIGAMMA          **
C               **  NOVEMBER  1994:       **
C               **       DN               **
C               **  APRIL     1995:       **
C               **       DLGCDF           **
C               **       DLGPDF           **
C               **       DLGPPF           **
C               **  OCTOBER   1995:       **
C               **       DWECDF           **
C               **       DWEPDF           **
C               **       DWEPPF           **
C               **  JANUARY   1996:       **
C               **       DGACDF           **
C               **       DGAPDF           **
C               **       DGAPPF           **
C               **  MARCH     1999:       **
C               **       DEBYE            **
C               **  MAY       2004:       **
C               **       DNFPDF, DNTPDF   **
C               **  JUNE      2006:       **
C               **       DXGCDF           **
C               **       DXGPDF           **
C               **       DXGPPF           **
C               **  NOVEMBER  2006:       **
C               **       DIWCDF           **
C               **       DIWPDF           **
C               **       DIWPPF           **
C               **       DIWHAZ           **
C               **  OCTOBER   2007:       **
C               **       DPUCDF           **
C               **       DPUPDF           **
C               **       DPUPPF           **
C               **  AUGUST    2011:       **
C               **       DISAGREE         **
C               **  OCTOBER   2012:       **
C               **       DPNTLINE         **
C               **  AUGUST    2015:       **
C               **       DECBIN           **
C               ****************************
C
      IF(IA(I).EQ.'D')GOTO409
      GOTO490
  409 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'X')GOTO410
      IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'F')GOTO420
      IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'T')GOTO420
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'C'.AND.
     1IA(IP3).EQ.'O'.AND.IA(IP4).EQ.'C'.AND.
     1IA(IP5).EQ.'T')GOTO7600
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'C'.AND.
     1IA(IP3).EQ.'B'.AND.IA(IP4).EQ.'I'.AND.
     1IA(IP5).EQ.'N')GOTO7600
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'W'.AND.
     1IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'O'.AND.
     1IA(IP5).EQ.'N')GOTO7600
      IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'M')GOTO7300
      IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'G'.AND.
     1IA(IP3).EQ.'A'.AND.IA(IP4).EQ.'M'.AND.
     1IA(IP5).EQ.'M'.AND.IA(IP6).EQ.'A')GOTO7700
      IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'A'.AND.
     1   IA(IP4).EQ.'G'.AND.IA(IP5).EQ.'R'.AND.IA(IP6).EQ.'E'.AND.
     1   IA(IP7).EQ.'E')GOTO7800
      IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'T'.AND.
     1   IA(IP4).EQ.'L'.AND.IA(IP5).EQ.'I'.AND.IA(IP6).EQ.'N'.AND.
     1   IA(IP7).EQ.'E')GOTO7800
      IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'S')GOTO410
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'G')GOTO410
      IF(IA(IP1).EQ.'W'.AND.IA(IP2).EQ.'E')GOTO410
      IF(IA(IP1).EQ.'X'.AND.IA(IP2).EQ.'G')GOTO410
      IF(IA(IP1).EQ.'G'.AND.IA(IP2).EQ.'A')GOTO410
      IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'W')GOTO410
      IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'U')GOTO410
      IF(IA(IP1).EQ.'N')GOTO7200
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'B'.AND.
     1IA(IP3).EQ.'Y'.AND.IA(IP4).EQ.'E')GOTO7500
      GOTO9000
C
  410 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.
     1IA(IP5).EQ.'Z')GOTO7600
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'F')GOTO7500
      GOTO9000
C
  420 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      GOTO9000
C
  490 CONTINUE
C
C               ****************************
C               **  STEP 5--              **
C               **  SEARCH FOR FUNCTIONS  **
C               **  STARTING WITH E--     **
C               **       ERFC             **
C               **       ERF              **
C               **       EXP              **
C               **       EXPLOS           **
C               **  APRIL 1994:           **
C               **       EV1CDF           **
C               **       EV1PDF           **
C               **       EV1PPF           **
C               **       EV2CDF           **
C               **       EV2PDF           **
C               **       EV2PPF           **
C               **       EXPCDF           **
C               **       EXPPDF           **
C               **       EXPPPF           **
C               **       EXPSF            **
C               **  SEPTEMBER 1994:       **
C               **       EXPINT1          **
C               **       EXPINTE          **
C               **       EXPINTN          **
C               **       ELLIPC1          **
C               **       ELLIP1           **
C               **       ELLIPC2          **
C               **       ELLIP2           **
C               **       ELLIP3           **
C               **  OCTOBER 1995:         **
C               **       EWECDF           **
C               **       EWEPDF           **
C               **       EWEPPF           **
C               **  SEPTEMBER 1997:       **
C               **       EN               **
C               **       ETA              **
C               **  APRIL     1998:       **
C               **       EXPHAZ, EXPCHA   **
C               **       EV1HAZ, EV1CHA   **
C               **       EV2HAZ, EV2CHA   **
C               **  MAY       1998:       **
C               **       EWEHAZ, EWECHA   **
C               **  MAY       2003:       **
C               **       ERRCDF           **
C               **       ERRPDF           **
C               **       ERRPPF           **
C               **  MARCH     2005:       **
C               **       EXPAFR           **
C               **  JULY      2010:       **
C               **       EEFCDF           **
C               **       EEFPDF           **
C               **       EEFPPF           **
C               **  MAY       2014:       **
C               **       EXPSURV          **
C               **       EXPISURV         **
C               **       EV1SURV          **
C               **       EV1ISURV         **
C               **       EV2SURV          **
C               **       EV2ISURV         **
C               **       EWESURV          **
C               **       EWEISURV         **
C               ****************************
C
      IF(IA(I).EQ.'E')GOTO509
      GOTO590
  509 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'N')GOTO7200
      IF(IA(IP1).EQ.'T'.AND.IA(IP2).EQ.'A')GOTO7300
      IF(IA(IP1).EQ.'V'.AND.IA(IP2).EQ.'1')GOTO510
      IF(IA(IP1).EQ.'V'.AND.IA(IP2).EQ.'2')GOTO510
      IF(IA(IP1).EQ.'W'.AND.IA(IP2).EQ.'E')GOTO510
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'L'.AND.IA(IP3).EQ.'I'.AND.
     1IA(IP4).EQ.'P')GOTO530
C
      IF(IA(IP1).EQ.'X'.AND.IA(IP2).EQ.'P'.AND.
     1IA(IP3).EQ.'L'.AND.IA(IP4).EQ.'O'.AND.
     1IA(IP5).EQ.'S')GOTO7600
      IF(IA(IP1).EQ.'X'.AND.IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'3')GOTO7400
      IF(IA(IP1).EQ.'X'.AND.IA(IP2).EQ.'P')GOTO520
C
      IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'F'.AND.
     1IA(IP3).EQ.'C')GOTO7400
      IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'F')GOTO7300
      IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'R')GOTO505
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'W')GOTO505
      GOTO9000
C
  505 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      GOTO9000
C
  510 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.
     1IA(IP5).EQ.'Z')GOTO7600
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.
     1IA(IP5).EQ.'A'.AND.IA(IP6).EQ.'Z')GOTO7700
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'U'.AND.
     1IA(IP5).EQ.'R'.AND.IA(IP6).EQ.'V')GOTO7700
      IF(IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'S'.AND.
     1IA(IP5).EQ.'U'.AND.IA(IP6).EQ.'R'.AND.
     1IA(IP7).EQ.'V')GOTO7800
      GOTO9000
C
  520 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.
     1IA(IP5).EQ.'Z')GOTO7600
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.
     1IA(IP5).EQ.'A'.AND.IA(IP6).EQ.'Z')GOTO7700
      IF(IA(IP3).EQ.'A'.AND.IA(IP4).EQ.'F'.AND.
     1IA(IP5).EQ.'R')GOTO7600
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'U'.AND.
     1IA(IP5).EQ.'R'.AND.IA(IP6).EQ.'V')GOTO7700
      IF(IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'S'.AND.
     1IA(IP5).EQ.'U'.AND.IA(IP6).EQ.'R'.AND.
     1IA(IP7).EQ.'V')GOTO7800
      IF(IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'N'.AND.
     1IA(IP5).EQ.'T'.AND.IA(IP6).EQ.'1')GOTO7700
      IF(IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'N'.AND.
     1IA(IP5).EQ.'T'.AND.IA(IP6).EQ.'N')GOTO7700
      IF(IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'N'.AND.
     1IA(IP5).EQ.'T'.AND.IA(IP6).EQ.'E')GOTO7700
      GOTO7300
C
  530 CONTINUE
      IF(IA(IP5).EQ.'1')GOTO7600
      IF(IA(IP5).EQ.'2')GOTO7600
      IF(IA(IP5).EQ.'3')GOTO7600
      IF(IA(IP5).EQ.'C'.AND.IA(IP6).EQ.'1')GOTO7700
      IF(IA(IP5).EQ.'C'.AND.IA(IP6).EQ.'2')GOTO7700
      GOTO9000
C
  590 CONTINUE
C
C               ****************************
C               **  STEP 6--              **
C               **  SEARCH FOR FUNCTIONS  **
C               **  STARTING WITH F--     **
C               **       FCDF             **
C               **       FPDF             **
C               **       FPPF             **
C               **       FRACT            **
C               **       FLCDF (MAY 1990) **
C               **       FLPDF (MAY 1990) **
C               **       FLPPF (MAY 1990) **
C               **  NOVEMBER  1994:       **
C               **       FRESNC, FRESNS   **
C               **       FRESNF, FRESNG   **
C               **  MARCH     1995:       **
C               **       FLOOR            **
C               **  APRIL     1995:       **
C               **       FNRCDF           **
C               **       FNRPDF           **
C               **       FNRPPF           **
C               **  JANUARY   1996:       **
C               **       FCACDF           **
C               **       FCAPDF           **
C               **       FCAPPF           **
C               **  APRIL     1998:       **
C               **       FLHAZ, FLCHA     **
C               **  MAY       2002:       **
C               **       FERMDIRA         **
C               **  NOVEMBER  2003:       **
C               **       FERMDIRA         **
C               **  JUNE      2004:       **
C               **  FERCDF, FERPDF, FERPPF**
C               **  MAY       2014:       **
C               **       FLSURV           **
C               **       FLISURV          **
C               ****************************
C
      IF(IA(I).EQ.'F')GOTO609
      GOTO690
  609 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
CCCCC THE FOLLOWING LINE WAS ADDED MAY 1990
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'O'.AND.IA(IP3).EQ.'O'.AND.
     1IA(IP4).EQ.'R')GOTO7500
      IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'R')GOTO630
      IF(IA(IP1).EQ.'C'.AND.IA(IP2).EQ.'A')GOTO630
      IF(IA(IP1).EQ.'L')GOTO610
      IF(IA(IP1).EQ.'T')GOTO610
      IF(IA(IP1).EQ.'C'.AND.IA(IP2).EQ.'D'.AND.IA(IP3).EQ.'F')GOTO7400
      IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'D'.AND.IA(IP3).EQ.'F')GOTO7400
      IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'F')GOTO7400
      IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'A'.AND.
     1IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'T')GOTO7500
      IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'E'.AND.
     1IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'N')GOTO620
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND.
     1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'I'.AND.
     1IA(IP6).EQ.'R'.AND.IA(IP7).EQ.'A')GOTO7800
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R')GOTO630
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
  610 CONTINUE
      IF(IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP2).EQ.'H'.AND.IA(IP3).EQ.'A'.AND.IA(IP4).EQ.'Z')GOTO7500
      IF(IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.
     1IA(IP5).EQ.'Z')GOTO7600
      IF(IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'U'.AND.IA(IP4).EQ.'R'.AND.
     1IA(IP5).EQ.'V')GOTO7600
      IF(IA(IP2).EQ.'I'.AND.IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'U'.AND.
     1IA(IP5).EQ.'R'.AND.IA(IP6).EQ.'V')GOTO7700
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED NOVEMBER 1994
  620 CONTINUE
      IF(IA(IP5).EQ.'C')GOTO7600
      IF(IA(IP5).EQ.'S')GOTO7600
      IF(IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP5).EQ.'G')GOTO7600
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED APRIL 1995
  630 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED NOVEMBER 1994
  690 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS AUGMENTED      DECEMBER 1993
C               *******************************
C               **  STEP 7--                 **
C               **  SEARCH FOR FUNCTIONS     **
C               **  STARTING WITH G--        **
C               **       GAMMA               **
C               **       GEPCDF (DEC. 1993)  **
C               **       GEPPDF (DEC. 1993)  **
C               **       GEPPPF (DEC. 1993)  **
C               **  APRIL 1994:              **
C               **       GAMCDF              **
C               **       GAMPDF              **
C               **       GAMPPF              **
C               **       GEOCDF              **
C               **       GEOPDF              **
C               **       GEOPPF              **
C               **  SEPTEMBER 1994:          **
C               **       GAMMAI              **
C               **       GAMMAIC             **
C               **       GAMMAR              **
C               **       GAMMAIP             **
C               **  MARCH     1995:          **
C               **       GCD                 **
C               **  APRIL 1995:              **
C               **       GGDCDF              **
C               **       GGDPDF              **
C               **       GGDPPF              **
C               **  OCTOBER 1995:            **
C               **       GEVCDF              **
C               **       GEVPDF              **
C               **       GEVPPF              **
C               **  OCTOBER 1995:            **
C               **       GOMCDF              **
C               **       GOMPDF              **
C               **       GOMPPF              **
C               **  DECEMBER 1995:           **
C               **       GLOCDF              **
C               **       GLOPDF              **
C               **       GLOPPF              **
C               **  FEBRUARY 1996:           **
C               **       GEXCDF              **
C               **       GEXPDF              **
C               **       GEXPPF              **
C               **  APRIL    1998:           **
C               **       GEPHAZ, GEPCHA      **
C               **       GAMHAZ, GAMCHA      **
C               **  MARCH    1999:           **
C               **       GOODST              **
C               **  AUGUST   2001:           **
C               **       GLDCDF, GLDPDF      **
C               **       GLDPPF, GLDCHK      **
C               **       GLDLLM, GLDULM      **
C               **       GLDSGN              **
C               **  NOVEMBER 2001:           **
C               **       GEECDF, GEEPDF      **
C               **       GEEPPF, GEEHAZ      **
C               **       GEECHAZ             **
C               **  JANUARY  2003:           **
C               **       GHCDF, GHPDF, CHPPF **
C               **  JULY     2003:           **
C               **       GTRCDF              **
C               **       GTRPDF              **
C               **       GTRPPF              **
C               **  DECEMBER 2003:           **
C               **       GIGCDF              **
C               **       GIGPDF              **
C               **       GIGPPF              **
C               **  APRIL 2004:              **
C               **   GWACDF, GWAPDF, GWAPPF  **
C               **  JUNE  2004:              **
C               **   GALCDF, GALPDF, GALPPF  **
C               **  SEPTEMBER 2004:          **
C               **   GMCCDF, GMCPDF, GMCPPF  **
C               **  MAY       2005:          **
C               **   GMCCDF, GMCPDF, GMCPPF  **
C               **  FEBRUARY  2006:          **
C               **   GL2CDF, GL2PDF, GL2PPF  **
C               **   GL3CDF, GL3PDF, GL3PPF  **
C               **   GL4CDF, GL4PDF, GL4PPF  **
C               **   GL5CDF, GL5PDF, GL5PPF  **
C               **  JUNE      2006:          **
C               **   GLSCDF, GLSPDF, GLSPPF  **
C               **  JULY      2006:          **
C               **   GETCDF, GETPDF, GETPPF  **
C               **   GNBCDF, GNBPDF, GNBPPF  **
C               **  NOVEMBER  2006:          **
C               **   GLGCDF, GLGPDF, GLGPPF  **
C               **  JANUARY   2007:          **
C               **   GNTCDF, GNTPDF, GNTPPF  **
C               **  FEBRUARY  2007:          **
C               **   GTLCDF, GTLPDF, GTLPPF  **
C               **  MAY   2014:              **
C               **       GAMSURV             **
C               **       GAMISURV            **
C               **       GEESURV             **
C               **       GEEISURV            **
C               **       GEVSURV             **
C               **       GEVISURV            **
C               **       GOMSURV             **
C               **       GOMISURV            **
C               **  SEPTEMBER 2014           **
C               **       GCDF, GPDF, CPPF    **
C               *******************************
C
      IF(IA(I).EQ.'G')GOTO709
      GOTO790
  709 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'M'.AND.
     1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'I'.AND.
     1IA(IP6).EQ.'C')GOTO7700
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'M'.AND.
     1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'I'.AND.
     1IA(IP6).EQ.'P')GOTO7700
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'M'.AND.
     1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'I')GOTO7600
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'M'.AND.
     1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'R')GOTO7600
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'M'.AND.
     1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'A')GOTO7500
      IF(IA(IP1).EQ.'H'.AND.IA(IP2).EQ.'C'.AND.
     1IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP1).EQ.'H'.AND.IA(IP2).EQ.'P'.AND.
     1IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP1).EQ.'H'.AND.IA(IP2).EQ.'P'.AND.
     1IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP1).EQ.'C'.AND.IA(IP2).EQ.'D'.AND.
     1IA(IP3).EQ.'F')GOTO7400
      IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'D'.AND.
     1IA(IP3).EQ.'F')GOTO7400
      IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'P'.AND.
     1IA(IP3).EQ.'F')GOTO7400
C
      IF(IA(IP1).EQ.'C'.AND.IA(IP2).EQ.'D')GOTO7300
C
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'P')GOTO710
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'V')GOTO710
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'X')GOTO710
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'O')GOTO710
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'M')GOTO710
      IF(IA(IP1).EQ.'G'.AND.IA(IP2).EQ.'D')GOTO710
      IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'M')GOTO710
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'O')GOTO710
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'2')GOTO710
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'3')GOTO710
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'4')GOTO710
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'5')GOTO710
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'D')GOTO710
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'S')GOTO710
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'E')GOTO710
      IF(IA(IP1).EQ.'T'.AND.IA(IP2).EQ.'R')GOTO710
      IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'G')GOTO710
      IF(IA(IP1).EQ.'W'.AND.IA(IP2).EQ.'A')GOTO710
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'L')GOTO710
      IF(IA(IP1).EQ.'M'.AND.IA(IP2).EQ.'C')GOTO710
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'T')GOTO710
      IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'B')GOTO710
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'G')GOTO710
      IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'T')GOTO710
      IF(IA(IP1).EQ.'T'.AND.IA(IP2).EQ.'L')GOTO710
      IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'O'.AND.
     1IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'S'.AND.IA(IP5).EQ.'T')
     1GOTO7600
C
      GOTO9000
C
  710 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.
     1   IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.
     1   IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.
     1   IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.
     1   IA(IP5).EQ.'Z')GOTO7600
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.
     1   IA(IP5).EQ.'A'.AND.IA(IP6).EQ.'Z')GOTO7700
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'U'.AND.
     1   IA(IP5).EQ.'R'.AND.IA(IP6).EQ.'V')GOTO7700
      IF(IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'S'.AND.
     1   IA(IP5).EQ.'U'.AND.IA(IP6).EQ.'R'.AND.
     1   IA(IP7).EQ.'V')GOTO7800
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.
     1   IA(IP5).EQ.'K')GOTO7600
      IF(IA(IP3).EQ.'L'.AND.IA(IP4).EQ.'L'.AND.
     1   IA(IP5).EQ.'M')GOTO7600
      IF(IA(IP3).EQ.'U'.AND.IA(IP4).EQ.'L'.AND.
     1   IA(IP5).EQ.'M')GOTO7600
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'G'.AND.
     1   IA(IP5).EQ.'N')GOTO7600
      GOTO9000
C
  790 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED          APRIL    1994
C               *******************************
C               **  STEP 8--                 **
C               **  SEARCH FOR FUNCTIONS     **
C               **  STARTING WITH H--        **
C               **       HFNCDF              **
C               **       HFNPDF              **
C               **       HFNPPF              **
C               **  SEPTEMBER 1994           **
C               **       HYPCDF              **
C               **       HYPPDF              **
C               **       HYPPPF              **
C               **  MARCH     1995           **
C               **       HEAVE               **
C               **  JULY      1995           **
C               **       HERMITE             **
C               **       HERMSGN             **
C               **  OCTOBER   1995           **
C               **       HSECDF              **
C               **       HSEPDF              **
C               **       HSEPPF              **
C               **  OCTOBER   1995           **
C               **       HFCCDF              **
C               **       HFCPDF              **
C               **       HFCPPF              **
C               **  OCTOBER   1995           **
C               **       HFLCDF              **
C               **       HFLPDF              **
C               **       HFLPPF              **
C               **  MARCH     1997           **
C               **       H0                  **
C               **       H1                  **
C               **       HV                  **
C               **  AUGUST    1997           **
C               **       HYPERGEO            **
C               **  MARCH     2004           **
C               **    HERCDF, HERPDF, HERPPF **
C               **  SEPTEMBER 2004           **
C               **    HBOCDF, HBOPDF, HBOPPF **
C               **  MAY       2006           **
C               **    HBOCDF, HBOPDF, HBOPPF **
C               *******************************
C
      IF(IA(I).EQ.'H')GOTO809
      GOTO890
  809 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
      IP8=I+8
C
      IF(IA(IP1).EQ.'F'.AND.IA(IP2).EQ.'N')GOTO810
      IF(IA(IP1).EQ.'F'.AND.IA(IP2).EQ.'C')GOTO810
      IF(IA(IP1).EQ.'F'.AND.IA(IP2).EQ.'L')GOTO810
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R')GOTO810
      IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'O')GOTO810
      IF(IA(IP1).EQ.'Y'.AND.IA(IP2).EQ.'P'.AND.
     1IA(IP3).EQ.'E'.AND.IA(IP4).EQ.'R'.AND.
     1IA(IP5).EQ.'G'.AND.IA(IP6).EQ.'E'.AND.IA(IP7).EQ.'O')GOTO7800
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'R'.AND.
     1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'N'.AND.
     1IA(IP5).EQ.'U'.AND.IA(IP6).EQ.'M'.AND.IA(IP7).EQ.'B')GOTO7800
      IF(IA(IP1).EQ.'Y'.AND.IA(IP2).EQ.'P')GOTO810
      IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'E')GOTO810
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'A'.AND.IA(IP3).EQ.'V'.AND.
     1IA(IP4).EQ.'E')GOTO7500
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND.
     1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'I'.AND.
     1IA(IP5).EQ.'T'.AND.IA(IP6).EQ.'E')GOTO7700
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND.
     1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'S'.AND.
     1IA(IP5).EQ.'G'.AND.IA(IP6).EQ.'N')GOTO7700
      IF(IA(IP1).EQ.'0')GOTO7200
      IF(IA(IP1).EQ.'1')GOTO7200
      IF(IA(IP1).EQ.'V')GOTO7200
      GOTO9000
C
  810 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.
     1   IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.
     1   IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.
     1   IA(IP5).EQ.'F')GOTO7600
      GOTO9000
C
  890 CONTINUE
C
C
C               ****************************
C               **  STEP 9--              **
C               **  SEARCH FOR FUNCTIONS  **
C               **  STARTING WITH I--     **
C               **       INTEGER          **
C               **       INT              **
C               **       IND              **
C               **       IGCDF (MAY 1990) **
C               **       IGPDF (MAY 1990) **
C               **       IGPPF (MAY 1990) **
C               **       IGHAZ (APRIL 1998) **
C               **       IGCHA (APRIL 1998) **
C               **       IGACDF (APRIL 1998) **
C               **       IGAPDF (APRIL 1998) **
C               **       IGAPPF (APRIL 1998) **
C               **       IGAHAZ (APRIL 1998) **
C               **       IGACHA (APRIL 1998) **
C               **  SEPTEMBER 2001        **
C               **       IWECDF           **
C               **       IWEPDF           **
C               **       IWEPPF           **
C               **       IWEHAZ           **
C               **       IWECHAZ          **
C               **  MAY       2003        **
C               **       IBCDF            **
C               **       IBPDF            **
C               **       IBPPF            **
C               **  NOVEMBER  2005        **
C               **       I0INT            **
C               **       I0ML0            **
C               **       I1ML1            **
C               **  MAY       2014        **
C               **       IGSURV           **
C               **       IGISURV          **
C               **       IGASURV          **
C               **       IGAISURV         **
C               **       IWESURV          **
C               **       IWEISURV         **
C               ****************************
C
      IF(IA(I).EQ.'I')GOTO909
      GOTO990
  909 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
CCCCC THE FOLLOWING LINE WAS ADDED MAY 1990
      IF(IA(IP1).EQ.'G'.AND.IA(IP2).EQ.'A')GOTO920
      IF(IA(IP1).EQ.'W'.AND.IA(IP2).EQ.'E')GOTO920
      IF(IA(IP1).EQ.'G')GOTO910
      IF(IA(IP1).EQ.'B')GOTO910
      IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'T'.AND.
     1IA(IP3).EQ.'E'.AND.IA(IP4).EQ.'G'.AND.
     1IA(IP5).EQ.'E'.AND.IA(IP6).EQ.'R')GOTO7700
      IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'T')GOTO7300
      IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'D')GOTO7300
      IF(IA(IP1).EQ.'0'.AND.IA(IP2).EQ.'I'.AND.
     1IA(IP3).EQ.'N'.AND.IA(IP4).EQ.'T')GOTO7500
      IF(IA(IP1).EQ.'0'.AND.IA(IP2).EQ.'M'.AND.
     1IA(IP3).EQ.'L'.AND.IA(IP4).EQ.'0')GOTO7500
      IF(IA(IP1).EQ.'1'.AND.IA(IP2).EQ.'M'.AND.
     1IA(IP3).EQ.'L'.AND.IA(IP4).EQ.'1')GOTO7500
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
  910 CONTINUE
      IF(IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP2).EQ.'H'.AND.IA(IP3).EQ.'A'.AND.IA(IP4).EQ.'Z')GOTO7500
      IF(IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.
     1IA(IP5).EQ.'Z')GOTO7600
      IF(IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'U'.AND.IA(IP4).EQ.'R'.AND.
     1IA(IP5).EQ.'V')GOTO7600
      IF(IA(IP2).EQ.'I'.AND.IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'U'.AND.
     1IA(IP5).EQ.'R'.AND.IA(IP6).EQ.'V')GOTO7700
      GOTO9000
C
  920 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND.
     1IA(IP6).EQ.'Z')GOTO7700
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'U'.AND.IA(IP5).EQ.'R'.AND.
     1IA(IP6).EQ.'V')GOTO7700
      IF(IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'S'.AND.IA(IP5).EQ.'U'.AND.
     1IA(IP6).EQ.'R'.AND.IA(IP7).EQ.'V')GOTO7800
      GOTO9000
C
  990 CONTINUE
C
CCCCC THE JULIA FUNCTION WAS ADDED APRIL 1989
C               ********************************
C               **  STEP 10--                 **
C               **  SEARCH FOR FUNCTIONS      **
C               **  STARTING WITH J--         **
C               **       JULIA                **
C               **  JULY     1995             **
C               **       JACOBIP              **
C               **  SEPTEMBER    2001         **
C               **    JSBCDF, JSBPDF, JSBPPF  **
C               **    JSUCDF, JSUPDF, JSUPPF  **
C               **  NOVEMBER     2005         **
C               **    J0INT                   **
C               ********************************
C
      IF(IA(I).EQ.'J')GOTO1009
      GOTO1090
 1009 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'B')GOTO1020
      IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'U')GOTO1020
      IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'L'.AND.
     1IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'A')GOTO7500
      IF(IA(IP1).EQ.'0'.AND.IA(IP2).EQ.'I'.AND.
     1IA(IP3).EQ.'N'.AND.IA(IP4).EQ.'T')GOTO7500
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'C'.AND.
     1IA(IP3).EQ.'O'.AND.IA(IP4).EQ.'B'.AND.
     1IA(IP5).EQ.'I'.AND.IA(IP6).EQ.'P')
     1GOTO7700
C
 1020 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      GOTO9000
C
 1090 CONTINUE
C
C               ********************************************
C               **  STEP 30--                             **
C               **  SINCE NO LEAD CHARACTER MATCH FOUND,  **
C               **  GO TO END OF SUBROUTINE.              **
C               ********************************************
C
      GOTO9000
C
C               **********************************************
C               **  STEP 70--                               **
C               **  CHECK FOR A TRAILING LEFT PARENTHESIS.  **
C               **********************************************
C
C7100 CONTINUE
CCCCC IF(IA(IP1).EQ.'(')GOTO7110
CCCCC GOTO9000
C7110 CONTINUE
CCCCC IFOUND='YES'
CCCCC NCLF=1
CCCCC GOTO9000
C
 7200 CONTINUE
      IF(IA(IP2).EQ.'(')GOTO7210
      GOTO9000
 7210 CONTINUE
      IFOUND='YES'
      NCLF=2
      GOTO9000
C
 7300 CONTINUE
      IF(IA(IP3).EQ.'(')GOTO7310
      GOTO9000
 7310 CONTINUE
      IFOUND='YES'
      NCLF=3
      GOTO9000
C
 7400 CONTINUE
      IF(IA(IP4).EQ.'(')GOTO7410
      GOTO9000
 7410 CONTINUE
      IFOUND='YES'
      NCLF=4
      GOTO9000
C
 7500 CONTINUE
      IF(IA(IP5).EQ.'(')GOTO7510
      GOTO9000
 7510 CONTINUE
      IFOUND='YES'
      NCLF=5
      GOTO9000
C
 7600 CONTINUE
      IF(IA(IP6).EQ.'(')GOTO7610
      GOTO9000
 7610 CONTINUE
      IFOUND='YES'
      NCLF=6
      GOTO9000
C
 7700 CONTINUE
      IF(IA(IP7).EQ.'(')GOTO7710
      GOTO9000
 7710 CONTINUE
      IFOUND='YES'
      NCLF=7
      GOTO9000
C
 7800 CONTINUE
      IP8=I+8
      IF(IA(IP8).EQ.'(')GOTO7810
      GOTO9000
 7810 CONTINUE
      IFOUND='YES'
      NCLF=8
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGCK.EQ.'OFF')GOTO9990
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9911)
 9911 FORMAT('AT THE END       OF CKLIB1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9912)IFOUND,IERROR
 9912 FORMAT('IFOUND = ',A4,'  IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9913)NCLF
 9913 FORMAT('NCLF = ',I8)
      CALL DPWRST('XXX','BUG ')
 9990 CONTINUE
C
      RETURN
      END
      SUBROUTINE CKLIB2(IA,N,I,IFOUND,NCLF,IBUGCK,IERROR)
C
C     PURPOSE--SEARCH THE 1-CHARACTER PER WORD CHARACTER STRING IN
C              IA(.) STARTING WITH POSITION I AND DETERMINE IF THAT
C              STRING IS A MEMBER OF THE AUGMENTED LIBRARY FUNCTION SET.
C     NOTE--THIS IS PART 2 (SEARCHING FOR LIBRARY FUNCTIONS
C           WITH STARTING CHARACTERS OF K TO Z)
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED         --FEBRUARY  1981.
C     UPDATED         --JUNE      1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JUNE      1987.  WEICDF, WEIPDF, WEIPPF
C     UPDATED         --SEPTEMBER 1987.  LSD (= LEAST SIGNIFICANT DIGIT)
C     UPDATED         --SEPTEMBER 1987.  ROUND
C     UPDATED         --DECEMBER  1988.  LSD(.) RENAMED AS MSD(.)
C     UPDATED         --MAY       1989.  PERDEF(.,.) PERCENT DEFECTIVE
C     UPDATED         --MAY       1990.  RIGCDF/PDF/PPF (REV INV GAUS)
C     UPDATED         --MAY       1990.  WALCDF/PDF/PPF (WALD)
C     UPDATED         --APRIL     1990.  WALCDF/PDF/PPF (WALD)
C     UPDATED         --APRIL     1994.  POI-CDF/PDF/PPF (POISSON)
C     UPDATED         --APRIL     1994.  SEM-CDF/PPF (SEMI-CIRCULAR)
C     UPDATED         --APRIL     1994.  NB-CDF/PDF/PPF
C                                        (NEGATIVE BINOMIAL)
C     UPDATED         --APRIL     1994.  LAM-CDF/PDF/PPF/SF (LAMBDA)
C     UPDATED         --APRIL     1994.  LGN-CDF/PPF (LOG-NORMAL)
C     UPDATED         --APRIL     1994.  LOG-CDF/PPF (LOGISTIC)
C     UPDATED         --APRIL     1994.  PAR-CDF/PPF (PARETO)
C     UPDATED         --APRIL     1994.  UNI-CDF/PDF/PPF/SF (UNIFORM)
C     UPDATED         --SEPTEMBER 1994.  NCBCDF (NON-CENTRAL BETA)
C     UPDATED         --SEPTEMBER 1994.  NCCCDF (NON-CENTRAL CHISQ)
C     UPDATED         --SEPTEMBER 1994.  NCFCDF (NON-CENTRAL F)
C     UPDATED         --SEPTEMBER 1994.  NCTCDF (NON-CENTRAL T)
C     UPDATED         --SEPTEMBER 1994.  LNBETA (LOG BETA)
C     UPDATED         --SEPTEMBER 1994.  TRI-CDF/PDF/PPF (TRIANGULAR)
C     UPDATED         --SEPTEMBER 1994.  ELLIPTIC INTEGRALS (RC, ETC.)
C     UPDATED         --SEPTEMBER 1994.  TRICOMI (TRICOMI'S INCOMPLETE
C                                        GAMMA)
C     UPDATED         --SEPTEMBER 1994.  LOGINT (LOGARITHMIC INTEGRAL)
C     UPDATED         --SEPTEMBER 1994.  SPENCE (SPENCE DILOGARITHM)
C     UPDATED         --SEPTEMBER 1994.  POCH (POCHHAMMER'S
C                                        GENERALIZED SYMBOL)
C     UPDATED         --SEPTEMBER 1994.  POCH (POCHHAMMER'S
C                                        GENERALIZED SYMBOL FROM FIRST
C                                        ORDER)
C     UPDATED         --SEPTEMBER 1994.  SININT, SINHINT
C     UPDATED         --OCTOBER   1994.  VON-CDF/PDF/PPF (VON MISES)
C     UPDATED         --OCTOBER   1994.  BVNCDF (BIVARIATE NORMAL)
C     UPDATED         --NOVEMBER  1994.  PEQ, PEQ1, PLEM. PLEM1
C                                        PEQI, PEQ1I, PLEMI, PLEM1I
C                                        WEIRSTRASS ELLIPTIC FUNCTIONS
C     UPDATED         --NOVEMBER  1994.  SN (JACOBIAN ELLIPTIC FUNC)
C     UPDATED         --MARCH     1995.  STEP (STEP FUNCTION)
C     UPDATED         --APRIL     1995.  PNRCDF, PNRPDF, PNRPPF
C                                        (POWER NORMAL DISTRIBUTIONS)
C     UPDATED         --APRIL     1995.  PLNCDF, PLNPDF, PLNPPF
C                                        (POWER NORMAL DISTRIBUTIONS)
C     UPDATED         --APRIL     1995.  POWCDF, POWPDF, POWPPF
C     UPDATED         --APRIL     1995.  TNRCDF, TNRPDF, TNRPPF
C     UPDATED         --APRIL     1995.  WARCDF, WARPDF, WARPPF
C     UPDATED         --APRIL     1995.  LLGCDF, LLGPDF, LLGPPF
C     UPDATED         --APRIL     1995.  NCTPDF
C     UPDATED         --JULY      1995.  LAGUERRE, LEGENDRE POLYNOMIALS
C     UPDATED         --JULY      1995.  NORMLAIZED LAGUERRE POLYNOMIALS
C     UPDATED         --JULY      1995.  ULTRASPERICAL POLYNOMIALS
C     UPDATED         --OCTOBER   1995.  LGAPDF, LGACDF, LGAPPF
C     UPDATED         --OCTOBER   1995.  PA2PDF, PA2CDF, PA2PPF
C     UPDATED         --OCTOBER   1995.  WCAPDF, WCACDF, WCAPPF
C     UPDATED         --OCTOBER   1995.  TNEPDF, TNECDF, TNEPPF
C     UPDATED         --DECEMBER  1995.  PEXPDF, PEXCDF, PEXPPF
C     UPDATED         --JANUARY   1996.  KAPPDF, KAPCDF, KAPPPF
C     UPDATED         --MAY       1996.  RECPDF, RECCDF, RECPPF
C     UPDATED         --JANUARY   1997.  LOGBETA, LNGAMMA
C     UPDATED         --MARCH     1997.  LAMBDA, LAMBDAP
C     UPDATED         --MARCH     1997.  L0, L1, LV
C     UPDATED         --AUGUST    1997.  PBDV, PBDV1
C     UPDATED         --AUGUST    1997.  PBVV, PBVV1
C     UPDATED         --AUGUST    1997.  PBWA, PBWA1
C     UPDATED         --SEPTEMBER 1997.  PSI, ZETA
C     UPDATED         --APRIL     1998.  NORHAZ, NORCHAZ
C     UPDATED         --APRIL     1998.  PARHAZ, PARCHAZ
C     UPDATED         --APRIL     1998.  WEIHAZ, WEICHAZ
C     UPDATED         --APRIL     1998.  LGNHAZ, LGNCHAZ
C     UPDATED         --APRIL     1998.  LOGHAZ, LOGCHAZ
C     UPDATED         --APRIL     1998.  PLNHAZ, PLNCHAZ
C     UPDATED         --APRIL     1998.  PNRHAZ, PNRCHAZ
C     UPDATED         --APRIL     1998.  RIGHAZ, RIGCHAZ
C     UPDATED         --APRIL     1998.  WALHAZ, WALCHAZ
C     UPDATED         --APRIL     1998.  PEXHAZ, PEXCHAZ
C     UPDATED         --APRIL     1998.  UNIHAZ, UNICHAZ
C     UPDATED         --MARCH     1999.  SRACDF, SRAPDF, SRAPPF
C     UPDATED         --MARCH     1999.  LOBACH
C     UPDATED         --MARCH     1999.  SYNCH1
C     UPDATED         --MARCH     1999.  SYNCH2
C     UPDATED         --MARCH     1999.  STROM
C     UPDATED         --MARCH     1999.  TRAN
C     UPDATED         --MAY       2002.  TSPCDF, TSPPDF, TSPPPF
C     UPDATED         --JANUARY   2003.  SLAPDF
C     UPDATED         --APRIL     2003.  LANCDF, LANPDF, LANPPF
C     UPDATED         --APRIL     2003.  LANDIF, LANXM1, LANXM2
C     UPDATED         --JUNE      2003.  TRACDF, TRAPDF, TRAPPF
C     UPDATED         --NOVEMBER  2003.  SNCDF,  SNPDF,  SNPPF
C     UPDATED         --NOVEMBER  2003.  STCDF,  STPDF,  STPPF
C     UPDATED         --NOVEMBER  2003.  ZIPCDF, ZIPPDF, ZIPPPF
C     UPDATED         --DECEMBER  2003.  MAKCDF, MAKPDF, MAKPPF
C     UPDATED         --MARCH     2004.  LSNCDF, LSNPDF, LSNPPF
C     UPDATED         --MARCH     2004.  LSTCDF, LSTPDF, LSTPPF
C     UPDATED         --MARCH     2004.  POLCDF, POLPDF, POLPPF
C     UPDATED         --APRIL     2004.  YULCDF, YULPDF, YULPPF
C     UPDATED         --JUNE      2004.  SDECDF, SDEPDF, SDEPPF
C     UPDATED         --JUNE      2004.  MAXCDF, MAXPDF, MAXPPF
C     UPDATED         --JUNE      2004.  RAYCDF, RAYPDF, RAYPPF
C     UPDATED         --AUGUST    2004.  MCLCDF, MCLPDF, MCLPPF
C     UPDATED         --MARCH     2005.  LGNAFR, WEIAFR
C     UPDATED         --NOVEMBER  2005.  K0INT
C     UPDATED         --NOVEMBER  2005.  Y0INT
C     UPDATED         --FEBRUARY  2006.  WAKCDF, WAKPDF, WAKPPF
C     UPDATED         --MAY       2006.  ZETCDF, ZETPDF, ZETPPF
C     UPDATED         --MAY       2006.  LBECDF, LBEPDF, LBEPPF
C     UPDATED         --JUNE      2006.  LPOCDF, LPOPDF, LPOPPF
C     UPDATED         --JUNE      2006.  LCTCDF, LCTPDF, LCTPPF
C     UPDATED         --JUNE      2006.  MATCDF, MATPDF, MATPPF
C     UPDATED         --JUNE      2006.  OCCCDF, OCCPDF, OCCPPF
C     UPDATED         --JUNE      2006.  PAPCDF, PAPPDF, PAPPPF
C     UPDATED         --JUNE      2006.  NEYCDF, NEYPDF, NEYPPF
C     UPDATED         --JUNE      2006.  LOSCDF, LOSPDF, LOSPPF
C     UPDATED         --JULY      2006.  PIGCDF, PIGPDF, PIGPPF
C     UPDATED         --JULY      2006.  QBICDF, QBIPDF, QBIPPF
C     UPDATED         --AUGUST    2006.  LKCDF,  LKPDF,  LKPPF
C     UPDATED         --JANUARY   2007.  KATCDF, KATPDF, KATPPF
C     UPDATED         --FEBRUARY  2007.  TOPCDF, TOPPDF, TOPPPF
C     UPDATED         --FEBRUARY  2007.  RGTCDF, RGTPDF, RGTPPF
C     UPDATED         --SEPTEMBER 2007.  SLOCDF, SLOPDF, SLOPPF
C     UPDATED         --SEPTEMBER 2007.  TSSCDF, TSSPDF, TSSPPF
C     UPDATED         --SEPTEMBER 2007.  OGICDF, OGIPDF, OGIPPF
C     UPDATED         --SEPTEMBER 2007.  TSOCDF, TSOPDF, TSOPPF
C     UPDATED         --OCTOBER   2007.  UTSCDF, UTSPDF, UTSPPF
C     UPDATED         --OCTOBER   2007.  KUMCDF, KUMPDF, KUMPPF
C     UPDATED         --DECEMBER  2007.  POWHAZ, POWCHAZ
C     UPDATED         --DECEMBER  2007.  RPOCDF, RPOPDF, RPOPPF
C                                        RPOHAZ, RPOCHAZ
C     UPDATED         --JANUARY   2008.  MMXCDF, MMXPDF, MMXPPF
C     UPDATED         --JANUARY   2008.  MUTCDF, MUTPDF, MUTPPF
C     UPDATED         --FEBRUARY  2008.  LEXCDF, LEXPDF, LEXPPF,
C                                        LEXHAZ, LEXCHAZ
C     UPDATED         --MARCH     2008.  LE3CDF, LE3PDF, LE3PPF,
C                                        LE3HAZ, LE3CHAZ
C     UPDATED         --MARCH     2008.  TNPCDF, TNPPDF, TNPPPF,
C     UPDATED         --MAY       2008.  MIECDF, MIEPDF, MIEPPF,
C     UPDATED         --MAY       2008.  PE3CDF, PE3PDF, PE3PPF,
C     UPDATED         --DECEMBER  2010.  MERGE, MERGE3
C     UPDATED         --DECEMBER  2010.  RELDIF, PERCDIF, PERCERR
C     UPDATED         --JANUARY   2011.  RELERR, RELDIF2, PERCDIF2
C     UPDATED         --JANUARY   2013.  SLOPE
C     UPDATED         --MARCH     2013.  SINCDF, SINPDF, SINPPF
C     UPDATED         --AUGUST    2013.  LININTER
C     UPDATED         --MARCH     2014.  TRIGAMMA
C     UPDATED         --MAY       2014.  LGNSURV, LGNISURV
C     UPDATED         --MAY       2014.  LOGSURV, LOGISURV
C     UPDATED         --MAY       2014.  NORSURV, NORISURV
C     UPDATED         --MAY       2014.  PLNSURV, PLNISURV
C     UPDATED         --MAY       2014.  PNRSURV, PNRISURV
C     UPDATED         --MAY       2014.  RIGSURV, RIGISURV
C     UPDATED         --MAY       2014.  WALSURV, WALISURV
C     UPDATED         --MAY       2014.  WEISURV, WEIISURV
C     UPDATED         --MAY       2014.  UNISURV, UNIISURV
C     UPDATED         --JULY      2014.  NORPPCV
C     UPDATED         --AUGUST    2015.  OCTBIN
C     UPDATED         --AUGUST    2015.  VSUM, VSUM2, VSSQ
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IA
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGCK
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IA(*)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NCLF=-99
C
      NP1=N+1
C
      IF(IBUGCK.EQ.'ON')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('AT THE BEGINNING OF CKLIB2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)N,I,IBUGCK
   52   FORMAT('N,I,IBUGCK = ',I8,I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
        DO55I2=1,N
          WRITE(ICOUT,56)I2,IA(I2)
   56     FORMAT('I2,IA(I2) = ',I8,2X,A4)
          CALL DPWRST('XXX','BUG ')
   55   CONTINUE
      ENDIF
C
      IF(I.GE.NP1)GOTO9000
C
C               **********************************
C               **  STEP 11--                   **
C               **  SEARCH FOR FUNCTIONS        **
C               **  STARTING WITH K--           **
C               **       KAPCDF                 **
C               **       KAPPDF                 **
C               **       KAPPPF                 **
C               **  SEPTEMBER 1997:             **
C               **       KER, KERI, KER1, KERI1 **
C               **  NOVEMBER 2005:              **
C               **       K0INT                  **
C               **  SEPTEMBER 2006:             **
C               **       KATCDF                 **
C               **       KATPDF                 **
C               **       KATPPF                 **
C               **  OCTOBER   2007:             **
C               **       KUMCDF                 **
C               **       KUMPDF                 **
C               **       KUMPPF                 **
C               **********************************
C
      IF(IA(I).EQ.'K')GOTO1109
      GOTO1190
 1109 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND.
     1IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'1')GOTO7500
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND.
     1IA(IP3).EQ.'I')GOTO7400
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND.
     1IA(IP3).EQ.'1')GOTO7400
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R')GOTO7300
      IF(IA(IP1).EQ.'0'.AND.IA(IP2).EQ.'I'.AND.
     1IA(IP3).EQ.'N'.AND.IA(IP4).EQ.'T')GOTO7500
C
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'P')GOTO1120
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'T')GOTO1120
      IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'M')GOTO1120
      GOTO9000
C
 1120 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
C
 1190 CONTINUE
C
C
C               ****************************
C               **  STEP 12--             **
C               **  SEARCH FOR FUNCTIONS  **
C               **  STARTING WITH L--     **
C               **       LOGGAMMA         **
C               **       LOG10            **
C               **       LOGE             **
C               **       LOG2             **
C               **       LOG              **
C               **       LN               **
C               **  ADD: APRIL 1994       **
C               **       LAMCDF           **
C               **       LAMPDF           **
C               **       LAMPPF           **
C               **       LAMSF            **
C               **       LGNCDF           **
C               **       LGNPDF           **
C               **       LGNPPF           **
C               **       LOGCDF           **
C               **       LOGPDF           **
C               **       LOGPPF           **
C               **       LOGSF            **
C               **  ADD: SEPTEMBER 1994   **
C               **       LNBETA           **
C               **       LOGINT           **
C               **  ADD: APRIL 1995       **
C               **       LLGCDF           **
C               **       LLGPDF           **
C               **       LLGPPF           **
C               **  ADD: JULY  1995       **
C               **       LAGUERRE         **
C               **       LAGUERRL         **
C               **       LEGENDRE         **
C               **       LEGP             **
C               **       LEGQ             **
C               **       LNHERMIT         **
C               **  ADD: OCTOBER 1995     **
C               **       LGACDF           **
C               **       LGAPDF           **
C               **       LGAPPF           **
C               **  ADD: JANUARY  1997    **
C               **       LOGBETA          **
C               **       LNGAMMA          **
C               **       LAMBDA           **
C               **  ADD: MARCH    1997    **
C               **       LAMBDA           **
C               **       LAMBDAP          **
C               **       L0, L1, LV       **
C               **  ADD: APRIL 1998       **
C               **       LGNHAZ, LGNCHAZ  **
C               **       LOGHAZ, LLOGHAZ  **
C               **  ADD: MARCH  1999      **
C               **       LOBACH           **
C               **  ADD: SEPTEMBER 2001   **
C               **       LDECDF           **
C               **       LDEPDF           **
C               **       LDEPPF           **
C               **  ADD: APRIL 2003       **
C               **       LANCDF           **
C               **       LANPDF           **
C               **       LANPPF           **
C               **       LANXM1           **
C               **       LANXM2           **
C               **       LANDIF           **
C               **  ADD: MARCH 2004       **
C               **       LSNCDF           **
C               **       LSNPDF           **
C               **       LSNPPF           **
C               **       LSTCDF           **
C               **       LSTPDF           **
C               **       LSTPPF           **
C               **  ADD: MARCH 2005       **
C               **       LGNAFR           **
C               **  ADD: MAY   2006       **
C               **       LBECDF           **
C               **       LBEPDF           **
C               **       LBEPPF           **
C               **  ADD: JUNE  2006       **
C               **       LPOCDF           **
C               **       LPOPDF           **
C               **       LPOPPF           **
C               **       LCTCDF           **
C               **       LCTPDF           **
C               **       LCTPPF           **
C               **       LOSCDF           **
C               **       LOSPDF           **
C               **       LOSPPF           **
C               **  ADD: AUGUST  2006     **
C               **       LKCDF            **
C               **       LKPDF            **
C               **       LKPPF            **
C               **  ADD: JANUARY 2008     **
C               **       LEXCDF           **
C               **       LEXPDF           **
C               **       LEXPPF           **
C               **       LEXHAZ           **
C               **       LEXCHAZ          **
C               **  ADD: MARCH   2008     **
C               **       LE3CDF           **
C               **       LE3PDF           **
C               **       LE3PPF           **
C               **       LE3HAZ           **
C               **       LE3CHAZ          **
C               **  ADD: AUGUST  2013     **
C               **  ADD: MAY     2014     **
C               **       LGNSURV          **
C               **       LGNISURV         **
C               **       LOGSURV          **
C               **       LOGISURV         **
C               ****************************
C
      IF(IA(I).EQ.'L')GOTO1209
      GOTO1290
 1209 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'U'.AND.
     1IA(IP4).EQ.'E'.AND.IA(IP5).EQ.'R'.AND.IA(IP6).EQ.'R'.AND.
     1IA(IP7).EQ.'E')GOTO7800
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'U'.AND.
     1IA(IP4).EQ.'E'.AND.IA(IP5).EQ.'R'.AND.IA(IP6).EQ.'R'.AND.
     1IA(IP7).EQ.'L')GOTO7800
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'E'.AND.
     1IA(IP4).EQ.'N'.AND.IA(IP5).EQ.'D'.AND.IA(IP6).EQ.'R'.AND.
     1IA(IP7).EQ.'E')GOTO7800
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'P')
     1GOTO7400
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'Q')
     1GOTO7400
      IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'H'.AND.IA(IP3).EQ.'E'.AND.
     1IA(IP4).EQ.'R'.AND.IA(IP5).EQ.'M'.AND.IA(IP6).EQ.'I'.AND.
     1IA(IP7).EQ.'T')GOTO7800
      IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'A'.AND.
     1IA(IP4).EQ.'M'.AND.IA(IP5).EQ.'M'.AND.IA(IP6).EQ.'A')GOTO7700
      IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'B'.AND.
     1IA(IP4).EQ.'E'.AND.IA(IP5).EQ.'T'.AND.IA(IP6).EQ.'A')GOTO7700
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'M'.AND.IA(IP3).EQ.'B'.AND.
     1IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'A'.AND.IA(IP6).EQ.'P')GOTO7700
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'M'.AND.IA(IP3).EQ.'B'.AND.
     1IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'A')GOTO7600
      IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'B'.AND.IA(IP3).EQ.'A'.AND.
     1IA(IP4).EQ.'C'.AND.IA(IP5).EQ.'H')
     1GOTO7600
      IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'I'.AND.
     1IA(IP4).EQ.'N'.AND.IA(IP5).EQ.'T'.AND.IA(IP6).EQ.'E'.AND.
     1IA(IP7).EQ.'R')
     1GOTO7800
C
      IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'S')GOTO1230
      IF(IA(IP1).EQ.'N')GOTO1240
      IF(IA(IP1).EQ.'O')GOTO1210
      IF(IA(IP1).EQ.'K')GOTO1250
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'M')GOTO1220
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'N')GOTO1220
      IF(IA(IP1).EQ.'G'.AND.IA(IP2).EQ.'N')GOTO1220
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'G')GOTO1220
      IF(IA(IP1).EQ.'G'.AND.IA(IP2).EQ.'A')GOTO1220
      IF(IA(IP1).EQ.'D'.AND.IA(IP2).EQ.'E')GOTO1230
      IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'N')GOTO1230
      IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'T')GOTO1230
      IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'E')GOTO1230
      IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'O')GOTO1230
      IF(IA(IP1).EQ.'C'.AND.IA(IP2).EQ.'T')GOTO1230
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'X')GOTO1260
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'3')GOTO1260
      IF(IA(IP1).EQ.'0')GOTO7200
      IF(IA(IP1).EQ.'1')GOTO7200
      IF(IA(IP1).EQ.'V')GOTO7200
      GOTO9000
C
 1210 CONTINUE
      IF(IA(IP2).EQ.'G')GOTO1215
      GOTO9000
 1215 CONTINUE
      IF(IA(IP3).EQ.'G'.AND.IA(IP4).EQ.'A'.AND.
     1IA(IP5).EQ.'M'.AND.IA(IP6).EQ.'M'.AND.
     1IA(IP7).EQ.'A')GOTO7800
      IF(IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'N'.AND.
     1IA(IP5).EQ.'T')GOTO7600
      IF(IA(IP3).EQ.'1'.AND.IA(IP4).EQ.'0')GOTO7500
      IF(IA(IP3).EQ.'E')GOTO7400
      IF(IA(IP3).EQ.'2')GOTO7400
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND.
     1IA(IP6).EQ.'Z')GOTO7700
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'U'.AND.IA(IP5).EQ.'R'.AND.
     1IA(IP6).EQ.'V')GOTO7700
      IF(IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'S'.AND.IA(IP5).EQ.'U'.AND.
     1IA(IP6).EQ.'R'.AND.IA(IP7).EQ.'V')GOTO7800
      GOTO7300
C
 1220 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND.
     1IA(IP6).EQ.'Z')GOTO7700
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'U'.AND.IA(IP5).EQ.'R'.AND.
     1IA(IP6).EQ.'V')GOTO7700
      IF(IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'S'.AND.IA(IP5).EQ.'U'.AND.
     1IA(IP6).EQ.'R'.AND.IA(IP7).EQ.'V')GOTO7800
      IF(IA(IP3).EQ.'A'.AND.IA(IP4).EQ.'F'.AND.IA(IP5).EQ.'R')GOTO7600
      IF(IA(IP3).EQ.'X'.AND.IA(IP4).EQ.'M'.AND.IA(IP5).EQ.'1')GOTO7600
      IF(IA(IP3).EQ.'X'.AND.IA(IP4).EQ.'M'.AND.IA(IP5).EQ.'2')GOTO7600
      IF(IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'I'.AND.IA(IP5).EQ.'F')GOTO7600
      GOTO9000
C
 1230 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      GOTO9000
C
 1240 CONTINUE
      IF(IA(IP2).EQ.'B'.AND.IA(IP3).EQ.'E'.AND.IA(IP4).EQ.'T'
     1.AND.IA(IP5).EQ.'A')GOTO7600
      GOTO7200
C
 1250 CONTINUE
      IF(IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'F')GOTO7500
      GOTO9000
C
 1260 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND.
     1IA(IP6).EQ.'Z')GOTO7700
      GOTO9000
C
 1290 CONTINUE
C
C               ****************************
C               **  STEP 13--             **
C               **  SEARCH FOR FUNCTIONS  **
C               **  STARTING WITH M--     **
C               **       MAX              **
C               **       MIN              **
C               **       MODULO           **
C               **       MOD              **
C               **       MSD              **
C               **  DECEMBER  2003        **
C               **       MAKCDF           **
C               **       MAKPDF           **
C               **       MAKPPF           **
C               **       MAKHAZ           **
C               **       MAKCHAZ          **
C               **  JUNE      2004        **
C               **  MAXCDF, MAXPDF, MAXPPF**
C               **  AUGUST    2004        **
C               **  MCLCDF, MCLPDF, MCLPPF**
C               **  JUNE      2006        **
C               **  MATCDF, MATPDF, MATPPF**
C               **  JANUARY   2008        **
C               **  MMXCDF, MMXPDF, MMXPPF**
C               **  MUTCDF, MUTPDF, MUTPPF**
C               **  MUTHAZ, MUTCHAZ       **
C               **  MIECDF, MIEPDF, MIEPPF**
C               **  DECEMBER  2010        **
C               **  MERGE, MERGE3         **
C               ****************************
C
      IF(IA(I).EQ.'M')GOTO1309
      GOTO1390
 1309 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'N')GOTO7300
      IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'D'.AND.
     1IA(IP3).EQ.'U'.AND.IA(IP4).EQ.'L'.AND.
     1IA(IP5).EQ.'O')GOTO7600
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND.
     1IA(IP3).EQ.'G'.AND.IA(IP4).EQ.'E'.AND.
     1IA(IP5).EQ.'3')GOTO7600
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND.
     1IA(IP3).EQ.'G'.AND.IA(IP4).EQ.'E')GOTO7500
      IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'D')GOTO7300
CCCCC THE FOLLOWING LINE WAS ADDED DECEMBER 1988
      IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'D')GOTO7300
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'X')GOTO1330
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'K')GOTO1340
      IF(IA(IP1).EQ.'C'.AND.IA(IP2).EQ.'L')GOTO1330
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'T')GOTO1330
      IF(IA(IP1).EQ.'M'.AND.IA(IP2).EQ.'X')GOTO1330
      IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'T')GOTO1340
      IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'E')GOTO1330
      GOTO9000
C
 1330 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'X')GOTO7300
      GOTO9000
C
 1340 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND.
     1   IA(IP6).EQ.'Z')GOTO7700
      GOTO9000
C
 1390 CONTINUE
C
C               ****************************
C               **  STEP 14--             **
C               **  SEARCH FOR FUNCTIONS  **
C               **  STARTING WITH N--     **
C               **       NORCDF           **
C               **       NORPDF           **
C               **       NORPPF           **
C               **  ADD: APRIL 1994       **
C               **       NBCDF            **
C               **       NBPDF            **
C               **       NBPPF            **
C               **       NORSF            **
C               **  ADD: SEPTEMBER 1994   **
C               **       NCBCDF           **
C               **       NCBPDF           **
C               **       NCBPPF           **
C               **       NCCCDF           **
C               **       NCCPDF           **
C               **       NCCNCP           **
C               **       NCCPPF           **
C               **       NCFCDF           **
C               **       NCFPDF           **
C               **       NCFPDF           **
C               **       NCFPPF           **
C               **       NCTCDF           **
C               **       NCTPDF           **
C               **       NCTPPF           **
C               **  ADD: APRIL     1995   **
C               **       NCTPDF           **
C               **  ADD: JULY      1995   **
C               **       NRMLAG           **
C               **       NRMLEG           **
C               **       NRMLEGP          **
C               **       NRMLEGQ          **
C               **       NRMLAGL          **
C               **  ADD: JANUARY   1996   **
C               **       NCCCDF           **
C               **  ADD: APRIL     1998   **
C               **       NORHAZ, NORCHAZ  **
C               **  ADD: JUNE  2006       **
C               **       NEYCDF           **
C               **       NEYPDF           **
C               **       NEYPPF           **
C               **  ADD: MAY       2014   **
C               **       NORSURV          **
C               **       NORISURV         **
C               **  ADD: JULY      2014   **
C               **       NORPPCV          **
C               ****************************
C
      IF(IA(I).EQ.'N')GOTO1409
      GOTO1490
 1409 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'O')GOTO1410
      IF(IA(IP1).EQ.'B')GOTO1420
      IF(IA(IP1).EQ.'C')GOTO1430
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'Y')GOTO1460
C
      IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'M'.AND.
     1IA(IP3).EQ.'L'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'G')
     1GOTO7600
CCCCC IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'M'.AND.
CCCCC1IA(IP3).EQ.'L'.AND.IA(IP4).EQ.'E'.AND.IA(IP5).EQ.'G'.AND.
CCCCC1IA(IP6).EQ.'P')GOTO7700
CCCCC IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'M'.AND.
CCCCC1IA(IP3).EQ.'L'.AND.IA(IP4).EQ.'E'.AND.IA(IP5).EQ.'G'.AND.
CCCCC1IA(IP6).EQ.'Q')GOTO7700
      IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'M'.AND.
     1IA(IP3).EQ.'L'.AND.IA(IP4).EQ.'E'.AND.IA(IP5).EQ.'G')
     1GOTO7600
      IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'M'.AND.
     1IA(IP3).EQ.'L'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'G'.AND.
     1IA(IP6).EQ.'L')
     1GOTO7700
C
      GOTO9000
C
 1410 CONTINUE
      IF(IA(IP2).EQ.'R')GOTO1415
      GOTO9000
 1415 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND.
     1IA(IP6).EQ.'Z')GOTO7700
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'C'.AND.
     1IA(IP6).EQ.'V')GOTO7700
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'U'.AND.IA(IP5).EQ.'R'.AND.
     1IA(IP6).EQ.'V')GOTO7700
      IF(IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'S'.AND.IA(IP5).EQ.'U'.AND.
     1IA(IP6).EQ.'R'.AND.IA(IP7).EQ.'V')GOTO7800
      IF(IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'X'.AND.IA(IP5).EQ.'C'.AND.
     1IA(IP6).EQ.'D'.AND.IA(IP7).EQ.'F')GOTO7800
      IF(IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'X'.AND.IA(IP5).EQ.'P'.AND.
     1IA(IP6).EQ.'D'.AND.IA(IP7).EQ.'F')GOTO7800
      IF(IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'X'.AND.IA(IP5).EQ.'P'.AND.
     1IA(IP6).EQ.'P'.AND.IA(IP7).EQ.'F')GOTO7800
      GOTO9000
C
 1420 CONTINUE
      IF(IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'F')GOTO7500
      GOTO9000
C
 1430 CONTINUE
      IF(IA(IP2).EQ.'B')GOTO1460
      IF(IA(IP2).EQ.'C')GOTO1470
      IF(IA(IP2).EQ.'F')GOTO1460
      IF(IA(IP2).EQ.'T')GOTO1480
      GOTO9000
C
 1460 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      GOTO9000
C
 1470 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'N'.AND.IA(IP4).EQ.'C'.AND.IA(IP5).EQ.'P')GOTO7600
      GOTO9000
C
 1480 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      GOTO9000
C
 1490 CONTINUE
C
C               ********************************
C               **  STEP 15--                 **
C               **  SEARCH FOR FUNCTIONS      **
C               **  STARTING WITH O--         **
C               **    OCTAL                   **
C               **    OCTDEC                  **
C               **    OCCCDF, OCCPDF, OCCPPF  **
C               **    OGICDF, OGIPDF, OGIPPF  **
C               **  AUGUST 2015               **
C               **    OCTBIN, OCTALBIN        **
C               ********************************
C
      IF(IA(I).EQ.'O')GOTO1509
      GOTO1590
 1509 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'C'.AND.IA(IP2).EQ.'C')GOTO1580
      IF(IA(IP1).EQ.'G'.AND.IA(IP2).EQ.'I')GOTO1580
      IF(IA(IP1).EQ.'C')GOTO1510
      GOTO9000
C
 1510 CONTINUE
      IF(IA(IP2).EQ.'T'.AND.IA(IP3).EQ.'A'.AND.IA(IP4).EQ.'L'.AND.
     1IA(IP5).EQ.'B'.AND.IA(IP6).EQ.'I'.AND.IA(IP7).EQ.'N')GOTO7800
      IF(IA(IP2).EQ.'T'.AND.IA(IP3).EQ.'A'.AND.IA(IP4).EQ.'L')GOTO7500
      IF(IA(IP2).EQ.'T'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'E'.AND.
     1IA(IP5).EQ.'C')GOTO7600
      IF(IA(IP2).EQ.'T'.AND.IA(IP3).EQ.'B'.AND.IA(IP4).EQ.'I'.AND.
     1IA(IP5).EQ.'N')GOTO7600
C
 1580 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      GOTO9000
C
      GOTO9000
C
 1590 CONTINUE
C
C               ****************************
C               **  STEP 16--             **
C               **  SEARCH FOR FUNCTIONS  **
C               **  STARTING WITH P--     **
C               **       PERDEF           **
C               **  ADD: APRIL 1994       **
C               **       POICDF           **
C               **       POIPDF           **
C               **       POIPPF           **
C               **       PARCDF           **
C               **       PARPDF           **
C               **       PARPPF           **
C               **  ADD: SEPTEMBER 1994   **
C               **       POCH             **
C               **       POCH1            **
C               **  ADD: NOVEMBER  1994   **
C               **       PEQ, PEQ1        **
C               **       PLEM, PLEM1      **
C               **       PEQI, PEQ1I      **
C               **       PLEMI, PLEM1I    **
C               **  ADD: APRIL     1995   **
C               **       PNRCDF           **
C               **       PNRPDF           **
C               **       PNRPPF           **
C               **  ADD: APRIL     1995   **
C               **       PLNCDF           **
C               **       PLNPDF           **
C               **       PLNPPF           **
C               **  ADD: APRIL     1995   **
C               **       POWCDF           **
C               **       POWPDF           **
C               **       POWPPF           **
C               **  ADD: OCTOBER 1995     **
C               **       PA2CDF           **
C               **       PA2PDF           **
C               **       PA2PPF           **
C               **  ADD: DECEMBER 1995    **
C               **       PEXCDF           **
C               **       PEXPDF           **
C               **       PEXPPF           **
C               **  ADD: AUGUST   1997    **
C               **       PBDV             **
C               **       PBDV1            **
C               **       PBVV             **
C               **       PBVV1            **
C               **       PBWA             **
C               **       PBWA1            **
C               **  ADD: SEPTEMBER 1997   **
C               **       PSI              **
C               **  ADD: OCTOBER   1997   **
C               **       PSIFN            **
C               **  ADD: APRIL     1998   **
C               **       PARHAZ, PARCHAZ  **
C               **       PNRHAZ, PNRCHAZ  **
C               **       PLNHAZ, PLNCHAZ  **
C               **       PEXHAZ, PEXCHAZ  **
C               **  ADD: MARCH    2004    **
C               **       POLCDF           **
C               **       POLPDF           **
C               **       POLPPF           **
C               **  ADD: JUNE     2006    **
C               **       PAPCDF           **
C               **       PAPPDF           **
C               **       PAPPPF           **
C               **  ADD: JULY     2006    **
C               **       PIGCDF           **
C               **       PIGPDF           **
C               **       PIGPPF           **
C               **  ADD: DECEMBER  2007   **
C               **       POWHAZ           **
C               **       POWCHAZ          **
C               **  ADD: MAY      2008    **
C               **       PE3CDF           **
C               **       PE3PDF           **
C               **       PE3PPF           **
C               **  ADD: DECEMBER 2010    **
C               **       PERCDIF          **
C               **       PERCERR          **
C               **  ADD: JANUARY  2011    **
C               **       PERCDIF2         **
C               **  ADD: MAY       2014   **
C               **       PLNSURV          **
C               **       PLNISURV         **
C               **       PNRSURV          **
C               **       PNRISURV         **
C               ****************************
C
CCCCC THE ENTIRE P SECTION IS NEW MAY 1989
      IF(IA(I).EQ.'P')GOTO1609
      GOTO1690
 1609 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'D'.AND.
     1IA(IP3).EQ.'V'.AND.IA(IP4).EQ.'1')GOTO7500
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND.
     1IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'I'.AND.IA(IP6).EQ.'F'.AND.
     1IA(IP7).EQ.'2')GOTO7800
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND.
     1IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.
     1IA(IP5).EQ.'I'.AND.IA(IP6).EQ.'F')GOTO7700
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND.
     1IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'E'.AND.
     1IA(IP5).EQ.'R'.AND.IA(IP6).EQ.'R')GOTO7700
      IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'D'.AND.
     1IA(IP3).EQ.'V')GOTO7400
      IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'V'.AND.
     1IA(IP3).EQ.'V'.AND.IA(IP4).EQ.'1')GOTO7500
      IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'V'.AND.
     1IA(IP3).EQ.'V')GOTO7400
      IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'W'.AND.
     1IA(IP3).EQ.'A'.AND.IA(IP4).EQ.'1')GOTO7500
      IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'W'.AND.
     1IA(IP3).EQ.'A')GOTO7400
      IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'I'.AND.IA(IP3).EQ.'F'.AND.
     1IA(IP4).EQ.'N')GOTO7500
      IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'I')GOTO7300
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'Q'.AND.
     1IA(IP3).EQ.'1'.AND.IA(IP4).EQ.'I')GOTO7500
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'Q'.AND.
     1IA(IP3).EQ.'1')GOTO7400
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'Q'.AND.
     1IA(IP3).EQ.'I')GOTO7400
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'Q')GOTO7300
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'E'.AND.IA(IP3).EQ.'M'.AND.
     1IA(IP4).EQ.'1'.AND.IA(IP5).EQ.'I')GOTO7600
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'E'.AND.
     1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'1')GOTO7500
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'E'.AND.
     1IA(IP3).EQ.'M'.AND.IA(IP4).EQ.'I')GOTO7500
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'E'.AND.
     1IA(IP3).EQ.'M')GOTO7400
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'.AND.
     1IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'E'.AND.
     1IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'I')GOTO1610
CCCCC IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'W')GOTO1610
      IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'W')GOTO1620
      IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'L')GOTO1610
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'P')GOTO1610
      IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'G')GOTO1610
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'3')GOTO1610
      IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'H'.AND.
     1IA(IP4).EQ.'1')GOTO7500
      IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'H')GOTO7400
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'R')GOTO1620
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'2')GOTO1620
      IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'R')GOTO1620
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'N')GOTO1620
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'X')GOTO1620
      GOTO9000
C
 1610 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      GOTO9000
C
 1620 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND.
     1IA(IP6).EQ.'Z')GOTO7700
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'U'.AND.IA(IP5).EQ.'R'.AND.
     1IA(IP6).EQ.'V')GOTO7700
      IF(IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'S'.AND.IA(IP5).EQ.'U'.AND.
     1IA(IP6).EQ.'R'.AND.IA(IP7).EQ.'V')GOTO7800
      GOTO9000
C
 1690 CONTINUE
C
C               *******************************
C               **  STEP 17--                **
C               **  SEARCH FOR FUNCTIONS     **
C               **  STARTING WITH Q--        **
C               **  ADD: JULY  2006          **
C               **   QBICDF, QBIPDF, QBIPPF  **
C               *******************************
C
      IF(IA(I).EQ.'Q')GOTO1709
      GOTO1790
 1709 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'B'.AND.IA(IP2).EQ.'I')GOTO1710
      GOTO9000
C
 1710 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      GOTO9000
C
 1790 CONTINUE
C
C               ****************************
C               **  STEP 18--             **
C               **  SEARCH FOR FUNCTIONS  **
C               **  STARTING WITH R--     **
C               **       ROUND            **
C               **       RIGCDF (MAY 1990)**
C               **       RIGPDF (MAY 1990)**
C               **       RIGPPF (MAY 1990)**
C               **  SEPTEMBER 1994        **
C               **       RC, RD, RF, RJ   **
C               **  MAY 1996              **
C               **  RECCDF, RECPDF,RECPPF **
C               **  APRIL 1998            **
C               **       RIGHAZ, RIGCHAZ  **
C               **  JUNE 2004             **
C               **  RAYCDF, RAYPDF,RAYPPF **
C               **  FEBRUARY 2007         **
C               **  RGTCDF, RGTPDF,RGTPPF **
C               **  DECEMBER 2007         **
C               **  RPOCDF, RPOPDF,RPOPPF **
C               **  DECEMBER 2010         **
C               **     RELDIF             **
C               **  JANUARY  2011         **
C               **     RELERR, RELDIF2    **
C               **  MAY 2014              **
C               **       RIGSURV          **
C               **       RIGISURV         **
C               ****************************
C
      IF(IA(I).EQ.'R')GOTO1809
      GOTO1890
 1809 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'O')GOTO1810
      IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'G')GOTO1820
      IF(IA(IP1).EQ.'C')GOTO7200
      IF(IA(IP1).EQ.'D')GOTO7200
      IF(IA(IP1).EQ.'F')GOTO7200
      IF(IA(IP1).EQ.'J')GOTO7200
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'L'.AND.IA(IP3).EQ.'D'.AND.
     1   IA(IP4).EQ.'I'.AND.IA(IP5).EQ.'F'.AND.
     1   IA(IP6).EQ.'2')GOTO7700
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'L'.AND.IA(IP3).EQ.'D'.AND.
     1   IA(IP4).EQ.'I'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'L'.AND.IA(IP3).EQ.'E'.AND.
     1   IA(IP4).EQ.'R'.AND.IA(IP5).EQ.'R')GOTO7600
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'C')GOTO1820
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'Y')GOTO1820
      IF(IA(IP1).EQ.'G'.AND.IA(IP2).EQ.'T')GOTO1820
      IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'O')GOTO1820
CCCCC THE FOLLOWING LINE WAS ADDED MAY 1990
      GOTO9000
C
 1810 CONTINUE
      IF(IA(IP2).EQ.'U'.AND.IA(IP3).EQ.'N'.AND.IA(IP4).EQ.'D')GOTO7500
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
 1820 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND.
     1IA(IP6).EQ.'Z')GOTO7700
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'U'.AND.IA(IP5).EQ.'R'.AND.
     1IA(IP6).EQ.'V')GOTO7700
      IF(IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'S'.AND.IA(IP5).EQ.'U'.AND.
     1IA(IP6).EQ.'R'.AND.IA(IP7).EQ.'V')GOTO7800
      GOTO9000
C
 1890 CONTINUE
C
C               ****************************
C               **  STEP 19--             **
C               **  SEARCH FOR FUNCTIONS  **
C               **  STARTING WITH S--     **
C               **       SECH             **
C               **       SEC              **
C               **       SIGN             **
C               **       SINH             **
C               **       SIN              **
C               **       SQRT             **
C               **  ADD: APRIL 1994       **
C               **       SEMCDF           **
C               **       SEMPDF           **
C               **       SEMPPF           **
C               **  SEPTEMBER 1994        **
C               **       SPENCE           **
C               **       SININT, SINHINT  **
C               **  NOVEMBER  1994        **
C               **       SN               **
C               **  MARCH     1995        **
C               **       STEP             **
C               **  JULY      1995        **
C               **       SPHRHRMR         **
C               **       SPHRHRMC         **
C               **  MARCH     1999        **
C               **       SRACDF           **
C               **       SRAPDF           **
C               **       SRAPPF           **
C               **       STROM            **
C               **       SYNCH1           **
C               **       SYNCH2           **
C               **  JANUARY   2003        **
C               **       SLACDF           **
C               **       SLAPDF           **
C               **  NOVEMBER  2003        **
C               **       SNCDF            **
C               **       SNPDF            **
C               **       SNPPF            **
C               **       STCDF            **
C               **       STPDF            **
C               **       STPPF            **
C               **  JUNE      2004        **
C               **       SDECDF           **
C               **       SDEPDF           **
C               **       SDEPPF           **
C               **  SEPTEMBER 2007        **
C               **       SLOCDF           **
C               **       SLOPDF           **
C               **       SLOPPF           **
C               **  JANUARY   2013        **
C               **       SLOPE            **
C               **  MARCH     2013        **
C               **       SINCDF           **
C               **       SINPDF           **
C               **       SINPPF           **
C               ****************************
C
      IF(IA(I).EQ.'S')GOTO1909
      GOTO1990
 1909 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'E')GOTO1910
      IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'N')GOTO1940
      IF(IA(IP1).EQ.'I')GOTO1920
      IF(IA(IP1).EQ.'Q')GOTO1930
      IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'A')GOTO1945
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'A')GOTO1945
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'O'.AND.IA(IP3).EQ.'P'.AND.
     1IA(IP4).EQ.'E')GOTO7500
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'O')GOTO1940
      IF(IA(IP1).EQ.'D'.AND.IA(IP2).EQ.'E')GOTO1940
      IF(IA(IP1).EQ.'Y'.AND.IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'C'.AND.
     1IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'1')GOTO7600
      IF(IA(IP1).EQ.'Y'.AND.IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'C'.AND.
     1IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'2')GOTO7600
      IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'E'.AND.IA(IP3).EQ.'N'.AND.
     1IA(IP4).EQ.'C'.AND.IA(IP5).EQ.'E')GOTO7600
      IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'H'.AND.IA(IP3).EQ.'R'.AND.
     1IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'R'.AND.IA(IP6).EQ.'M'.AND.
     1IA(IP7).EQ.'R')GOTO7800
      IF(IA(IP1).EQ.'P'.AND.IA(IP2).EQ.'H'.AND.IA(IP3).EQ.'R'.AND.
     1IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'R'.AND.IA(IP6).EQ.'M'.AND.
     1IA(IP7).EQ.'C')GOTO7800
      IF(IA(IP1).EQ.'T'.AND.IA(IP2).EQ.'E'.AND.IA(IP3).EQ.'P')GOTO7400
      IF(IA(IP1).EQ.'T'.AND.IA(IP2).EQ.'R'.AND.IA(IP3).EQ.'O'.AND.
     1IA(IP4).EQ.'M')GOTO7500
      IF(IA(IP1).EQ.'N')GOTO1950
      IF(IA(IP1).EQ.'T')GOTO1950
      GOTO9000
C
 1910 CONTINUE
      IF(IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'H')GOTO7400
      IF(IA(IP2).EQ.'C')GOTO7300
      IF(IA(IP2).EQ.'M')GOTO1940
      GOTO9000
C
 1920 CONTINUE
      IF(IA(IP2).EQ.'G'.AND.IA(IP3).EQ.'N')GOTO7400
      GOTO9000
C
 1930 CONTINUE
      IF(IA(IP2).EQ.'R'.AND.IA(IP3).EQ.'T')GOTO7400
      GOTO9000
C
 1940 CONTINUE
      IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'I'.AND.
     1IA(IP5).EQ.'N'.AND.IA(IP6).EQ.'T')GOTO7700
      IF(IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'N'.AND.IA(IP5).EQ.'T')GOTO7600
      IF(IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'H')GOTO7400
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      GOTO7300
      GOTO9000
C
 1945 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      GOTO9000
C
 1950 CONTINUE
      IF(IA(IP2).EQ.'C'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'D'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP1).EQ.'N')GOTO7200
      GOTO7200
C
 1990 CONTINUE
C
C               ****************************
C               **  STEP X.20--           **
C               **  SEARCH FOR FUNCTIONS  **
C               **  STARTING WITH T--     **
C               **       TANH             **
C               **       TAN              **
C               **       TCDF             **
C               **       TPDF             **
C               **       TPPF             **
C               **  SEPTEMBER 1994:       **
C               **       TRICDF           **
C               **       TRIPDF           **
C               **       TRIPPF           **
C               **       TRICOMI          **
C               **  APRIL     1995:       **
C               **       TNRCDF           **
C               **       TNRPDF           **
C               **       TNRPPF           **
C               **  OCTOBER   1995:       **
C               **       TNECDF           **
C               **       TNEPDF           **
C               **       TNEPPF           **
C               **  MARCH     1999:       **
C               **       TRAN             **
C               **  MAY       2002:       **
C               **       TSPCDF           **
C               **       TSPPDF           **
C               **       TSPPPF           **
C               **  JUNE      2003:       **
C               **       TRACDF           **
C               **       TRAPDF           **
C               **       TRAPPF           **
C               **  FEBRUARY  2007:       **
C               **       TOPCDF           **
C               **       TOPPDF           **
C               **       TOPPPF           **
C               **  SEPTEMBER 2007:       **
C               **       TSSCDF           **
C               **       TSSPDF           **
C               **       TSSPPF           **
C               **       TSOCDF           **
C               **       TSOPDF           **
C               **       TSOPPF           **
C               **  MARCH     2008:       **
C               **       TNECDF           **
C               **       TNEPDF           **
C               **       TNEPPF           **
C               **  MARCH     2014:       **
C               **       TRIGAMMA         **
C               ****************************
C
      IF(IA(I).EQ.'T')GOTO2009
      GOTO2090
 2009 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'A')GOTO2010
      IF(IA(IP1).EQ.'C')GOTO2020
      IF(IA(IP1).EQ.'P')GOTO2030
      IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'A'.AND.
     1IA(IP3).EQ.'N')GOTO7400
      IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'A')GOTO2040
      IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'I')GOTO2040
      IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'R')GOTO2050
      IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'E')GOTO2050
      IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'P')GOTO2040
      IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'P')GOTO2040
      IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'S')GOTO2040
      IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'O')GOTO2040
      IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'P')GOTO2050
      GOTO9000
C
 2010 CONTINUE
      IF(IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'H')GOTO7400
      IF(IA(IP2).EQ.'N')GOTO7300
      GOTO9000
C
 2020 CONTINUE
      IF(IA(IP2).EQ.'D'.AND.IA(IP3).EQ.'F')GOTO7400
      GOTO9000
C
 2030 CONTINUE
      IF(IA(IP2).EQ.'D'.AND.IA(IP3).EQ.'F')GOTO7400
      IF(IA(IP2).EQ.'P'.AND.IA(IP3).EQ.'F')GOTO7400
      GOTO9000
C
 2040 CONTINUE
C
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'O'.AND.IA(IP5).EQ.'M'.AND.
     1IA(IP6).EQ.'I')GOTO7700
      IF(IA(IP3).EQ.'G'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'M'.AND.
     1IA(IP6).EQ.'M'.AND.IA(IP7).EQ.'A')GOTO7800
C
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP2).EQ.'A')GOTO9000
      GOTO9000
C
 2050 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      GOTO9000
C
 2090 CONTINUE
C
CCCCC THIS SECTION ADDED APRIL, 1994.
C               ****************************
C               **  STEP 21--             **
C               **  SEARCH FOR FUNCTIONS  **
C               **  STARTING WITH U--     **
C               **       UNICDF           **
C               **       UNIPDF           **
C               **       UNIPPF           **
C               **       UNISF            **
C               **  JULY    1995          **
C               **       ULTRASPH         **
C               **  STARTING WITH U--     **
C               **       UNIHAZ, UNICHAZ  **
C               **  STARTING WITH U--     **
C               **       UTSCDF           **
C               **       UTSPDF           **
C               **       UTSPPF           **
C               ****************************
      IF(IA(I).EQ.'U')GOTO2109
      GOTO2190
 2109 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'I')GOTO2110
      IF(IA(IP1).EQ.'T'.AND.IA(IP2).EQ.'S')GOTO2110
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'T'.AND.IA(IP3).EQ.'R'.AND.
     1IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'S'.AND.IA(IP6).EQ.'P'.AND.
     1IA(IP7).EQ.'H')GOTO7800
      GOTO9000
C
 2110 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'F')GOTO7500
      IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND.
     1IA(IP6).EQ.'Z')GOTO7700
      GOTO9000
C
 2190 CONTINUE
C
CCCCC THIS SECTION ADDED OCTOBER, 1994.
C               ****************************
C               **  STEP 22--             **
C               **  SEARCH FOR FUNCTIONS  **
C               **  STARTING WITH V--     **
C               **       VONCDF           **
C               **       VONPDF           **
C               **       VONPPF           **
C               **       VSUM, VSUM2, VSSQ**
C               ****************************
      IF(IA(I).EQ.'V')GOTO2209
      GOTO2290
 2209 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'N')GOTO2210
      IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'U'.AND.IA(IP3).EQ.'M'.AND.
     1IA(IP4).EQ.'2')GOTO7500
      IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'U'.AND.IA(IP3).EQ.'M')GOTO7400
      IF(IA(IP1).EQ.'S'.AND.IA(IP2).EQ.'S'.AND.IA(IP3).EQ.'Q')GOTO7400
      GOTO9000
C
 2210 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      GOTO9000
C
 2290 CONTINUE
C
C
C               ****************************
C               **  STEP 23--             **
C               **  SEARCH FOR FUNCTIONS  **
C               **  STARTING WITH W--     **
C               **       WEICDF           **
C               **       WEIPDF           **
C               **       WEIPPF           **
C               **       WALCDF (MAY 1990)**
C               **       WALPDF (MAY 1990)**
C               **       WALPPF (MAY 1990)**
C               **  APRIL 1995            **
C               **       WARCDF           **
C               **       WARPDF           **
C               **       WARPPF           **
C               **  OCTOBER 1995          **
C               **       WCACDF           **
C               **       WCAPDF           **
C               **       WCAPPF           **
C               **  APRIL   1998          **
C               **       WEIHAZ, WEICHAZ  **
C               **  MARCH   2005          **
C               **       WEIAFR           **
C               **  FEBRUARY  2006        **
C               **  WAKCDF, WAKPDF, WAKPPF**
C               **  MAY     2014          **
C               **       WEISURV          **
C               **       WEIISURV         **
C               **       WALSURV          **
C               **       WALISURV         **
C               ****************************
C
      IF(IA(I).EQ.'W')GOTO2309
      GOTO2390
 2309 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'I')GOTO2310
CCCCC THE FOLLOWING LINE WAS ADDED MAY 1990
      IF(IA(IP1).EQ.'A')GOTO2320
      IF(IA(IP1).EQ.'C'.AND.IA(IP2).EQ.'A')GOTO2310
      GOTO9000
C
 2310 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND.
     1IA(IP6).EQ.'Z')GOTO7700
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'U'.AND.IA(IP5).EQ.'R'.AND.
     1IA(IP6).EQ.'V')GOTO7700
      IF(IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'S'.AND.IA(IP5).EQ.'U'.AND.
     1IA(IP6).EQ.'R'.AND.IA(IP7).EQ.'V')GOTO7800
      IF(IA(IP3).EQ.'A'.AND.IA(IP4).EQ.'F'.AND.IA(IP5).EQ.'R')GOTO7600
      GOTO9000
C
CCCCC THE FOLLOWING 8 LINES WERE ADDED MAY 1990
 2320 CONTINUE
      IF(IA(IP2).EQ.'L')GOTO2328
      IF(IA(IP2).EQ.'R')GOTO2325
      IF(IA(IP2).EQ.'K')GOTO2325
      GOTO9000
 2325 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      GOTO9000
 2328 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'H'.AND.IA(IP4).EQ.'A'.AND.IA(IP5).EQ.'Z')GOTO7600
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'H'.AND.IA(IP5).EQ.'A'.AND.
     1IA(IP6).EQ.'Z')GOTO7700
      IF(IA(IP3).EQ.'S'.AND.IA(IP4).EQ.'U'.AND.IA(IP5).EQ.'R'.AND.
     1IA(IP6).EQ.'V')GOTO7700
      IF(IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'S'.AND.IA(IP5).EQ.'U'.AND.
     1IA(IP6).EQ.'R'.AND.IA(IP7).EQ.'V')GOTO7800
      GOTO9000
C
 2390 CONTINUE
C
CCCCC THIS SECTION ADDED APRIL 2004
C               ******************************
C               **  STEP 24--               **
C               **  SEARCH FOR FUNCTIONS    **
C               **  STARTING WITH Y--       **
C               **  YULCDF, YULPDF, YULPPF  **
C               **  NOVEMBER 2005:          **
C               **  Y0INT                   **
C               ******************************
      IF(IA(I).EQ.'Y')GOTO2409
      GOTO2490
 2409 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'U'.AND.IA(IP2).EQ.'L')GOTO2420
      IF(IA(IP1).EQ.'0'.AND.IA(IP2).EQ.'I'.AND.
     1IA(IP3).EQ.'N'.AND.IA(IP4).EQ.'T')GOTO7500
      GOTO9000
C
 2420 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
C
 2490 CONTINUE
C
CCCCC THIS SECTION ADDED SEPTEMBER, 1997.
C               ****************************
C               **  STEP 25--             **
C               **  SEARCH FOR FUNCTIONS  **
C               **  STARTING WITH Z--     **
C               **       ZETA             **
C               ****************************
      IF(IA(I).EQ.'Z')GOTO2509
      GOTO2590
 2509 CONTINUE
C
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
C
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'T'.AND.IA(IP3).EQ.'A')GOTO7400
      IF(IA(IP1).EQ.'I'.AND.IA(IP2).EQ.'P')GOTO2520
      IF(IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'T')GOTO2520
      GOTO9000
 2520 CONTINUE
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'D'.AND.IA(IP5).EQ.'F')GOTO7600
      IF(IA(IP3).EQ.'P'.AND.IA(IP4).EQ.'P'.AND.IA(IP5).EQ.'F')GOTO7600
C
 2590 CONTINUE
C
C               ********************************************
C               **  STEP 30--                             **
C               **  SINCE NO LEAD CHARACTER MATCH FOUND,  **
C               **  GO TO END OF SUBROUTINE.              **
C               ********************************************
C
      GOTO9000
C
C               **********************************************
C               **  STEP 70--                               **
C               **  CHECK FOR A TRAILING LEFT PARENTHESIS.  **
C               **********************************************
C
C7100 CONTINUE
CCCCC IF(IA(IP1).EQ.'(')GOTO7110
CCCCC GOTO9000
C7110 CONTINUE
CCCCC IFOUND='YES'
CCCCC NCLF=1
CCCCC GOTO9000
C
 7200 CONTINUE
      IF(IA(IP2).EQ.'(')GOTO7210
      GOTO9000
 7210 CONTINUE
      IFOUND='YES'
      NCLF=2
      GOTO9000
C
 7300 CONTINUE
      IF(IA(IP3).EQ.'(')GOTO7310
      GOTO9000
 7310 CONTINUE
      IFOUND='YES'
      NCLF=3
      GOTO9000
C
 7400 CONTINUE
      IF(IA(IP4).EQ.'(')GOTO7410
      GOTO9000
 7410 CONTINUE
      IFOUND='YES'
      NCLF=4
      GOTO9000
C
 7500 CONTINUE
      IF(IA(IP5).EQ.'(')GOTO7510
      GOTO9000
 7510 CONTINUE
      IFOUND='YES'
      NCLF=5
      GOTO9000
C
 7600 CONTINUE
      IF(IA(IP6).EQ.'(')GOTO7610
      GOTO9000
 7610 CONTINUE
      IFOUND='YES'
      NCLF=6
      GOTO9000
C
 7700 CONTINUE
      IF(IA(IP7).EQ.'(')GOTO7710
      GOTO9000
 7710 CONTINUE
      IFOUND='YES'
      NCLF=7
      GOTO9000
C
 7800 CONTINUE
      IP8=I+8
      IF(IA(IP8).EQ.'(')GOTO7810
      GOTO9000
 7810 CONTINUE
      IFOUND='YES'
      NCLF=8
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGCK.EQ.'OFF')GOTO9990
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9911)
 9911 FORMAT('AT THE END       OF CKLIB2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9912)IFOUND,IERROR
 9912 FORMAT('IFOUND = ',A4,'  IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9913)NCLF
 9913 FORMAT('NCLF = ',I8)
      CALL DPWRST('XXX','BUG ')
 9990 CONTINUE
C
      RETURN
      END
      SUBROUTINE CKLOSC(X,N,ISORSW,ICASAX,
     1ISUBG4,IBUGG4,IERRG4)
C
C     PURPOSE--CHECK THAT ALL DATA IN X(.) ARE VALID
C              (IN THIS CASE, MEANING POSITIVE)
C              IN PREPARATION FOR A LOG SCALE TRANSFORMATION.
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--88.10
C     ORIGINAL VERSION--MAY        1983.
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--SEPTEMBER 1988.
C     UPDATED         --DECEMBER  1988.  IBUGG4 FOR IBUGPL
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 ISORSW
      CHARACTER*4 ICASAX
C
      CHARACTER*4 ISUBG4
      CHARACTER*4 IBUGG4
      CHARACTER*4 IERRG4
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'LOSC')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF CKLOSC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG4,ISUBG4,IERRG4
   52 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',3A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ISORSW,ICASAX
   53 FORMAT('ISORSW,ICASAX = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)N
   61 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO62I=1,N
      WRITE(ICOUT,63)I,X(I)
   63 FORMAT('I,X(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   62 CONTINUE
   90 CONTINUE
C
C               **************************************************
C               **  STEP 11--                                   **
C               **  CHECK THAT ALL X(.) ARE > 0                 **
C               **************************************************
C
      IF(ISORSW.EQ.'ON')GOTO1120
      GOTO1130
C
 1120 CONTINUE
      J=1
      IF(X(J).LE.0.0)GOTO1150
      GOTO9000
C
 1130 CONTINUE
      DO1135I=1,N
      J=I
      IF(X(J).LE.0.0)GOTO1150
 1135 CONTINUE
      GOTO9000
C
 1150 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN CKLOSC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      THE LOG OF A NON-POSITIVE DATA VALUE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      WAS ENCOUNTERED IN FORMING A PLOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)
 1154 FORMAT('      DATA MAY NOT BE ZERO OR NEGATIVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      WHEN A LOG SCALE PLOT IS USED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)X(J)
 1156 FORMAT('      THE VALUE = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1160)
 1160 FORMAT('      THIS VALUE CAME FROM THE ')
      CALL DPWRST('XXX','BUG ')
      IF(ICASAX.EQ.'2DHO')WRITE(ICOUT,1161)
 1161 FORMAT('      2-D HORIZONTAL AXIS VARIABLE.')
      IF(ICASAX.EQ.'2DHO')CALL DPWRST('XXX','BUG ')
      IF(ICASAX.EQ.'2DVE')WRITE(ICOUT,1162)
 1162 FORMAT('      2-D VERTICAL AXIS VARIABLE.')
      IF(ICASAX.EQ.'2DVE')CALL DPWRST('XXX','BUG ')
      IF(ICASAX.EQ.'3DH1')WRITE(ICOUT,1163)
 1163 FORMAT('      FIRST 3-D HORIZONTAL AXIS VARIABLE.')
      IF(ICASAX.EQ.'3DH1')CALL DPWRST('XXX','BUG ')
      IF(ICASAX.EQ.'3DH2')WRITE(ICOUT,1164)
 1164 FORMAT('      2ND 3-D HORIZONTAL AXIS VARIABLE.')
      IF(ICASAX.EQ.'3DH2')CALL DPWRST('XXX','BUG ')
      IF(ICASAX.EQ.'3DVE')WRITE(ICOUT,1165)
 1165 FORMAT('      3-D VERTICAL AXIS VARIABLE.')
      IF(ICASAX.EQ.'3DVE')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1171)
 1171 FORMAT('      CORRECTIVE ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1172)
 1172 FORMAT('      CHANGE DATA OR CHANGE LIMITS.')
      CALL DPWRST('XXX','BUG ')
      IERRG4='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'LOSC')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF CKLOSC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG4,ISUBG4,IERRG4
 9012 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',3A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ISORSW,ICASAX
 9013 FORMAT('ISORSW,ICASAX = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)N,J
 9021 FORMAT('N,J = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9022I=1,N
      WRITE(ICOUT,9023)I,X(I)
 9023 FORMAT('I,X(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE CKMATH(IBUGA3,ISUBRO,IFOUN7,ICASL7,ICASS7,ISTANR,
     1                  IMSUBC,ILOCV)
C
C     PURPOSE--CHECK TO SEE IF A TYPE 7 LET
C              COMMAND HAS BEEN GIVEN--
C                      SORT
C                      SORT2 (= SORT WITH 2 VARIABLES)
C                      SORTC (= SORT AND CARRY)
C                      GROUP SORT
C                      COCODE (= CORANK)
C                      COCOPY
C                      EXPAND
C                      RANK
C                      RANK2 (= RANKS WITHIN A GROUP)
C                      RANK INDEX
C                      PERCENTAGE RANK
C                      CODE
C                      CODEH
C                      CODE2
C                      CODE4
C                      CODE8
C                      CODE10
C                      CODEZ
C                      CODEX
C                      CODE DEX
C                      CODE DEX 2-LEVEL
C                      CODE CROSS TABULATE
C                      COMBINE
C                      KEEP/OMIT
C                      THRESHOLD MINIMUM
C                      THRESHOLD MAXIMUM
C                      SHUFFLE GROUP
C                      BREAK LOCATION
C                      FRAGMENT LOCATION
C                      FRAGMENT LENGTH
C                      2D GRID
C                      3D GRID
C
C                      DISTINCT
C                      SEQUENTIAL DIFFERENCE
C                      SEQUENTIAL SUM
C                      SEQUENTIAL MEAN
C                      SEQUENTIAL MINIMUM
C                      SEQUENTIAL MAXIMUM
C                      SEQUENTIAL PRODUCT
C                      SEQUENTIAL LOWER
C                      SEQUENTIAL UPPER
C                      INTERARRIVAL TIMES
C                      CUMULATIVE AVERAGE (MEAN)
C                      CUMULATIVE SUM
C                      CUMULATIVE INTEGRAL
C                      CUMULATIVE PRODUCT
C                      CUMULATIVE MINIMUM
C                      CUMULATIVE MAXIMUM
C                      CUMULATIVE <STAT>
C                      CONVOLUTION
C                      DECONVOLUTION
C                      INTERPOLATE
C                      LINEAR INTERPOLATE
C                      2D INTERPOLATE (SCATTERED TO RECTANGULAR GRID)
C                      BILINEAR INTERPOLATE (FROM RECTANGULAR GRID)
C                      BIVARIATE INTERPOLATE (FROM RECTANGULAR GRID)
C                      HERMITE INTERPOLATE
C                      HERMITE INTEGRATION
C
C                      SINE TRANSFORM
C                      COSINE TRANSFORM
C                      LAPLACE TRANSFORM  (NOT IMPLEMENTED)
C                      INVERSE LAPLACE TRANSFORM (NOT IMPLEMENTED)
C
C                      FOURIER TRANSFORM
C                      INVERSE FOURIER TRANSFORM
C                      FFT
C                      INVERSE FFT
C
C                      LOW  PASS FILTER
C                      HIGH PASS FILTER
C
C                      NORMAL KERNEL DENSITY MIXTURE
C
C                      COMPLEX ADDITION
C                      COMPLEX SUBTRACTION
C                      COMPLEX MULTIPLICATION
C                      COMPLEX DIVISION
C                      COMPLEX EXPONENTIATION
C                      COMPLEX SQUARE ROOT
C                      COMPLEX ROOT (OF A POLYNOMIAL)  (2 OR 1 ARGUMENTS)
C                      COMPLEX CONJUGATE
C
C                      POLYNOMIAL ADDITION
C                      POLYNOMIAL SUBTRACTION
C                      POLYNOMIAL MULTIPLICATION
C                      POLYNOMIAL DIVISION
C                      POLYNOMIAL SQUARE
C                      POLYNOMIAL SQUARE ROOT  (FUTURE--NOT YET IMPLEMENTED)
C                      POLYNOMIAL GCD          (FUTURE--NOT YET IMPLEMENTED)
C                      POLYNOMIAL LCM          (FUTURE--NOT YET IMPLEMENTED)
C                      POLYNOMIAL EVALUATION
C
C                      VECTOR ADDITION
C                      VECTOR SUBTRACTION
C                      VECTOR DOT PRODUCT (OR INNER PRODUCT)
C                      VECTOR CROSS PRODUCT    (FUTURE--NOT YET IMPLEMENTED)
C                      VECTOR LENGTH (OR MAGNITUDE)
C                      VECTOR DISTANCE
C                      VECTOR ANGLE
C
C                      SET UNION (OR ADDITION)
C                      SET INTERSECTION
C                      SET COMPLEMENT
C                      SET CARDINALITY
C                      SET CARTESIAN PRODUCT
C                      SET ELEMENTS (DISTINCT)
C
C                      LOGICAL AND (OR CONJUNCTION OR MULTIPLICATION)
C                      LOGICAL OR (OR DISJUNCTION OR ADDITION)
C                      LOGICAL NAND
C                      LOGICAL NOR
C                      LOGICAL IFTHEN (OR IMPLICATION)
C                      LOGICAL IFF (OR EQUIVALENCE)
C                      LOGICAL NOT (OR NEGATION OR NOT OR COMPLEMENT)
C                      LOGICAL XOR (OR EXCLUSIVE OR   OR EXCL. DISJ.)
C
C                      MATRIX DEFINITION
C                      MATRIX SUBMATRIX
C                      CREATE MATRIX
C                      MATRIX TRANSPOSE
C                      MATRIX NUMBER OF ROWS
C                      MATRIX NUMBER OF COLUMNS
C                      MATRIX ROW
C                      MATRIX ELEMENT
C                      MATRIX REPLACE ROW
C                      MATRIX ADD ROW
C                      MATRIX DELETE ROW
C                      MATRIX REPLACE ELEMENT
C                      MATRIX AUGMENT
C                      MATRIX DIAGONAL
C                      DIAGONAL MATRIX
C                      VARIABLE TO MATRIX
C                      MATRIX TO VARIABLE
C                      MATRIX COMBINE ROWS
C                      MATRIX COMBINE COLUMNS
C
C                      MATRIX ADDITION
C                      MATRIX SUBTRACTION
C                      MATRIX MULTIPLICATION
C
C                      MATRIX CONDITION NUMBER
C                      MATRIX RECIPROCAL CONDITION NUMBER
C                      MATRIX INVERSE
C                      MATRIX SOLUTION
C                      MATRIX ITERATIVE SOLUTION
C                      TRIDIAGONAL SOLVE
C                      TRIANGULAR SOLVE
C                      TRIANGULAR INVERSE
C                      MATRIX CHOLESKY DECOMP
C                      MATRIX SIMPLEX SOLUTION
C                      PSUEDO INVERSE
C                      QR DECOMPOSITION (NOT DONE)
C
C                      MATRIX EIGENVALUES
C                      MATRIX EIGENVECTORS
C                      MATRIX SINGULAR VALUES
C                      MATRIX SINGULAR VALUE DECOMPOSITION
C                      MATRIX SINGULAR VALUE FACTORIZATION
C
C                      MATRIX DETERMINANT
C                      MATRIX ADJOINT
C                      MATRIX MINOR
C                      MATRIX COFACTOR
C                      MATRIX CHARACTERISTIC EQ. (FUTURE--NOT YET IMP.)
C                      MATRIX PERMANENT
C
C                      MATRIX RANK
C                      MATRIX TRACE
C                      MATRIX SPECTRAL NORM
C                      MATRIX SPECTRAL RADIUS
C                      MATRIX EUCLIDEAN NORM
C
C                      VARIANCE-COVARIANCE MATRIX
C                      CORRELATION MATRIX
C                      PARTIAL CORRELATION MATRIX
C                      PARTIAL CORRELATION CDF MATRIX
C                      PARTIAL CORRELATION PVALUE MATRIX
C                      COMOVEMENT MATRIX
C                      POOLED VARIANCE-COVARIANCE MATRIX
C                      PRINCIPLE COMPONENTS
C                      PRINCIPLE COMPONENTS EIGENVECTORS
C                      PRINCIPLE COMPONENTS EIGENVALUES
C                      ... PRINCIPLE COMPONENT
C                      ... PRINCIPLE COMPONENTS EIGENVECTORS
C                      ... PRINCIPLE COMPONENTS EIGENVALUES
C
C                      CATCHER MATRIX
C                      XTXINV MATRIX
C                      VARIANCE INFLATION FACTORS
C                      CONDITION INDICES
C                      QUADRATIC FORM
C                      LINEAR COMBINATION
C                      VECTOR TIMES TRANSPOSE
C
C                      HOTELLING 1-SAMPLE T-SQUARE
C                      HOTELLING 2-SAMPLE T-SQUARE
C                      MATRIX MEAN
C                      MATRIX SUM
C                      DISTANCE FROM MEAN
C                      MATRIX ROW <STAT>
C                      MATRIX COLUMN <STAT>
C                      MATRIX PARTITION <STAT>
C                      MATRIX GRAND <STAT>
C                      MATRIX BIN
C                      MATRIX GROUP MEANS
C                      MATRIX GROUP STANDARD DEVIATIONS
C                      MATRIX ROW SCALE
C                      MATRIX COLUMN SCALE
C                      EUCLIDEAN ROW DISTANCE
C                      EUCLIDEAN COLUMN DISTANCE
C                      MAHALANOBIS ROW DISTANCE
C                      MAHALANOBIS COLUMN DISTANCE
C                      MINKOWSKY ROW DISTANCE
C                      MINKOWSKY COLUMN DISTANCE
C                      CHEBYCHEV ROW DISTANCE
C                      CHEBYCHEV COLUMN DISTANCE
C                      BLOCK ROW DISTANCE
C                      BLOCK COLUMN DISTANCE
C                      COSINE ROW DISTANCE
C                      COSINE COLUMN DISTANCE
C                      COSINE ROW SIMILARITY
C                      COSINE COLUMN SIMILARITY
C                      JACCARD ROW DISTANCE
C                      JACCARD COLUMN DISTANCE
C                      JACCARD ROW SIMILARITY
C                      JACCARD COLUMN SIMILARITY
C                      CANBERRA ROW DISTANCE
C                      CANBERRA COLUMN DISTANCE
C                      PEARSON ROW DISTANCE
C                      PEARSON COLUMN DISTANCE
C                      PEARSON ROW SIMILARITY
C                      PEARSON COLUMN SIMILARITY
C                      GENERATE MATRIX <STAT>
C                      DEX CORE
C                      DEX CONFOUND
C                      DEX CHECK CLASSIC
C
C                      MULTIVARIATE NORMAL RANDOM NUMBERS
C                      INDEPENDENT UNIFORM RANDOM NUMBERS
C                      CORRELATED UNIFORM RANDOM NUMBERS
C                      MULTIVARIATE T RANDOM NUMBERS
C                      MULTINOMIAL RANDOM NUMBERS
C                      MULTINOMIAL PDF
C                      WISHART RANDOM NUMBERS
C                      DIRICHLET RANDOM NUMBERS
C                      DIRICHLET PDF
C                      DIRICHLET LOG PDF
C                      MULTIVARIATE NORMAL CDF
C                      MULTIVARIATE T CDF
C
C                      MATRIX ROW FIT
C                      MATRIX COLUMN FIT
C                      BIPLOT
C
C                      MATRIX RENUMBER M SIG TAU
C                      EDGES TO ADJANCENCY MATRIX
C
C                      FRACTAL
C                      BOOTSTRAP SAMPLE
C                      RANDOM SAMPLE = BOOTSTRAP SAMPLE
C                      JACKNIFE SAMPLE = BOOTSTRAP SAMPLE
C                      JACKNIFE INDEX
C                      REVERSE
C                      CUMULATIVE HAZARD
C                      HAZARD
C                      EXPONENTIAL SMOOTHING
C                      SAMPLED RANDOM PERMUTATION
C
C                      BINNED (= FREQUENCY TABLE)
C                      RELATIVE BINNED (= RELATIVE FREQUENCY TABLE)
C                      CODED BINNED
C                      CODED RELATIVE BINNED
C                      ASH BINNED
C                      COUNTS ASH BINNED
C                      FREQUENCY TO RAW
C                      COMBINE FREQUENCY TABLE
C                      INTEGER FREQUENCY TABLE
C                      PEAKS OF FREQUENCY TABLE (FREQUENCY TABLE PEAKS)
C                      PEAKS
C                      PEAK TRIANGLE AREAS
C                      EMPIRICAL QUANTILE FUNCTION
C                      INFORMATIVE QUANTILE FUNCTION
C                      TRUNCATED INFORMATIVE QUANTILE FUNCTION
C
C                      CUSUM ARL (= TWO SIDED CUSUM ARL)
C                      ONE-SIDED CUSUM ARL
C                      TWO-SIDED CUSUM ARL
C
C                      STANDARDIZE
C                      LOCATION STANDARDIZE
C                      SCALE STANDARDIZE
C                      ZSCORE
C                      USCORE
C                      MEAN RANK
C                      JSCORE
C                      JSCORE TABLE
C                      EN
C                      ISO 13528 ZSCORE
C                      ISO 13528 ZPRIME SCORE
C                      ISO 13528 ZETA SCORE
C                      ISO 13528 EZ- SCORE
C                      ISO 13528 EZ+ SCORE
C                      ISO 13528 EN  SCORE
C                      ISO 13528 PA  SCORE
C                      ISO 13528 DI PERCENT  SCORE
C                      RANDOM ERROR QUANTITY
C
C                      VARIANCES WELCH-SATTERTHWAITE
C                      GUM WELCH-SATTERTHWAITE
C
C                      CROSS TABULATE <STAT>
C                      CROSS TABULATE CUMULATIVE <STAT>
C                      MOVING <STAT>
C                      WINDOW <STAT>
C
C                      SORT BY <STAT>
C
C                      MATCH
C                      CELL MATCH
C                      REPLACE
C                      STACK
C                      REPLICATED STACK
C                      UNSTACK
C                      INSERT
C
C                      WINSOR
C
C                      H CONSISTENCY STATISTIC
C                      K CONSISTENCY STATISTIC
C
C                      PROBABILITY WEIGHTED MOMENTS
C                      BETA PROBABILITY WEIGHTED MOMENTS
C                      L MOMENTS
C
C                      GENERATOR MULTIPLICATION
C
C                      JITTER
C                      AGRESTI COULL LIMITS
C                      EXACT BINOMIAL LOWER LIMIT
C                      EXACT BINOMIAL UPPER LIMIT
C                      EXACT BINOMIAL LIMITS
C                      DIFFERENCE OF PROPORTIONS CONFIDENCE LIMITS
C                      DIFFERENCE OF PROPORTIONS HYPOTHESIS TEST
C                      RUHKIN 1 TEST  (P1 = P2*P3)
C                      RUHKIN 2 TEST  (P1 = 0.5*P2)
C                      RUHKIN 3 TEST  (P1*P2 = P3*P4)
C                      BINOMIAL RATIO CONFIDENCE LIMITS
C                      BINOMIAL PRODUCT STANDARD ERROR
C
C                      MANN WHITNEY U STATISTIC FREQUENCY
C
C                      2D CONVEX HULL
C                      POINT IN POLYGON
C                      NEAREST NEIGHBOR INDEX
C                      NEAREST NEIGHBOR DISTANCE
C                      NEAREST NEIGHBOR
C                      FIRST NEAREST NEIGHBOR
C                      ALL NEAREST NEIGHBORS
C                      JOIN
C                      TRANSFORM POINTS
C                      EXTREME POINTS
C                      ENCLOSING BOX
C                      LINE INTERSECTIONS
C                      PARALLEL LINES
C                      PERPINDICULAR LINES
C                      MINIMUM SPANNING TREE
C                      SPANNING FORST
C
C                      NEXT SUBSET
C                      NEXT PERMUTATION
C                      NEXT K-SET OF N-SET
C                      NEXT COMPOSITION
C                      NEXT PARTITION
C                      NEXT EQUIVALENCE RELATION
C                      NEXT YOUNG TABLEAUX
C                      CONVERT YOUNG TABLEAUX
C                      YOUNG TABLEAUX HOOK LENGTH
C
C                      GATHER
C                      SCATTER
C                      SHIFT
C                      SHIFTC
C
C                      DIGITS
C
C                      LARGEST
C                      SMALLEST
C
C                      BRITTLE FIBER WEIBULL PDF
C                      BRITTLE FIBER WEIBULL CDF
C                      BRITTLE FIBER WEIBULL PPF
C                      END EFFECTS WEIBULL PDF
C                      END EFFECTS WEIBULL CDF
C                      END EFFECTS WEIBULL PPF
C                      WEIBULL MOMENT ESTIMATE
C                      LOGNORMAL MOMENT ESTIMATE
C                      GAMMA MOMENT ESTIMATE
C                      INVERSE GAUSSIAN MOMENT ESTIMATE
C
C                      YFRAME LIMITS
C                      XFRAME LIMITS
C                      YTIC <SCREEN/DATA> COORDINATES
C                      XTIC <SCREEN/DATA> COORDINATES
C
C                      VECTOR PERCENTILE
C
C                 NOTE: CHECK FOR THE COMMANDS:
C
C                          LET Y = X       (I.E., COPY A VECTOR)
C
C                       TREAT THIS AS AN IMPLCIT
C
C                          LET Y = COPY X
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/10
C     ORIGINAL VERSION--JULY      1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1987.
C     UPDATED         --APRIL     1987.
C     UPDATED         --AUGUST    1987. COMPLEX SQUARE ROOT
C     UPDATED         --AUGUST    1987. COMPLEX ROOTS (OF POLYNOMIAL)
C     UPDATED         --AUGUST    1987. POLYNOMIAL ARITHMETIC
C     UPDATED         --AUGUST    1987. VECTOR ARITHMETIC
C     UPDATED         --AUGUST    1987. SET ARITHMETIC
C     UPDATED         --AUGUST    1987. LOGICAL ARITHMETIC
C     UPDATED         --SEPTEMBER 1987. FFT AND INVERSE FFT
C     UPDATED         --SEPTEMBER 1987. MATRIX OPERATIONS
C     UPDATED         --SEPTEMBER 1987. COMPLEX CONJUGATE
C     UPDATED         --FEBRUARY  1988. BIWEIGHT AND TRICUBE
C     UPDATED         --JULY      1988. FRACTAL
C     UPDATED         --JANUARY   1989. BOOTSTRAP SAMPLE
C     UPDATED         --JANUARY   1989. JACKNIFE SAMPLE = BOOTSTRAP SAMPLE
C     UPDATED         --JANUARY   1990. RANDOM (SUB)SAMPLE  (GENERALIZE)
C
C     UPDATED         --AUGUST    1988  (VARIANCE-COVARIANCE MATRIX)
C     UPDATED         --AUGUST    1988  (CORRELATION MATRIX)
C     UPDATED         --AUGUST    1988  (PRINCIPLE COMPONENTS ...)
C     UPDATED         --AUGUST    1988  (... PRINCIPLE COMPONENTS ...)
C
C     UPDATED         --DECEMBER  1989. GENERATOR MULTIPLICATION
C     UPDATED         --JULY      1991. COCODE ('COCD')
C     UPDATED         --JULY      1991. COCOPY ('COCP')
C     UPDATED         --OCTOBER   1991. CORANK SYNONYM FOR COCODE
C     UPDATED         --MARCH     1992. RECOGNIZE   SORT & CARRY
C     UPDATED         --JULY      1993. MATRIX SINGULAR VALUES AND
C                                       MATRIX SING VALUE DECOMP
C     UPDATED         --SEPTEMBER 1993. MATRIX ROW
C                                       MATRIX ELEMENT
C     UPDATED         --OCTOBER   1993. JACKNIFE INDEX
C     UPDATED         --OCTOBER   1993. CHOLESKY DECOMP, MATRIX
C                                       REPLACE ROW, MATRIX REPLACE
C                                       ELEMENT, MATRIX AUGMENT, MATRIX
C                                       DIAGONAL, DIAGONAL MATRIX,
C                                       TRIDIAGONAL SOLVE
C     UPDATED         --MAY       1994. LINEAR INTERPOLATE, 2D
C                                       INTERPOLATE, BILINEAR INTERPOL
C     UPDATED         --FEBRUARY  1998. CODED AS SYNONYM FOR CODE
C     UPDATED         --MAY       1998. INTERARRIVAL TIMES
C     UPDATED         --MAY       1998. CUMULATIVE AVERAGE
C     UPDATED         --MAY       1998. REVERSE (OR FLIP)
C     UPDATED         --MAY       1998. HAZARD
C     UPDATED         --MAY       1998. CUMULATIVE HAZARD
C     UPDATED         --JUNE      1998. SOME NEW MATRIX COMMANDS
C     UPDATED         --AUGUST    1998. MATRIX MEAN
C     UPDATED         --AUGUST    1998. MATRIX ADD ROW
C     UPDATED         --AUGUST    1998. MATRIX DELETE ROW
C     UPDATED         --SEPTEMBER 1998. MATRIX GROUP MEAN
C     UPDATED         --SEPTEMBER 1998. MATRIX GROUP STANDARD DEVIATION
C     UPDATED         --NOVEMBER  1998. BINNED, RELATIVE BINNED
C     UPDATED         --MARCH     1999. CUSUM ARL
C     UPDATED         --MARCH     2001. STANDARDIZE
C     UPDATED         --MARCH     2001. LOCATION STANDARDIZE
C     UPDATED         --SEPTEMBER 2001. FIXES TO STANDARDIZE
C     UPDATED         --SEPTEMBER 2001. LOCATION STANDARDIZE
C     UPDATED         --OCTOBER   2001. MATCH
C     UPDATED         --MAY       2002. MULTIVARIATE NORM RAND NUMB
C     UPDATED         --MAY       2002. MULTINOMIAL RAND NUMB
C     UPDATED         --MAY       2002. WISHART RAND NUMB
C     UPDATED         --MAY       2002. FERMDIRA
C     UPDATED         --JUNE      2002. CATCHER MATRIX
C     UPDATED         --JUNE      2002. XTXINV MATRIX
C     UPDATED         --JUNE      2002. VARIANCE INFLATION FACTORS
C     UPDATED         --JUNE      2002. CONDITION INDICES
C     UPDATED         --JUNE      2002. CREATE MATRIX
C     UPDATED         --JULY      2002. WINSORIZE
C     UPDATED         --AUGUST    2002. UPDATE SUPPORTED STATISTICS
C                                       FOR CROSS TABULATE AND
C                                       MATRIX <ROW/COLUMN>
C     UPDATED         --MARCH     2003. ADD 35 "DIFFERENCE OF"
C                                       STATISTICS TO CROSS TABULATE
C     UPDATED         --APRIL     2003. MULTIVARIATE T RAND NUMB
C     UPDATED         --APRIL     2003. MULTIVARIATE INDE UNIF RAND NUMB
C     UPDATED         --APRIL     2003. MULTIVARIATE DIRE RAND NUMB
C     UPDATED         --APRIL     2003. MULTIVARIATE NORM CDF
C     UPDATED         --APRIL     2003. MULTIVARIATE NORM PDF
C     UPDATED         --APRIL     2003. ADD SN SCALE AND QN SCALE TO
C                                       CROSS TABULATE AND
C                                       MATRIX ROW/COLUMN STAT
C     UPDATED         --MAY       2003. STACK COMMAND
C     UPDATED         --MAY       2003. MULTINOMIAL PDF
C     UPDATED         --OCTOBER   2004. ASH BIN
C     UPDATED         --OCTOBER   2004. COUNTS ASH BIN
C     UPDATED         --OCTOBER   2004. COMBINE FREQUENCY TABLE
C     UPDATED         --FEBRUARY  2005. REPLICATED STACK
C     UPDATED         --FEBRUARY  2005. H CONSISTENCY STATISTIC
C     UPDATED         --FEBRUARY  2005. K CONSISTENCY STATISTIC
C     UPDATED         --JUNE      2005. L MOMENTS
C     UPDATED         --JUNE      2005. PROBABILITY WEIGHTED MOMENTS
C     UPDATED         --JUNE      2005. MATRIX <STAT>
C     UPDATED         --JUNE      2005. MATRIX PARTITION <STAT>
C     UPDATED         --SEPTEMBER 2005. CROSS TABULATE RATIO
C     UPDATED         --DECEMBER  2005. BETA PROBABILITY WEIGHTED
C                                       MOMENTS
C     UPDATED         --DECEMBER  2005. SORT BY <STAT>
C     UPDATED         --MARCH     2006. MATRIX BIN
C     UPDATED         --MARCH     2006. MATRIX LOWER TRUNCATE
C     UPDATED         --MARCH     2006. MATRIX UPPER TRUNCATE
C     UPDATED         --MAY       2006. INTEGER FREQUENCY TABLE
C     UPDATED         --JANUARY   2007. JITTER
C     UPDATED         --FEBRUARY  2007. AGRSTI COULL LIMITS
C     UPDATED         --FEBRUARY  2007. EXACT BINOMIAL LOWER LIMITS
C     UPDATED         --FEBRUARY  2007. EXACT BINOMIAL UPPER LIMITS
C     UPDATED         --MARCH     2007. MATRIX CRAMER CONT COEFF
C     UPDATED         --MARCH     2007. MATRIX PEARSON CONT COEFF
C     UPDATED         --MAY       2007. TRIMMED STANDARD DEVIATION
C                                       FOR "MATRIX" AND
C                                       "CROSS TABULATE" COMMANDS
C     UPDATED         --NOVEMBER  2007. COMOVEMENT MATRIX
C     UPDATED         --NOVEMBER  2007. LP LOCA, VARI LP LOCA,
C                                       SD LP LOCA FOR MATRIX <STAT>
C                                       AND CROSS TABULATE COMMANDS
C     UPDATED         --APRIL     2008. 2D CONVEX HULL
C     UPDATED         --APRIL     2008. MINIMUM SPANNING TREE
C     UPDATED         --APRIL     2008. NEXT SUBSET
C     UPDATED         --APRIL     2008. NEXT PERMUTATION
C     UPDATED         --APRIL     2008. NEXT K-SET OF N-SET
C     UPDATED         --MAY       2008. PEAKS OF FREQUENCY TABLE
C     UPDATED         --MAY       2008. LET Y = X CASE
C     UPDATED         --MAY       2008. NEXT COMPOSITION
C     UPDATED         --MAY       2008. NEXT PARTITION
C     UPDATED         --JUNE      2008. NEXT EQUIVALENCE RELATION
C     UPDATED         --JUNE      2008. MATRIX RENUMBER
C     UPDATED         --JUNE      2008. SPANNING FOREST
C     UPDATED         --JULY      2008. EDGES TO ADJACENCY MATRIX
C     UPDATED         --AUGUST    2008. NEXT YOUNG TABLEAUX
C     UPDATED         --AUGUST    2008. CONVERT YOUNG TABLEAUX
C     UPDATED         --AUGUST    2008. YOUNG TABLEAUX HOOK LENGTH
C     UPDATED         --AUGUST    2008. GROUP SORT
C     UPDATED         --AUGUST    2008. DIFFERENCE OF PROPORTIONS
C                                       CONFIDENCE LIMITS
C     UPDATED         --AUGUST    2008. DIFFERENCE OF PROPORTIONS
C                                       HYPOTHEIS TEST
C     UPDATED         --SEPTEMBER 2008. RUHKIN 1 TEST
C     UPDATED         --SEPTEMBER 2008. RUHKIN 2 TEST
C     UPDATED         --OCTOBER   2008. SORT2, SORT3, SORT4
C     UPDATED         --NOVEMBER  2008. GATHER
C     UPDATED         --NOVEMBER  2008. SCATTER
C     UPDATED         --DECEMBER  2008. RANK2, RANK3, RANK4
C     UPDATED         --JANUARY   2009. EDGES TO DIRECTED ADJACENCY
C                                       MATRIX
C     UPDATED         --FEBRUARY  2009. FOLLOWING STATISTICS FOR
C                                       CROSS TABULATE AND MATRIX
C                                       <COLUMN/ROW> <STAT> COMMANDS
C                                       INDEX MINIMUM,
C                                       INDEX MAXIMUM,
C                                       INDEX EXTREME,
C                                       GRUBB, GRUBB CDF,
C                                       GRUBB DIRECTION, GRUBB INDEX,
C                                       ONE SAMPLE T-TEST,
C                                       ONE SAMPLE T-TEST CDF,
C                                       CHI-SQUARE SD TEST,
C                                       CHI-SQUARE SD TEST CDF,
C                                       FREQUENCY TEST, FREQUENCY TEST CDF,
C                                       FREQUENCY WITHIN A BLOCK TEST,
C                                       FREQUENCY WITHIN A BLOCK TEST CDF
C     UPDATED         --FEBRUARY  2009. SHIFT, CIRCULAR SHIFT
C     UPDATED         --MARCH     2009. USE "EXTSTA" TO LOOK FOR
C                                       STATISTICS FOR
C                                       CROSS TABULATE, SORT BY, AND
C                                       MATRIX
C                                       <COLUMN/ROW/GRAND/PARTITION>
C                                       <STAT> COMMANDS
C     UPDATED         --MARCH     2009. BIPLOT
C     UPDATED         --JUNE      2009. CODE CROSS TABULATE
C     UPDATED         --FEBRUARY  2010. MATRIX <ROW/COLUMN> FIT
C     UPDATED         --JUNE      2010. RANK INDEX
C     UPDATED         --JUNE      2010. RUHKIN 3
C     UPDATED         --SEPTEMBER 2010. COMBINE
C     UPDATED         --OCTOBER   2010. MOVING <STAT>
C     UPDATED         --OCTOBER   2010. BRITTLE FIBER WEIBULL PDF/CDF/PPF
C     UPDATED         --OCTOBER   2010. EXACT BINOMIAL LIMITS
C     UPDATED         --NOVEMBER  2010. VARIABLE TO MATRIX
C     UPDATED         --NOVEMBER  2010. MATRIX TO VARIABLE
C     UPDATED         --JANUARY   2011. MATRIX COMBINE ROWS
C     UPDATED         --JANUARY   2011. MATRIX COMBINE COLUMNS
C     UPDATED         --APRIL     2011. KEEP/OMIT
C     UPDATED         --MAY       2011. MANN WHITNEY U STATISTIC
C                                       FREQUENCY
C     UPDATED         --JULY      2011. THRESHOLD MINIMUM
C     UPDATED         --JULY      2011. THRESHOLD MAXIMUM
C     UPDATED         --JANUARY   2012. PERCENTAGE RANK
C     UPDATED         --JANUARY   2012. EXPAND
C     UPDATED         --JANUARY   2012. EN
C     UPDATED         --JANUARY   2012. ISO 13528 ZSCORE
C     UPDATED         --JANUARY   2012. ISO 13528 ZPRIME SCORE
C     UPDATED         --JANUARY   2012. ISO 13528 ZETA SCORE
C     UPDATED         --JANUARY   2012. ISO 13528 EZMINUS SCORE
C     UPDATED         --JANUARY   2012. ISO 13528 EZPLUS SCORE
C     UPDATED         --JANUARY   2012. ISO 13528 EN SCORE
C     UPDATED         --FEBRUARY  2012. JSCORE
C     UPDATED         --MARCH     2012. BUG FIX IN "LET Y = X"
C     UPDATED         --JUNE      2012. WEIBULL MOMENT ESTIMATE
C     UPDATED         --AUGUST    2012. LOW  PASS FILTER
C     UPDATED         --AUGUST    2012. HIGH PASS FILTER
C     UPDATED         --OCTOBER   2012. TRANSFORM POINTS
C     UPDATED         --OCTOBER   2012. EXTREME POINTS
C     UPDATED         --OCTOBER   2012. ENCLOSING BOX
C     UPDATED         --OCTOBER   2012. PARALLEL LINES
C     UPDATED         --OCTOBER   2012. PERPINDICULAR LINES
C     UPDATED         --DECEMBER  2012. CUMULATIVE MINIMUM
C     UPDATED         --DECEMBER  2012. CUMULATIVE MAXIMUM
C     UPDATED         --JANUARY   2013. CUMULATIVE <STAT>
C     UPDATED         --JANUARY   2013. CROSS TABULATE CUMULATIVE <STAT>
C     UPDATED         --AUGUST    2013. NEAREST NEIGHBOR
C     UPDATED         --AUGUST    2013. NEAREST NEIGHBOR INDEX
C     UPDATED         --AUGUST    2013. NEAREST NEIGHBOR DISTANCE
C     UPDATED         --AUGUST    2013. JOIN
C     UPDATED         --AUGUST    2013. PEAKS
C     UPDATED         --AUGUST    2013. PEAKS TRAINGLE AREAS
C     UPDATED         --SEPTEMBER 2013. FIRST NEAREST NEIGHBOR
C     UPDATED         --SEPTEMBER 2013. ALL NEAREST NEIGHBORS
C     UPDATED         --APRIL     2014. LOGNORMAL MOMENT ESTIMATES
C     UPDATED         --APRIL     2014. GAMMA MOMENT ESTIMATES
C     UPDATED         --APRIL     2014. INVERSE GAUSSIAN MOMENT ESTIMATES
C     UPDATED         --JULY      2014. SHUFFLE GROUP
C     UPDATED         --DECEMBER  2014. RANDOM ERROR QUANTITY
C     UPDATED         --JANUARY   2015. DIGITS
C     UPDATED         --OCTOBER   2015. JSCORE TABLE
C     UPDATED         --DECEMBER  2015. XFRAME LIMITS
C     UPDATED         --DECEMBER  2015. YFRAME LIMITS
C     UPDATED         --FEBRUARY  2016. ISO 13528 PA SCORE
C     UPDATED         --FEBRUARY  2016. SEQUENTIAL SUM
C     UPDATED         --FEBRUARY  2016. SEQUENTIAL PRODUCT
C     UPDATED         --FEBRUARY  2016. SEQUENTIAL MEAN
C     UPDATED         --FEBRUARY  2016. SEQUENTIAL MINIMUM
C     UPDATED         --FEBRUARY  2016. SEQUENTIAL MAXIMUM
C     UPDATED         --FEBRUARY  2016. SEQUENTIAL LOWER
C     UPDATED         --FEBRUARY  2016. SEQUENTIAL UPPER
C     UPDATED         --FEBRUARY  2016. SEQUENTIAL <STAT> WITH GROUP-ID
C                                       VARIABLE
C     UPDATED         --JUNE      2016. WINDOW <STAT>
C     UPDATED         --JUNE      2016. VECTOR PERCENTILE
C     UPDATED         --JUNE      2016. CODEZ
C     UPDATED         --AUGUST    2016. UNSTACK
C     UPDATED         --JANUARY   2017. VARIANCES WELCH-SATTERTHWAITE
C     UPDATED         --JANUARY   2017. GUM WELCH-SATTERTHWAITE
C     UPDATED         --FEBRUARY  2017. NORMAL KERNEL DENISTY MIXTURE
C     UPDATED         --FEBRUARY  2017. EMPIRICAL QUANTILE FUNCTION
C     UPDATED         --MARCH     2017. INFORMATIVE QUANTILE FUNCTION
C     UPDATED         --MARCH     2017. TRUNCATED INFORMATIVE QUANTILE
C                                       FUNCTION
C     UPDATED         --JULY      2017. CODEX
C     UPDATED         --AUGUST    2017. SAMPLED RANDOM PERMUTATION
C     UPDATED         --AUGUST    2017. HERMITE INTERPOLATION
C     UPDATED         --AUGUST    2017. HERMITE INTEGRATION
C     UPDATED         --AUGUST    2017. GENERATE MATRIX <STAT>
C     UPDATED         --JANUARY   2018. DEX CORE
C     UPDATED         --JANUARY   2018. DEX CONFOUND
C     UPDATED         --JANUARY   2018. CODE DEX
C     UPDATED         --FEBRUARY  2018. DEX CHECK CLASSIC
C     UPDATED         --JULY      2018. MEAN RANK
C     UPDATED         --AUGUST    2018. MATRIX COSINE ROW DISTANCE
C     UPDATED         --AUGUST    2018. MATRIX COSINE COLUMN DISTANCE
C     UPDATED         --AUGUST    2018. MATRIX COSINE ROW SIMILARITY
C     UPDATED         --AUGUST    2018. MATRIX COSINE COLUMN SIMILARITY
C     UPDATED         --AUGUST    2018. MATRIX JACCARD ROW DISTANCE
C     UPDATED         --AUGUST    2018. MATRIX JACCARD COLUMN DISTANCE
C     UPDATED         --AUGUST    2018. MATRIX JACCARD ROW SIMILARITY
C     UPDATED         --AUGUST    2018. MATRIX JACCARD COLUMN SIMILARITY
C     UPDATED         --AUGUST    2018. MATRIX ANGULAR COSINE ROW DISTANCE
C     UPDATED         --AUGUST    2018. MATRIX ANGULAR COSINE COLUMN DISTANCE
C     UPDATED         --AUGUST    2018. MATRIX ANGULAR COSINE ROW SIMILARITY
C     UPDATED         --AUGUST    2018. MATRIX ANGULAR COSINE COLUMN SIMILARITY
C     UPDATED         --AUGUST    2018. MATRIX PEARSON ROW DISTANCE
C     UPDATED         --AUGUST    2018. MATRIX PEARSON COLUMN DISTANCE
C     UPDATED         --AUGUST    2018. MATRIX HAMMING ROW DISTANCE
C     UPDATED         --AUGUST    2018. MATRIX HAMMING COLUMN DISTANCE
C     UPDATED         --AUGUST    2018. MATRIX CANBERRA ROW DISTANCE
C     UPDATED         --AUGUST    2018. MATRIX CANBERRA COLUMN DISTANCE
C     UPDATED         --AUGUST    2018. CELL MATCH
C     UPDATED         --OCTOBER   2018. LARGEST
C     UPDATED         --OCTOBER   2018. SMALLEST
C     UPDATED         --OCTOBER   2018. <YTIC/XTIC> <SCREEN/DATA>
C                                       COORDINATES
C     UPDATED         --OCTOBER   2018. MATRIX PEARSON ROW SIMILARITY
C     UPDATED         --OCTOBER   2018. MATRIX PEARSON COLUMN SIMILARITY
C     UPDATED         --OCTOBER   2018. CODE DEX 2-LEVEL
C     UPDATED         --JULY      2019. BREAK LOCATION
C     UPDATED         --AUGUST    2019. FRAGMENT LOCATION
C     UPDATED         --AUGUST    2019. FRAGMENT CENTROID
C     UPDATED         --AUGUST    2019. FRAGMENT LENGTH
C     UPDATED         --AUGUST    2019. 2D GRID
C     UPDATED         --AUGUST    2019. 3D GRID
C     UPDATED         --FEBRUARY  2020. INSERT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUN7
      CHARACTER*4 ICASL7
      CHARACTER*4 ICASS7
      CHARACTER*4 IMSUBC
C
      CHARACTER*4 IERROR
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*8 IHTEMP
C
      CHARACTER*4  ISTADF
      CHARACTER*60 ISTANM
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
C
      IERROR='NO'
      ISUBN1='CKMA'
      ISUBN2='TH  '
C
C               *********************************************
C               **  CHECK FOR A DATA MANIPULATION SUBCASE  **
C               *********************************************
C
      IFOUN7='NO'
      ICASL7='UNKN'
      ICASS7='UNKN'
      ILOCV=-1
      ISTANR=1
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MATH')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF CKMATH--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA3,ISUBRO,NUMARG
   52   FORMAT('IBUGA3,ISUBRO,NUMARG = ',2(A4,2X),I8)
        CALL DPWRST('XXX','BUG ')
        DO54I=1,NUMARG
          WRITE(ICOUT,55)I,IHARG(I)
   55     FORMAT('I,IHARG(I)    = ',I8,1X,A4)
          CALL DPWRST('XXX','BUG ')
   54   CONTINUE
      ENDIF
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE IF OF THIS TYPE  **
C               **  AND BRANCH ACCORDINGLY.    **
C               *********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC IF(NUMARG.LE.3)GOTO9000
      IF(NUMARG.LE.2)GOTO9000
C
CCCCC THE FOLLOWING SECTION WERE ADDED MARCH 1992
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'SORT'.AND.IHARG2(3).EQ.'    '.AND.
     1IHARG(4).EQ.'AND '.AND.IHARG2(4).EQ.'    '.AND.
     1IHARG(5).EQ.'CARR'.AND.IHARG2(5).EQ.'Y   ')GOTO1110
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'SORT'.AND.IHARG2(3).EQ.'    '.AND.
     1IHARG(4).EQ.'CARR'.AND.IHARG2(4).EQ.'Y   ')GOTO1120
      GOTO1190
 1110 CONTINUE
      ISHIFT=2
      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGA3,IERROR)
      IHARG(3)='SORT'
      IHARG2(3)='C   '
      GOTO1190
 1120 CONTINUE
      ISHIFT=1
      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGA3,IERROR)
      IHARG(3)='SORT'
      IHARG2(3)='C   '
      GOTO1190
 1190 CONTINUE
C
C               **************************************
C               **  CHECK FOR   SORT BY  <STAT>     **
C               **************************************
C
CCCCC DECEMBER 2005: SORT BY <STAT>
CCCCC ONLY SUPPORT FOR STATISTICS WITH A SINGLE VARIABLE (I.E.,
CCCCC NO "DIFFERENCE OF", "WEIGHTED", OR 2-VARIABLE STATISTICS).
CCCCC PARSE HERE TO DISTINGUISH FROM SORT COMMAND.
CCCCC SET ICASS7 FOR SUBSEQUENT USE IN DPMATC SUBROUTINE.
CCCCC MARCH 2009: USE "EXTSTA" TO PARSE.  FOR THIS CASE,
CCCCC             ONLY COUNT A MATCH FOR STATISTICS USING A
CCCCC             SINGLE RESPONSE VARIABLE.
C
      ISTEPN='1A'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.6.AND.IHARG(4).EQ.'SORT'.AND.IHARG(5).EQ.'BY  ')THEN
        JMIN=6
        JMAX=MIN(NUMARG,JMIN+6)
        CALL EXTSTA(ICOM,ICOM2,IHARG,IHARG2,IARGT,ARG,NUMARG,JMIN,JMAX,
     1              ICASS7,ISTANM,ISTANR,ISTADF,IFOUN7,ILOCV,
     1              ISUBRO,IBUGA3,IERROR)
C
        IF(ISTANR.GT.1)IFOUN7='NO'
        ICASL7='SRTB'
        IF(IFOUN7.EQ.'YES')GOTO8020
      ENDIF
C
      ISTEPN='2A'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'SORT'.AND.IHARG2(3).EQ.'    ')GOTO1201
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'RANK'.AND.IHARG(4).EQ.'INDE')GOTO5294
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'PERC'.AND.IHARG(4).EQ.'RANK')GOTO5299
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'RANK'.AND.IHARG2(3).EQ.'    ')GOTO1202
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'CODE'.AND.IHARG(4).EQ.'CROS'.AND.
     1IHARG(5).EQ.'TABU')GOTO5300
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'CODE'.AND.IHARG(4).EQ.'DEX '.AND.
     1IHARG(5).EQ.'2   '.AND.IHARG(6).EQ.'LEVE')GOTO1234
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'DEX '.AND.IHARG(4).EQ.'CODE'.AND.
     1IHARG(5).EQ.'2   '.AND.IHARG(6).EQ.'LEVE')GOTO1234
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'CODE'.AND.IHARG(4).EQ.'DEX '.AND.
     1IHARG(5).EQ.'2LEV')GOTO1235
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'DEX '.AND.IHARG(4).EQ.'CODE'.AND.
     1IHARG(5).EQ.'2LEV')GOTO1235
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CODE'.AND.IHARG(4).EQ.'DEX ')GOTO1233
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'DEX '.AND.IHARG(4).EQ.'CODE')GOTO1233
CCCCC ADD FOLLOWING 2 LINES FEBRUARY 1998.
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'    ')GOTO1203
CCCCC ADD FOLLOWING 2 LINES FEBRUARY 1998.
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'D   ')GOTO1203
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'DIST'.AND.IHARG2(3).EQ.'INCT')GOTO1204
CCCCC AUGUST 2008. ADD FOLLOWING SECTION.
      IF(NUMARG.GE.7.AND.
     1IHARG(3).EQ.'DIFF'.AND.IHARG(4).EQ.'OF'.AND.
     1IHARG(5).EQ.'PROP'.AND.IHARG(6).EQ.'HYPO'.AND.
     1IHARG(7).EQ.'TEST')GOTO5264
C
      IF(NUMARG.GE.9.AND.
     1IHARG(3).EQ.'DIFF'.AND.IHARG(4).EQ.'OF'.AND.
     1IHARG(5).EQ.'PROP'.AND.IHARG(6).EQ.'LOWE'.AND.
     1IHARG(7).EQ.'TAIL'.AND.IHARG(8).EQ.'HYPO'.AND.
     1IHARG(9).EQ.'TEST')GOTO5266
C
      IF(NUMARG.GE.9.AND.
     1IHARG(3).EQ.'DIFF'.AND.IHARG(4).EQ.'OF'.AND.
     1IHARG(5).EQ.'PROP'.AND.IHARG(6).EQ.'UPPE'.AND.
     1IHARG(7).EQ.'TAIL'.AND.IHARG(8).EQ.'HYPO'.AND.
     1IHARG(9).EQ.'TEST')GOTO5268
C
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'DIFF'.AND.IHARG2(3).EQ.'EREN')GOTO1205
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'SEQU'.AND.IHARG(4).EQ.'DIFF')GOTO1206
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'SEQU'.AND.IHARG(4).EQ.'SUM ')GOTO31206
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'SEQU'.AND.IHARG(4).EQ.'PROD')GOTO41207
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'SEQU'.AND.IHARG(4).EQ.'MEAN')GOTO31208
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'SEQU'.AND.IHARG(4).EQ.'AVER')GOTO31208
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'SEQU'.AND.IHARG(4)(1:3).EQ.'MIN')GOTO31209
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'SEQU'.AND.IHARG(4)(1:3).EQ.'MAX')GOTO31210
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'SEQU'.AND.IHARG(4).EQ.'LOWE')GOTO31211
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'SEQU'.AND.IHARG(4).EQ.'UPPE')GOTO31212
C
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'SEQU'.AND.IHARG(5).EQ.'DIFF')GOTO51206
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'SEQU'.AND.IHARG(5).EQ.'SUM ')GOTO51207
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'SEQU'.AND.IHARG(5).EQ.'PROD')GOTO51208
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'SEQU'.AND.IHARG(5).EQ.'MEAN')GOTO51209
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'SEQU'.AND.IHARG(5).EQ.'AVER')GOTO51209
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'SEQU'.AND.IHARG(5)(1:3).EQ.'MIN')GOTO51210
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'SEQU'.AND.IHARG(5)(1:3).EQ.'MAX')GOTO51211
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'SEQU'.AND.IHARG(5).EQ.'LOWE')GOTO51212
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'SEQU'.AND.IHARG(5).EQ.'UPPE')GOTO51213
C
CCCCC ADD FOLLOWING 2 LINES MAY 1998.
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'INTE'.AND.IHARG(4).EQ.'TIME')GOTO11206
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CUMU'.AND.IHARG(4).EQ.'DIFF')GOTO21206
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CUMU'.AND.IHARG(4).EQ.'SUM ')GOTO1207
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CUMU'.AND.IHARG(4).EQ.'MINI')GOTO21207
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CUMU'.AND.IHARG(4).EQ.'MIN ')GOTO21207
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CUMU'.AND.IHARG(4).EQ.'MAXI')GOTO31207
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CUMU'.AND.IHARG(4).EQ.'MAX ')GOTO31207
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CUMU'.AND.IHARG(4).EQ.'AVER')GOTO11207
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CUMU'.AND.IHARG(4).EQ.'HAZA')GOTO11209
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'HAZA')GOTO11210
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CUMU'.AND.IHARG(4).EQ.'MEAN')GOTO11207
CCCCC ADD FOLLOWING 2 LINES OCTOBER 2001.
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'MATC')GOTO11213
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'REPL')GOTO11214
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CELL' .AND. IHARG(4).EQ.'MATC')GOTO11215
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'EXPO'.AND.IHARG(4).EQ.'SMOO')GOTO11211
C
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'REVE')GOTO11208
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'FLIP')GOTO11208
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CUMU'.AND.IHARG(4).EQ.'PROD')GOTO1208
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CUMU'.AND.IHARG(4).EQ.'INTE')GOTO1209
C
C               **************************************
C               **  CHECK FOR CUMULATIVE <STAT>     **
C               **************************************
C
C     PUT THIS CODE HERE SO AS TO ALLOW PREVIOUSLY ENTERED
C     "CUMULATIVE" COMMANDS TO REMAIN.  THIS COMMAND WILL
C     USE A BRUTE FORCE METHOD WHILE SOME OF THE ABOVE COMMANDS
C     WILL BE MORE EFFICIENT.
C
      ISTEPN='2B'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.5.AND.IHARG(3).EQ.'CUMU')THEN
        ICASL7='CUMU'
        IF(IFOUN7.EQ.'YES')GOTO8020
        JMIN=4
        JMAX=MIN(NUMARG,JMIN+6)
        CALL EXTSTA(ICOM,ICOM2,IHARG,IHARG2,IARGT,ARG,NUMARG,JMIN,JMAX,
     1              ICASS7,ISTANM,ISTANR,ISTADF,IFOUN7,ILOCV,
     1              ISUBRO,IBUGA3,IERROR)
C
        ICASL7='CUMU'
        IF(IFOUN7.EQ.'YES')GOTO8020
      ENDIF
C
      ISTEPN='2C'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CONV'.AND.IHARG2(3).EQ.'OLUT')GOTO1210
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'DECO'.AND.IHARG2(3).EQ.'NVOL')GOTO1211
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'SORT'.AND.IHARG2(3).EQ.'C   ')GOTO1212
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'FREQ'.AND.IHARG(4).EQ.'TO  '.AND.
     1IHARG(5).EQ.'RAW ')GOTO5190
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'FREQ'.AND.IHARG2(3).EQ.'UENC')GOTO1213
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'SUMD'.AND.IHARG2(3).EQ.'    ')GOTO1216
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'INTE'.AND.IHARG2(3).EQ.'RPOL')GOTO1217
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'SPLI'.AND.IHARG(4).EQ.'INTE')GOTO1218
CCCCC FOLLOWING 8 LINES ADDED MAY, 1994.
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'LINE'.AND.IHARG(4).EQ.'INTE'.AND.IHARG2(4).NE.'RCEP')
     1GOTO1219
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'2D  '.AND.IHARG(4).EQ.'INTE')GOTO1249
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'BILI'.AND.IHARG(4).EQ.'INTE')GOTO1248
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'BIVA'.AND.IHARG(4).EQ.'INTE')GOTO1250
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'HERM'.AND.IHARG(4).EQ.'INTE'.AND.
     1IHARG2(4).EQ.'RPOL')GOTO11218
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'HERM'.AND.IHARG(4).EQ.'INTE'.AND.
     1IHARG2(4).EQ.'GRAT')GOTO11219
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'DEX '.AND.IHARG(4).EQ.'CORE')GOTO11221
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'DEX '.AND.IHARG(5).EQ.'CONF')GOTO11222
      IF(NUMARG.GE.5.AND.IHARG(3).EQ.'DEX '.AND.
     1IHARG(4).EQ.'CHEC'.AND.IHARG(5).EQ.'CLAS')GOTO11223
      IF(NUMARG.GE.6.AND.IHARG(3).EQ.'DEX '.AND.
     1IHARG(4).EQ.'CHEC'.AND.IHARG(5).EQ.'CENT'.AND.
     1IHARG(6).EQ.'POIN')GOTO11224
C
      ISTEPN='2D'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'H   ')GOTO1220
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'1   ')GOTO1221
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'2   ')GOTO1222
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'3   ')GOTO1223
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'4   ')GOTO1224
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'5   ')GOTO1225
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'6   ')GOTO1226
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'7   ')GOTO1227
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'8   ')GOTO1228
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'9   ')GOTO1229
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'10  ')GOTO1230
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'Z   ')GOTO1231
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CODE'.AND.IHARG2(3).EQ.'X   ')GOTO1232
C
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'BIWE'.AND.IHARG2(3).EQ.'IGHT'.AND.
     1IHARG(4).NE.'LOCA'.AND.IHARG(4).NE.'SCAL')GOTO1241
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'TRIC'.AND.IHARG2(3).EQ.'UBE')GOTO1242
C
      IF(NUMARG.GE.4.AND.
     1IHARG(4).EQ.'FRAC'.AND.IHARG2(4).EQ.'TAL')GOTO1243
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'SINE'.AND.IHARG(4).EQ.'TRAN')GOTO1251
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'SIN'.AND.IHARG(4).EQ.'TRAN')GOTO1251
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'COSI'.AND.IHARG(4).EQ.'TRAN')GOTO1252
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'COS'.AND.IHARG(4).EQ.'TRAN')GOTO1252
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'BREA'.AND.IHARG(4).EQ.'LOCA')GOTO4252
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'FRAG'.AND.IHARG(4).EQ.'LOCA')GOTO4253
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'FRAG'.AND.IHARG(4).EQ.'CENT')GOTO4253
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'FRAG'.AND.IHARG(4).EQ.'LENG')GOTO4254
C
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'2D  '.AND.IHARG(5).EQ.'GRID')GOTO4256
      IF(NUMARG.GE.6.AND.
     1IHARG(5).EQ.'3D  '.AND.IHARG(6).EQ.'GRID')GOTO4258
      IF(NUMARG.GE.7.AND.
     1IHARG(6).EQ.'4D  '.AND.IHARG(7).EQ.'GRID')GOTO4260
C
      ISTEPN='2E'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'FOUR'.AND.IHARG(5).EQ.'TRAN')GOTO1253
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'INVE'.AND.IHARG(5).EQ.'FOUR'.AND.
     1IHARG(6).EQ.'TRAN')GOTO1254
      IF(NUMARG.GE.4.AND.
     1IHARG(4).EQ.'FFT '.AND.IHARG2(4).EQ.'    ')GOTO1255
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'INVE'.AND.IHARG(5).EQ.'FFT')GOTO1256
C
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'PEAK'.AND.IHARG(5).EQ.'OF  '.AND.
     1IHARG(6).EQ.'FREQ'.AND.IHARG(7).EQ.'TABL')GOTO55112
      IF(NUMARG.GE.8.AND.
     1IHARG(4).EQ.'RELAT'.AND.
     1IHARG(5).EQ.'PEAK'.AND.IHARG(6).EQ.'OF  '.AND.
     1IHARG(7).EQ.'FREQ'.AND.IHARG(8).EQ.'TABL')GOTO55114
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'FREQ'.AND.IHARG(5).EQ.'TABL'.AND.
     1IHARG(6).EQ.'PEAK')GOTO55113
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'RELAT'.AND.
     1IHARG(5).EQ.'FREQ'.AND.IHARG(6).EQ.'TABL'.AND.
     1IHARG(7).EQ.'PEAK')GOTO55115
C
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'PEAK'.AND.IHARG(4).EQ.'TRIA'.AND.
     1IHARG(5).EQ.'AREA')GOTO55212
      IF(NUMARG.GE.4.AND.
     1IHARG(4).EQ.'PEAK')GOTO55214
C
      IF(NUMARG.GE.6.AND.
     1IHARG(5).EQ.'CODE' .AND. IHARG(6).EQ.'BINN')GOTO5108
      IF(NUMARG.GE.6.AND.
     1IHARG(5).EQ.'BINN' .AND. IHARG(6).EQ.'CODE')GOTO5108
      IF(NUMARG.GE.7.AND.
     1IHARG(5).EQ.'RELA' .AND. IHARG(6).EQ.'CODE' .AND.
     1IHARG(7).EQ.'BINN')GOTO5109
      IF(NUMARG.GE.7.AND.
     1IHARG(5).EQ.'CODE' .AND. IHARG(6).EQ.'RELA' .AND.
     1IHARG(7).EQ.'BINN')GOTO5109
      IF(NUMARG.GE.7.AND.
     1IHARG(5).EQ.'RELA' .AND. IHARG(6).EQ.'BINN' .AND.
     1IHARG(7).EQ.'CODE')GOTO5109
      IF(NUMARG.GE.4.AND.
     1IHARG(4).EQ.'BINN')GOTO5110
      IF(NUMARG.GE.4.AND.
     1IHARG(4).EQ.'BIN ')GOTO5110
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'FREQ'.AND.IHARG(5).EQ.'TABL')GOTO5112
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'RELA'.AND.IHARG(5).EQ.'BINN')GOTO5114
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'RELA'.AND.IHARG(5).EQ.'BIN ')GOTO5114
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'RELA'.AND.IHARG(5).EQ.'FREQ'.AND.
     1IHARG(6).EQ.'TABL')GOTO5116
C
      ISTEPN='2F'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'LAPL'.AND.IHARG(4).EQ.'TRAN')GOTO1261
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'INVE'.AND.IHARG(4).EQ.'LAPL'.AND.
     1IHARG(5).EQ.'TRAN')GOTO1262
C
CCCCC THE FOLLOWING 6 LINES WERE ADDED JANUARY 1989
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'BOOT'.AND.IHARG(4).EQ.'SAMP')GOTO1271
CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT JANUARY 1990
CCCCC IF(NUMARG.GE.4.AND.
CCCCC1IHARG(3).EQ.'RAND'.AND.IHARG(4).EQ.'SAMP')GOTO1271
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'JACK'.AND.IHARG(4).EQ.'SAMP')GOTO1271
C
CCCCC THE FOLLOWING 6 LINES WERE ADDED JANUARY 1990
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'SUBS')GOTO1272
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'RAND'.AND.IHARG(4).EQ.'SAMP')GOTO1273
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'RAND'.AND.IHARG(4).EQ.'SUBS')GOTO1273
CCCCC THE FOLLOWING 2 LINES WERE ADDED OCTOBER 1993
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'JACK'.AND.IHARG(4).EQ.'INDE')GOTO1274
C
      IF(NUMARG.GE.6.AND.IHARG(4).EQ.'SAMP'.AND.
     1IHARG(5).EQ.'RAND'.AND.IHARG(6).EQ.'PERM')GOTO1275
C
C               ***********************************************
C               **  CHECK FOR   COMPLEX ARITHMETIC SUBCASES  **
C               ***********************************************
C
      ISTEPN='2G'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.5.AND.IHARG(4).EQ.'COMP')GOTO1010
      GOTO1019
C
 1010 CONTINUE
      IF(IHARG(5).EQ.'ADDI')GOTO2101
      IF(IHARG(5).EQ.'SUBT')GOTO2102
      IF(IHARG(5).EQ.'MULT')GOTO2103
      IF(IHARG(5).EQ.'DIVI')GOTO2104
      IF(IHARG(5).EQ.'EXPO')GOTO2105
      IF(NUMARG.GE.6.AND.
     1   IHARG(5).EQ.'SQUA'.AND.IHARG(6).EQ.'ROOT')GOTO2106
      IF(IHARG(5).EQ.'ROOT')GOTO2107
      IF(IHARG(5).EQ.'ZERO')GOTO2107
      IF(IHARG(5).EQ.'CONJ')GOTO2108
 1019 CONTINUE
C
C               **************************************************
C               **  CHECK FOR   POLYNOMIAL ARITHMETIC SUBCASES  **
C               **************************************************
C
      ISTEPN='2H'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'POLY')GOTO1020
      IF(NUMARG.GE.5.AND.IHARG(4).EQ.'POLY'.AND.
     1   IHARG(5).EQ.'DIVI')GOTO2204
      GOTO1029
C
 1020 CONTINUE
      IF(IHARG(4).EQ.'ADDI')GOTO2201
      IF(IHARG(4).EQ.'SUBT')GOTO2202
      IF(IHARG(4).EQ.'MULT')GOTO2203
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'SQUA'.AND.IHARG(5).NE.'ROOT')GOTO2205
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'SQUA'.AND.IHARG(5).EQ.'ROOT')GOTO2206
      IF(IHARG(4).EQ.'GCD')GOTO2207
      IF(IHARG(4).EQ.'LCM')GOTO2208
      IF(IHARG(4).EQ.'EVAL')GOTO2209
      IF(IHARG(4).EQ.'ADDI')GOTO2210
 1029 CONTINUE
C
C               **************************************************
C               **  CHECK FOR   VECTOR     ARITHMETIC SUBCASES  **
C               **************************************************
C
      ISTEPN='2I'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'VECT'.AND.
     1   IHARG(4).NE.'PERC')GOTO1030
      GOTO1039
C
 1030 CONTINUE
      IF(IHARG(4).EQ.'ADDI')GOTO2301
      IF(IHARG(4).EQ.'SUBT')GOTO2302
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'DOT'.AND.IHARG(5).EQ.'PROD')GOTO2303
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'INNE'.AND.IHARG(5).EQ.'PROD')GOTO2303
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'CROS'.AND.IHARG(5).EQ.'PROD')GOTO2304
      IF(IHARG(4).EQ.'LENG')GOTO2305
      IF(IHARG(4).EQ.'MAGN')GOTO2305
      IF(IHARG(4).EQ.'DIST')GOTO2306
      IF(IHARG(4).EQ.'ANGL')GOTO2307
 1039 CONTINUE
C
C               **************************************************
C               **  CHECK FOR   SET        ARITHMETIC SUBCASES  **
C               **************************************************
C
      ISTEPN='2J'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'SET ')GOTO1040
      IF(NUMARG.GE.6.AND.IHARG(4).EQ.'SET '.AND.
     1   IHARG(5).EQ.'CART'.AND.IHARG(6).EQ.'PROD')GOTO2405
      GOTO1049
C
 1040 CONTINUE
      IF(IHARG(4).EQ.'UNIO')GOTO2401
      IF(IHARG(4).EQ.'ADDI')GOTO2401
      IF(IHARG(4).EQ.'INTE')GOTO2402
      IF(IHARG(4).EQ.'COMP')GOTO2403
      IF(IHARG(4).EQ.'CARD')GOTO2404
      IF(IHARG(4).EQ.'ELEM')GOTO2406
      IF(IHARG(4).EQ.'DIST')GOTO2406
 1049 CONTINUE
C
C               **************************************************
C               **  CHECK FOR   LOGICAL    ARITHMETIC SUBCASES  **
C               **************************************************
C
      ISTEPN='2K'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'LOGI')GOTO1050
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'BOOL')GOTO1050
      GOTO1059
C
 1050 CONTINUE
      IF(IHARG(4).EQ.'AND')GOTO2501
      IF(IHARG(4).EQ.'CONJ')GOTO2501
      IF(IHARG(4).EQ.'MULT')GOTO2501
      IF(IHARG(4).EQ.'OR')GOTO2502
      IF(IHARG(4).EQ.'DISJ')GOTO2502
      IF(IHARG(4).EQ.'ADDI')GOTO2502
      IF(IHARG(4).EQ.'NAND')GOTO2503
      IF(IHARG(4).EQ.'NOR')GOTO2504
      IF(IHARG(4).EQ.'IMPL')GOTO2505
      IF(IHARG(4).EQ.'IFTH')GOTO2505
      IF(IHARG(4).EQ.'EQUI')GOTO2506
      IF(IHARG(4).EQ.'IFF')GOTO2506
      IF(IHARG(4).EQ.'NOT')GOTO2507
      IF(IHARG(4).EQ.'NEGA')GOTO2507
      IF(IHARG(4).EQ.'COMP')GOTO2507
      IF(IHARG(4).EQ.'XOR')GOTO2508
 1059 CONTINUE
C
C               **************************************************
C               **  CHECK FOR   MATRIX     ARITHMETIC SUBCASES  **
C               **************************************************
C
CCCCC AUGUST 2017: USE "EXTSTA" TO PARSE   GENERATE MATRIX <STAT>.
CCCCC              ONLY COUNT A MATCH FOR STATISTICS HAVING EXACTLY
CCCCC              TWO RESPONSE VARIABLES.
C
      ISTEPN='2L'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'GENE'.AND.
     1   IHARG(4).EQ.'MATR')THEN
C
        JMIN=5
        JMAX=MIN(NUMARG,JMIN+6)
        CALL EXTSTA(ICOM,ICOM2,IHARG,IHARG2,IARGT,ARG,NUMARG,
     1              JMIN,JMAX,
     1              ICASS7,ISTANM,ISTANR,ISTADF,IFOUN7,ILOCV,
     1              ISUBRO,IBUGA3,IERROR)
C
        IF(ISTANR.NE.2)THEN
          IFOUN7='NO'
          GOTO9000
        ENDIF
        ICASL7='GMST'
        IF(IFOUN7.EQ.'YES')GOTO8020
      ENDIF
C
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'MATR')GOTO1060
      GOTO1065
C
 1060 CONTINUE
      IF(IHARG(4).EQ.'ADDI')GOTO2601
      IF(IHARG(4).EQ.'SUBT')GOTO2602
      IF(IHARG(4).EQ.'MULT')GOTO2603
      IF(IHARG(4).EQ.'SOLU')GOTO2604
      IF(IHARG(4).EQ.'INVE')GOTO2605
      IF(IHARG(4).EQ.'TRAN')GOTO2606
      IF(IHARG(4).EQ.'ADJO')GOTO2607
      IF(IHARG(4).EQ.'TRUN')GOTO2668
      IF(IHARG(4).EQ.'LOWE'.AND.IHARG(5).EQ.'TRUN')GOTO2669
      IF(IHARG(4).EQ.'UPPE'.AND.IHARG(5).EQ.'TRUN')GOTO2670
CCCCC OCTOBER 1993.  ADD FOLLOWING LINE
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ITER'.AND.IHARG(5).EQ.'SOLU')GOTO2962
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'CHAR'.AND.IHARG(5).EQ.'EQUA')GOTO2608
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'CHAR'.AND.IHARG(5).EQ.'FUNC')GOTO2608
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'CHAR'.AND.IHARG(5).EQ.'POLY')GOTO2608
      IF(IHARG(4).EQ.'EIGE'.AND.IHARG2(4).EQ.'NVAL')GOTO2609
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'CHAR'.AND.IHARG(5).EQ.'VALU')GOTO2610
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'LATE'.AND.IHARG(5).EQ.'ROOT')GOTO2610
      IF(IHARG(4).EQ.'EIGE'.AND.IHARG2(4).EQ.'NVEC')GOTO2611
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'PRIN'.AND.IHARG(5).EQ.'AXES')GOTO2612
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'PRIN'.AND.IHARG(5).EQ.'AXIS')GOTO2612
      IF(IHARG(4).EQ.'RANK')GOTO2613
      IF(IHARG(4).EQ.'DETE')GOTO2614
      IF(IHARG(4).EQ.'PERM')GOTO2615
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'SPEC'.AND.IHARG(5).EQ.'NORM')GOTO2616
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'SPEC'.AND.IHARG(5).EQ.'RADI')GOTO2617
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'NUMB'.AND.IHARG(5).EQ.'ROWS')GOTO2618
      IF(NUMARG.GE.6.AND.
     1   IHARG(4).EQ.'NUMB'.AND.IHARG(5).EQ.'OF'.AND.
     1   IHARG(6).EQ.'ROWS')GOTO2619
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'NUMB'.AND.IHARG(5).EQ.'COLU')GOTO2620
      IF(NUMARG.GE.6.AND.
     1   IHARG(4).EQ.'NUMB'.AND.IHARG(5).EQ.'OF'.AND.
     1   IHARG(6).EQ.'COLU')GOTO2621
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'SIMP'.AND.IHARG(5).EQ.'SOLU')GOTO2622
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'SIMP'.AND.IHARG(5).EQ.'METH')GOTO2622
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'LINE'.AND.IHARG(5).EQ.'PROG')GOTO2622
      IF(NUMARG.GE.4.AND.
     1   IHARG(4).EQ.'LP'.AND.IHARG2(4).EQ.'    ')GOTO2623
      IF(IHARG(4).EQ.'RENU')GOTO2624
      IF(IHARG(4).EQ.'TRAC')GOTO2631
      IF(IHARG(4).EQ.'SUBM')GOTO2632
      IF(IHARG(4).EQ.'MINO')GOTO2633
      IF(IHARG(4).EQ.'COFA')GOTO2634
      IF(IHARG(4).EQ.'DEFI')GOTO2635
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'EUCL'.AND.IHARG(5).EQ.'NORM')GOTO2636
      IF(IHARG(4).EQ.'NORM')GOTO2637
CCCCC OCTOBER 1993.  ADD FOLLOWING LINES.
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'CHOL'.AND.IHARG(5).EQ.'DECO')GOTO2651
      IF(IHARG(4).EQ.'CHOL')GOTO2652
      IF(IHARG(4).EQ.'AUGM')GOTO2902
      IF(IHARG(4).EQ.'DIAG')GOTO2912
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'REPL'.AND.IHARG(5).EQ.'ROW ')GOTO2922
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'REPL'.AND.IHARG(5).EQ.'ELEM')GOTO2932
CCCCC FOLLOWING SECTION AUGUST 1998.
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ADD '.AND.IHARG(5).EQ.'ROW ')GOTO5088
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'DELE'.AND.IHARG(5).EQ.'ROW ')GOTO5090
      IF(NUMARG.GE.4.AND.IHARG(4).EQ.'MEAN')GOTO5092
      IF(NUMARG.GE.4.AND.IHARG(4).EQ.'SUM ')GOTO5093
CCCCC END CHANGE
CCCCC FOLLOWING SECTION SEPTEMBER 1998.
C
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GROU'.AND.IHARG(5).EQ.'MEAN')GOTO5102
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GROU'.AND.IHARG(5).EQ.'SD  ')GOTO5104
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GROU'.AND.IHARG(5).EQ.'STAN'.AND.
     1IHARG(6).EQ.'DEVI')GOTO5106
C
CCCCC MARCH 2009: USE "EXTSTA" TO PARSE ROW/COLUMN/GRAND/PARTITION
CCCCC             <STAT>.  ONLY COUNT A MATCH FOR STATISTICS USING A
CCCCC             SINGLE RESPONSE VARIABLE.
CCCCC
CCCCC             TREAT THE "CRAMER CONT COEF" AND
CCCCC             "PEARSON CONT COEFF" AS SPECIAL CASES AS THESE
CCCCC             ARE ONLY APPLICABLE TO "MATRIX GRAND" AND ARE
CCCCC             NOT FUNNELLED THROUGH "EXTSTA" AND "CMPSTA".
C
      IF(NUMARG.GE.4.AND.
     1  (IHARG(4).EQ.'ROW ' .OR. IHARG(4).EQ.'COLU' .OR.
     1   IHARG(4).EQ.'GRAN' .OR. IHARG(4).EQ.'PART'))THEN
C
        JMIN=5
        JMAX=MIN(NUMARG,JMIN+6)
        IF(IHARG(JMIN).EQ.'CRAM' .AND. IHARG(JMIN+1).EQ.'CONT' .AND.
     1     IHARG(JMIN+2).EQ.'COEF' .AND. IHARG(JMIN-1).EQ.'GRAN')THEN
          ICASL7='MGRA'
          ICASS7='CRAM'
          IFOUN7='YES'
          ILOCV=JMIN+3
        ELSEIF(IHARG(JMIN).EQ.'PEAR'.AND.IHARG(JMIN+1).EQ.'CONT'.AND.
     1     IHARG(JMIN+2).EQ.'COEF' .AND. IHARG(JMIN-1).EQ.'GRAN')THEN
          ICASL7='MGRA'
          ICASS7='PEAR'
          IFOUN7='YES'
          ILOCV=JMIN+3
        ELSE
          CALL EXTSTA(ICOM,ICOM2,IHARG,IHARG2,IARGT,ARG,NUMARG,
     1                JMIN,JMAX,
     1                ICASS7,ISTANM,ISTANR,ISTADF,IFOUN7,ILOCV,
     1                ISUBRO,IBUGA3,IERROR)
C
          IF(ISTANR.GT.1)IFOUN7='NO'
          ICASL7='MROW'
          IF(IHARG(4).EQ.'COLU')ICASL7='MCOL'
          IF(IHARG(4).EQ.'GRAN')ICASL7='MGRA'
          IF(IHARG(4).EQ.'PART')ICASL7='MPAR'
          IF(IFOUN7.EQ.'YES')GOTO8020
       ENDIF
      ENDIF
C
      ISTEPN='2M'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC SEPTEMBER 1993.  ADD FOLLOWING LINES.
      IF(IHARG(4).EQ.'ROW ')GOTO2649
      IF(IHARG(4).EQ.'ELEM')GOTO2650
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COND' .AND. IHARG(5).EQ.'NUMB')GOTO5134
      IF(NUMARG.GE.6.AND.IHARG(4).EQ.'RECI'.AND.
     1IHARG(5).EQ.'COND' .AND. IHARG(6).EQ.'NUMB')GOTO5136
CCCCC END CHANGE
 1065 CONTINUE
      IF(NUMARG.GE.5.AND.IHARG(3).EQ.'VARI'.AND.
     1   IHARG(4).EQ.'COVA'.AND.IHARG(5).EQ.'MATR')GOTO2641
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'CORR'.AND.
     1   IHARG(4).EQ.'MATR')GOTO2642
      IF(NUMARG.GE.5.AND.IHARG(3).EQ.'CORR'.AND.
     1   IHARG(4).EQ.'CDF'.AND.IHARG(5).EQ.'MATR')GOTO2659
      IF(NUMARG.GE.5.AND.IHARG(3).EQ.'CORR'.AND.
     1   IHARG(4).EQ.'PVAL'.AND.IHARG(5).EQ.'MATR')GOTO2660
      IF(NUMARG.GE.5.AND.IHARG(3).EQ.'PART'.AND.
     1   IHARG(4).EQ.'CORR'.AND.IHARG(5).EQ.'MATR')GOTO2656
      IF(NUMARG.GE.6.AND.IHARG(3).EQ.'PART'.AND.
     1   IHARG(4).EQ.'CORR'.AND.IHARG(5).EQ.'CDF'.AND.
     1   IHARG(6).EQ.'MATR')GOTO2657
      IF(NUMARG.GE.6.AND.IHARG(3).EQ.'PART'.AND.
     1   IHARG(4).EQ.'CORR'.AND.IHARG(5).EQ.'PVAL'.AND.
     1   IHARG(6).EQ.'MATR')GOTO2658
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'COMO'.AND.
     1   IHARG(4).EQ.'MATR')GOTO2672
C
      IF(NUMARG.GE.5.AND.IHARG(3).EQ.'PRIN'.AND.
     1   IHARG(4).EQ.'COMP'.AND.
     1   IHARG(5).EQ.'EIGE'.AND.IHARG2(5).EQ.'NVEC')GOTO2643
      IF(NUMARG.GE.5.AND.IHARG(3).EQ.'PRIN'.AND.
     1   IHARG(4).EQ.'COMP'.AND.
     1   IHARG(5).EQ.'EIGE'.AND.IHARG2(5).EQ.'NVAL')GOTO2644
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'PRIN'.AND.
     1   IHARG(4).EQ.'COMP')GOTO2645
C
      IF(NUMARG.GE.6.AND.IHARG(4).EQ.'PRIN'.AND.
     1   IHARG(5).EQ.'COMP'.AND.
     1   IHARG(6).EQ.'EIGE'.AND.IHARG2(6).EQ.'NVEC')GOTO2653
      IF(NUMARG.GE.6.AND.IHARG(4).EQ.'PRIN'.AND.
     1   IHARG(5).EQ.'COMP'.AND.
     1   IHARG(6).EQ.'EIGE'.AND.IHARG2(6).EQ.'NVAL')GOTO2654
      IF(NUMARG.GE.5.AND.IHARG(4).EQ.'PRIN'.AND.
     1   IHARG(5).EQ.'COMP')GOTO2655
C
      IF(IHARG(3).EQ.'EIGE'.AND.IHARG2(3).EQ.'NVEC')GOTO2661
      IF(IHARG(3).EQ.'EIGE'.AND.IHARG2(3).EQ.'NVAL')GOTO2662
CCCCC JULY 1993.  FOLLOWING LINES ADDED FOR MATRIX SINGULAR VALUES AND
CCCCC MATRIX SINGULAR VALUE DECOMPOSITION.
      IF(NUMARG.GE.7.AND.
     1   IHARG(5).EQ.'SING'.AND.IHARG(6).EQ.'VALU'.AND.
     1   IHARG(7).EQ.'DECO')GOTO2646
      IF(NUMARG.GE.7.AND.
     1   IHARG(5).EQ.'SING'.AND.IHARG(6).EQ.'VALU'.AND.
     1   IHARG(7).EQ.'FACT')GOTO2648
      IF(NUMARG.GE.4.AND.
     1   IHARG(3).EQ.'SING'.AND.IHARG(4).EQ.'VALU')GOTO2647
CCCCC OCTOBER 1993.  ADD FOLLOWING LINES.
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CHOL'.AND.IHARG(4).EQ.'DECO')GOTO2652
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CHOL')GOTO2666
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'DIAG'.AND.IHARG(4).EQ.'MATR')GOTO2942
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'TRID'.AND.IHARG(4).EQ.'SOLV')GOTO2952
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'TRID'.AND.IHARG(4).EQ.'SOLU')GOTO2952
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'TRIA'.AND.IHARG(4).EQ.'SOLV')GOTO2972
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'TRIA'.AND.IHARG(4).EQ.'SOLU')GOTO2972
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'TRIA'.AND.IHARG(4).EQ.'INVE')GOTO2982
CCCCC END CHANGE
CCCCC JUNE 1998.  ADD FOLLOWING LINES.
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'PSEU'.AND.IHARG(4).EQ.'INVE')GOTO5002
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'QUAD'.AND.IHARG(4).EQ.'FORM')GOTO5012
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'LINE'.AND.IHARG(4).EQ.'COMB')GOTO5096
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'VECT'.AND.IHARG(4).EQ.'TIME'.AND.
     1IHARG(5).EQ.'TRAN')GOTO5098
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'HOTE'.AND.IHARG(4).EQ.'1   '.AND.
     1IHARG(5).EQ.'SAMP'.AND.IHARG(6).EQ.'T2  ')GOTO5022
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'HOTE'.AND.IHARG(4).EQ.'1   '.AND.
     1IHARG(5).EQ.'SAMP'.AND.IHARG(6).EQ.'TSQU')GOTO5022
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'HOTE'.AND.IHARG(4).EQ.'ONE '.AND.
     1IHARG(5).EQ.'SAMP'.AND.IHARG(6).EQ.'TSQU')GOTO5022
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'HOTE'.AND.IHARG(4).EQ.'ONE '.AND.
     1IHARG(5).EQ.'SAMP'.AND.IHARG(6).EQ.'T2  ')GOTO5022
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'HOTE'.AND.IHARG(4).EQ.'2   '.AND.
     1IHARG(5).EQ.'SAMP'.AND.IHARG(6).EQ.'TSQU')GOTO5023
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'HOTE'.AND.IHARG(4).EQ.'2   '.AND.
     1IHARG(5).EQ.'SAMP'.AND.IHARG(6).EQ.'T2  ')GOTO5023
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'HOTE'.AND.IHARG(4).EQ.'TWO '.AND.
     1IHARG(5).EQ.'SAMP'.AND.IHARG(6).EQ.'TSQU')GOTO5023
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'HOTE'.AND.IHARG(4).EQ.'TWO '.AND.
     1IHARG(5).EQ.'SAMP'.AND.IHARG(6).EQ.'T2  ')GOTO5023
C
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'EUCL'.AND.IHARG(4).EQ.'ROW '.AND.
     1IHARG(5).EQ.'DIST')GOTO5032
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'EUCL'.AND.IHARG(4).EQ.'COLU'.AND.
     1IHARG(5).EQ.'DIST')GOTO5033
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'MAHA'.AND.IHARG(4).EQ.'ROW '.AND.
     1IHARG(5).EQ.'DIST')GOTO5042
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'MAHA'.AND.IHARG(4).EQ.'COLU'.AND.
     1IHARG(5).EQ.'DIST')GOTO5044
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'MINK'.AND.IHARG(4).EQ.'ROW '.AND.
     1IHARG(5).EQ.'DIST')GOTO5062
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'MINK'.AND.IHARG(4).EQ.'COLU'.AND.
     1IHARG(5).EQ.'DIST')GOTO5064
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'BLOC'.AND.IHARG(4).EQ.'ROW '.AND.
     1IHARG(5).EQ.'DIST')GOTO5072
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'MANH'.AND.IHARG(4).EQ.'ROW '.AND.
     1IHARG(5).EQ.'DIST')GOTO5072
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'BLOC'.AND.IHARG(4).EQ.'COLU'.AND.
     1IHARG(5).EQ.'DIST')GOTO5074
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'MANH'.AND.IHARG(4).EQ.'COLU'.AND.
     1IHARG(5).EQ.'DIST')GOTO5074
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'CHEB'.AND.IHARG(4).EQ.'ROW '.AND.
     1IHARG(5).EQ.'DIST')GOTO5082
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'CHEB'.AND.IHARG(4).EQ.'COLU'.AND.
     1IHARG(5).EQ.'DIST')GOTO5084
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'COSI'.AND.IHARG(4).EQ.'ROW '.AND.
     1IHARG(5).EQ.'SIMI')GOTO5034
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'COSI'.AND.IHARG(4).EQ.'COLU'.AND.
     1IHARG(5).EQ.'SIMI')GOTO5035
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'COSI'.AND.IHARG(4).EQ.'ROW '.AND.
     1IHARG(5).EQ.'DIST')GOTO5036
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'COSI'.AND.IHARG(4).EQ.'COLU'.AND.
     1IHARG(5).EQ.'DIST')GOTO5037
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'JACC'.AND.IHARG(4).EQ.'ROW '.AND.
     1IHARG(5).EQ.'SIMI')GOTO5038
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'JACC'.AND.IHARG(4).EQ.'COLU'.AND.
     1IHARG(5).EQ.'SIMI')GOTO5039
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'JACC'.AND.IHARG(4).EQ.'ROW '.AND.
     1IHARG(5).EQ.'DIST')GOTO5040
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'JACC'.AND.IHARG(4).EQ.'COLU'.AND.
     1IHARG(5).EQ.'DIST')GOTO5041
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'ANGU'.AND.IHARG(4).EQ.'COSI'.AND.
     1IHARG(5).EQ.'ROW '.AND.IHARG(6).EQ.'SIMI')GOTO5045
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'ANGU'.AND.IHARG(4).EQ.'COSI'.AND.
     1IHARG(5).EQ.'COLU '.AND.IHARG(6).EQ.'SIMI')GOTO5046
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'ANGU'.AND.IHARG(4).EQ.'COSI'.AND.
     1IHARG(5).EQ.'ROW '.AND.IHARG(6).EQ.'DIST')GOTO5047
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'ANGU'.AND.IHARG(4).EQ.'COSI'.AND.
     1IHARG(5).EQ.'COLU '.AND.IHARG(6).EQ.'DIST')GOTO5048
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'PEAR'.AND.IHARG(4).EQ.'ROW '.AND.
     1IHARG(5).EQ.'DIST')GOTO5049
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'PEAR'.AND.IHARG(4).EQ.'ROW '.AND.
     1IHARG(5).EQ.'SIMI')GOTO55049
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'PEAR'.AND.IHARG(4).EQ.'COLU'.AND.
     1IHARG(5).EQ.'DIST')GOTO5050
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'PEAR'.AND.IHARG(4).EQ.'COLU'.AND.
     1IHARG(5).EQ.'SIMI')GOTO55050
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'HAMM'.AND.IHARG(4).EQ.'ROW '.AND.
     1IHARG(5).EQ.'DIST')GOTO5051
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'HAMM'.AND.IHARG(4).EQ.'COLU'.AND.
     1IHARG(5).EQ.'DIST')GOTO5053
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'CANB'.AND.IHARG(4).EQ.'ROW '.AND.
     1IHARG(5).EQ.'DIST')GOTO5054
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'CANB'.AND.IHARG(4).EQ.'COLU'.AND.
     1IHARG(5).EQ.'DIST')GOTO5055
C
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'POOL'.AND.IHARG(4).EQ.'VARI'.AND.
     1IHARG(5).EQ.'COVA'.AND.IHARG(6).EQ.'MATR')GOTO5086
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'POOL'.AND.IHARG(4).EQ.'COVA'.AND.
     1IHARG(5).EQ.'MATR')GOTO5087
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'QR  '.AND.IHARG(4).EQ.'DECO')GOTO5052
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'DIST'.AND.IHARG(4).EQ.'FROM'.AND.
     1IHARG(5).EQ.'MEAN')GOTO5094
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'MULT'.AND.IHARG(4).EQ.'NORM'.AND.
     1IHARG(5).EQ.'RAND'.AND.IHARG(6).EQ.'NUMB')GOTO5118
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'MULT'.AND.IHARG(4).EQ.'T   '.AND.
     1IHARG(5).EQ.'RAND'.AND.IHARG(6).EQ.'NUMB')GOTO5119
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CATC'.AND.IHARG(4).EQ.'MATR')GOTO5120
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'MULT'.AND.IHARG(4).EQ.'RAND'.AND.
     1IHARG(5).EQ.'NUMB')GOTO5122
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'MULT'.AND.IHARG(4).EQ.'PDF')GOTO5123
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'WISH'.AND.IHARG(4).EQ.'RAND'.AND.
     1IHARG(5).EQ.'NUMB')GOTO5124
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'DIRI'.AND.IHARG(4).EQ.'RAND'.AND.
     1IHARG(5).EQ.'NUMB')GOTO5125
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'DIRI'.AND.IHARG(4).EQ.'PDF')GOTO15125
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'DIRI'.AND.IHARG(4).EQ.'LOG'.AND.
     1IHARG(5).EQ.'PDF')GOTO15127
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'VARI'.AND.IHARG(4).EQ.'INFL'.AND.
     1IHARG(5).EQ.'FACT')GOTO5126
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'COND'.AND.IHARG(4).EQ.'INDI')GOTO5128
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'XTXI'.AND.IHARG(4).EQ.'MATR')GOTO5130
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CREA'.AND.IHARG(4).EQ.'MATR')GOTO5132
CCCCC END CHANGE
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'WINS')GOTO5152
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'MULT'.AND.IHARG(4).EQ.'NORM'.AND.
     1IHARG(5).EQ.'CDF')GOTO5154
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'MULT'.AND.IHARG(4).EQ.'T'.AND.
     1IHARG(5).EQ.'CDF')GOTO5156
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'INDE'.AND.IHARG(4).EQ.'UNIF'.AND.
     1IHARG(5).EQ.'RAND'.AND.IHARG(6).EQ.'NUMB')GOTO5158
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'CORR'.AND.IHARG(4).EQ.'UNIF'.AND.
     1IHARG(5).EQ.'RAND'.AND.IHARG(6).EQ.'NUMB')GOTO5160
C
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'MATR'.AND.IHARG(5)(1:3).EQ.'BIN')GOTO5197
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'MATR'.AND.IHARG(5).EQ.'COUN'.AND.
     1IHARG(6)(1:3).EQ.'BIN')GOTO5198
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'MATR'.AND.IHARG(5).EQ.'RELA'.AND.
     1IHARG(6)(1:3).EQ.'BIN')GOTO5199
C
CCCCC OCTOBER 2004.  ADD FOLLOWING SECTION.
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ASH '.AND.IHARG(5)(1:3).EQ.'BIN')GOTO5192
      IF(NUMARG.GE.4.AND.IHARG(4).EQ.'ASH ')GOTO5193
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COUN'.AND.IHARG(5).EQ.'ASH '.AND.
     1IHARG(6)(1:3).EQ.'BIN')GOTO5194
      IF(NUMARG.GE.7.AND.
     1IHARG(5).EQ.'COMB'.AND.IHARG(6).EQ.'FREQ'.AND.
     1IHARG(7).EQ.'TABL')GOTO5196
      IF(NUMARG.GE.7.AND.
     1IHARG(5).EQ.'INTE'.AND.IHARG(6).EQ.'FREQ'.AND.
     1IHARG(7).EQ.'TABL')GOTO5195
C
CCCCC FEBRAURY 2005.  ADD FOLLOWING SECTION.
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'H   '.AND.IHARG(4).EQ.'CONS'.AND.
     1IHARG(5).EQ.'STAT')GOTO5202
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'H   '.AND.IHARG(4).EQ.'CONS')GOTO5203
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'K   '.AND.IHARG(4).EQ.'CONS'.AND.
     1IHARG(5).EQ.'STAT')GOTO5204
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'K   '.AND.IHARG(4).EQ.'CONS')GOTO5205
C
      IF(NUMARG.GE.7.AND.
     1IHARG(5).EQ.'H   '.AND.IHARG(6).EQ.'CONS'.AND.
     1IHARG(7).EQ.'STAT')GOTO5206
      IF(NUMARG.GE.6.AND.
     1IHARG(5).EQ.'H   '.AND.IHARG(6).EQ.'CONS')GOTO5207
      IF(NUMARG.GE.7.AND.
     1IHARG(5).EQ.'K   '.AND.IHARG(6).EQ.'CONS'.AND.
     1IHARG(7).EQ.'STAT')GOTO5208
      IF(NUMARG.GE.6.AND.
     1IHARG(5).EQ.'K   '.AND.IHARG(6).EQ.'CONS')GOTO5209
C
CCCCC JUNE 2005. ADD FOLLOWING SECTION.
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'L   '.AND.IHARG(4).EQ.'MOME')GOTO5211
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'PROB'.AND.IHARG(4).EQ.'WEIG'.AND.
     1IHARG(5).EQ.'MOME')GOTO5213
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'BETA'.AND.
     1IHARG(4).EQ.'PROB'.AND.IHARG(5).EQ.'WEIG'.AND.
     1IHARG(6).EQ.'MOME')GOTO5215
C
CCCCC JANUARY 2007. ADD FOLLOWING SECTION.
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'JITT')GOTO5217
C
CCCCC FEBRUARY 2007. ADD FOLLOWING SECTION.
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'AGRE'.AND.IHARG(5).EQ.'COUL'.AND.
     1(IHARG(6).EQ.'LIMI'.OR.IHARG(6).EQ.'INTE'))GOTO5219
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'AGRE'.AND.IHARG(5).EQ.'COUL'.AND.
     1IHARG(6).EQ.'CONF'.AND.
     1(IHARG(7).EQ.'LIMI'.OR.IHARG(7).EQ.'INTE'))GOTO5220
C
CCCCC FEBRUARY 2007. ADD FOLLOWING SECTION.
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'EXAC'.AND.IHARG(4).EQ.'BINO'.AND.
     1IHARG(5).EQ.'LOWE'.AND.
     1(IHARG(6).EQ.'LIMI'.OR.IHARG(6).EQ.'INTE'))GOTO5221
C
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'EXAC'.AND.IHARG(4).EQ.'BINO'.AND.
     1IHARG(5).EQ.'LOWE'.AND.IHARG(6).EQ.'BOUN')GOTO5221
C
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'BINO'.AND.IHARG(4).EQ.'EXAC'.AND.
     1IHARG(5).EQ.'LOWE'.AND.
     1(IHARG(6).EQ.'LIMI'.OR.IHARG(6).EQ.'INTE'))GOTO5221
C
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'BINO'.AND.IHARG(4).EQ.'EXAC'.AND.
     1IHARG(5).EQ.'LOWE'.AND.IHARG(6).EQ.'BOUN')GOTO5221
C
CCCCC FEBRUARY 2007. ADD FOLLOWING SECTION.
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'EXAC'.AND.IHARG(4).EQ.'BINO'.AND.
     1IHARG(5).EQ.'UPPE'.AND.
     1(IHARG(6).EQ.'LIMI'.OR.IHARG(6).EQ.'INTE'))GOTO5223
C
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'EXAC'.AND.IHARG(4).EQ.'BINO'.AND.
     1IHARG(5).EQ.'UPPE'.AND.IHARG(6).EQ.'BOUN')GOTO5223
C
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'BINO'.AND.IHARG(4).EQ.'EXAC'.AND.
     1IHARG(5).EQ.'UPPE'.AND.
     1(IHARG(6).EQ.'LIMI'.OR.IHARG(6).EQ.'INTE'))GOTO5223
C
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'BINO'.AND.IHARG(4).EQ.'EXAC'.AND.
     1IHARG(5).EQ.'UPPE'.AND.IHARG(6).EQ.'BOUN')GOTO5223
C
CCCCC OCTOBER  2009. ADD FOLLOWING SECTION.
      IF(NUMARG.GE.8.AND.
     1IHARG(5).EQ.'BINO'.AND.IHARG(6).EQ.'RATI'.AND.
     1IHARG(7).EQ.'CONF'.AND.
     1(IHARG(8).EQ.'LIMI'.OR.IHARG(8).EQ.'INTE'))GOTO5224
C
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'2D  '.AND.IHARG(5).EQ.'CONV'.AND.
     1IHARG(6).EQ.'HULL')GOTO5225
C
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'POIN'.AND.IHARG(4).EQ.'IN  '.AND.
     1IHARG(5).EQ.'POLY')GOTO5226
C
      IF(NUMARG.GE.7.AND.
     1IHARG(5).EQ.'MINI'.AND.IHARG(6).EQ.'SPAN'.AND.
     1IHARG(7).EQ.'TREE')GOTO5227
C
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'MINI'.AND.IHARG(5).EQ.'SPAN'.AND.
     1IHARG(6).EQ.'TREE')GOTO5229
C
      IF(NUMARG.GE.7.AND.
     1IHARG(5).EQ.'EDGE'.AND.IHARG(6).EQ.'TO  '.AND.
     1IHARG(7).EQ.'VERT')GOTO5231
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'NEXT'.AND.IHARG(4).EQ.'SUBS')GOTO5233
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'NEXT'.AND.IHARG(4).EQ.'PERM')GOTO5235
C
      IF(NUMARG.GE.8.AND.
     1IHARG(3).EQ.'NEXT'.AND.IHARG(4).EQ.'K   '.AND.
     1IHARG(5).EQ.'SET '.AND.IHARG(6).EQ.'OF  '.AND.
     1IHARG(7).EQ.'N   '.AND.IHARG(8).EQ.'SET ')GOTO5237
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'NEXT'.AND.IHARG(4).EQ.'COMP')GOTO5239
C
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'NEXT'.AND.IHARG(5).EQ.'PART')GOTO5240
C
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'NEXT'.AND.IHARG(5).EQ.'EQUI'.AND.
     1IHARG(6).EQ.'RELA')GOTO5246
C
      IF(NUMARG.GE.6.AND.
     1IHARG(5).EQ.'SPAN'.AND.IHARG(6).EQ.'FORE')GOTO5248
C
      IF(NUMARG.GE.7.AND.
     1IHARG(6).EQ.'SPAN'.AND.IHARG(7).EQ.'FORE')GOTO5250
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'ADJA'.AND.IHARG(4).EQ.'MATR')GOTO5252
C
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'DIRE'.AND.IHARG(4).EQ.'ADJA'.AND.
     1IHARG(4).EQ.'MATR')GOTO5253
C
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'EDGE'.AND.IHARG(4).EQ.'TO  '.AND.
     1IHARG(5).EQ.'ADJA'.AND.IHARG(6).EQ.'MATR')GOTO5254
C
      IF(NUMARG.GE.7.AND.
     1IHARG(3).EQ.'EDGE'.AND.IHARG(4).EQ.'TO  '.AND.
     1IHARG(5).EQ.'DIRE'.AND.IHARG(6).EQ.'ADJA'.AND.
     1IHARG(7).EQ.'MATR')GOTO5255
C
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'NEXT'.AND.IHARG(4).EQ.'YOUN'.AND.
     1IHARG(5).EQ.'TABL')GOTO5256
C
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'CONV'.AND.IHARG(5).EQ.'YOUN'.AND.
     1IHARG(6).EQ.'TABL')GOTO5257
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'GROU'.AND.IHARG(4).EQ.'SORT')GOTO5258
C
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'YOUN'.AND.IHARG(4).EQ.'TABL'.AND.
     1IHARG(5).EQ.'HOOK'.AND.IHARG(6).EQ.'LENG')GOTO5260
C
CCCCC AUGUST 2008. ADD FOLLOWING SECTION.
      IF(NUMARG.GE.9.AND.
     1IHARG(5).EQ.'DIFF'.AND.IHARG(6).EQ.'OF'.AND.
     1IHARG(7).EQ.'PROP'.AND.IHARG(8).EQ.'CONF'.AND.
     1(IHARG(9).EQ.'LIMI'.OR.IHARG(9).EQ.'INTE'))GOTO5262
C
      IF(NUMARG.GE.9.AND.
     1IHARG(3).EQ.'DIFF'.AND.IHARG(4).EQ.'OF'.AND.
     1IHARG(5).EQ.'PROP'.AND.IHARG(6).EQ.'LOWE'.AND.
     1IHARG(7).EQ.'TAIL'.AND.IHARG(8).EQ.'HYPO'.AND.
     1IHARG(9).EQ.'TEST')GOTO5266
C
      IF(NUMARG.GE.9.AND.
     1IHARG(3).EQ.'DIFF'.AND.IHARG(4).EQ.'OF'.AND.
     1IHARG(5).EQ.'PROP'.AND.IHARG(6).EQ.'UPPE'.AND.
     1IHARG(7).EQ.'TAIL'.AND.IHARG(8).EQ.'HYPO'.AND.
     1IHARG(9).EQ.'TEST')GOTO5268
C
      ISTEPN='2N'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC SEPTEMBER 2008. ADD FOLLOWING SECTION.
      IF(NUMARG.GE.7.AND.
     1(IHARG(5).EQ.'RUHK'.OR.IHARG(5).EQ.'RUKH').AND.
     1(IHARG(6).EQ.'ONE'.OR.IHARG(6).EQ.'1').AND.
     1IHARG(7).EQ.'TEST')GOTO5270
C
      IF(NUMARG.GE.9.AND.
     1(IHARG(5).EQ.'RUHK'.OR.IHARG(5).EQ.'RUKH').AND.
     1(IHARG(6).EQ.'ONE'.OR.IHARG(6).EQ.'1').AND.
     1IHARG(7).EQ.'LOWE'.AND.IHARG(8).EQ.'TAIL'.AND.
     1IHARG(9).EQ.'TEST')GOTO5272
C
      IF(NUMARG.GE.9.AND.
     1(IHARG(5).EQ.'RUHK'.OR.IHARG(5).EQ.'RUKH').AND.
     1(IHARG(6).EQ.'ONE'.OR.IHARG(6).EQ.'1').AND.
     1IHARG(7).EQ.'UPPE'.AND.IHARG(8).EQ.'TAIL'.AND.
     1IHARG(9).EQ.'TEST')GOTO5274
C
CCCCC SEPTEMBER 2008. ADD FOLLOWING SECTION.
      IF(NUMARG.GE.7.AND.
     1(IHARG(5).EQ.'RUHK'.OR.IHARG(5).EQ.'RUKH').AND.
     1(IHARG(6).EQ.'TWO'.OR.IHARG(6).EQ.'2').AND.
     1IHARG(7).EQ.'TEST')GOTO5276
C
      IF(NUMARG.GE.9.AND.
     1(IHARG(5).EQ.'RUHK'.OR.IHARG(5).EQ.'RUKH').AND.
     1(IHARG(6).EQ.'TWO'.OR.IHARG(6).EQ.'2').AND.
     1IHARG(7).EQ.'LOWE'.AND.IHARG(8).EQ.'TAIL'.AND.
     1IHARG(9).EQ.'TEST')GOTO5278
C
      IF(NUMARG.GE.9.AND.
     1(IHARG(5).EQ.'RUHK'.OR.IHARG(5).EQ.'RUKH').AND.
     1(IHARG(6).EQ.'TWO'.OR.IHARG(6).EQ.'2').AND.
     1IHARG(7).EQ.'UPPE'.AND.IHARG(8).EQ.'TAIL'.AND.
     1IHARG(9).EQ.'TEST')GOTO5280
C
CCCCC JUNE 2010. ADD FOLLOWING SECTION.
      IF(NUMARG.GE.7.AND.
     1(IHARG(5).EQ.'RUHK'.OR.IHARG(5).EQ.'RUKH').AND.
     1(IHARG(6).EQ.'THRE'.OR.IHARG(6).EQ.'3').AND.
     1IHARG(7).EQ.'TEST')GOTO5306
C
      IF(NUMARG.GE.9.AND.
     1(IHARG(5).EQ.'RUHK'.OR.IHARG(5).EQ.'RUKH').AND.
     1(IHARG(6).EQ.'THRE'.OR.IHARG(6).EQ.'3').AND.
     1IHARG(7).EQ.'LOWE'.AND.IHARG(8).EQ.'TAIL'.AND.
     1IHARG(9).EQ.'TEST')GOTO5308
C
      IF(NUMARG.GE.9.AND.
     1(IHARG(5).EQ.'RUHK'.OR.IHARG(5).EQ.'RUKH').AND.
     1(IHARG(6).EQ.'THRE'.OR.IHARG(6).EQ.'3').AND.
     1IHARG(7).EQ.'UPPE'.AND.IHARG(8).EQ.'TAIL'.AND.
     1IHARG(9).EQ.'TEST')GOTO5310
C
      IF(NUMARG.GE.8.AND.
     1IHARG(5).EQ.'BINO'.AND.IHARG(6).EQ.'PROD'.AND.
     1IHARG(7).EQ.'STAN'.AND.IHARG(8).EQ.'ERRO')GOTO5312
C
      IF(NUMARG.GE.8.AND.
     1IHARG(5).EQ.'BINO'.AND.IHARG(6).EQ.'PROD'.AND.
     1IHARG(7).EQ.'CONF'.AND.IHARG(8).EQ.'LIMI')GOTO5312
C
      IF(NUMARG.GE.8.AND.
     1IHARG(5).EQ.'BINO'.AND.IHARG(6).EQ.'PROD'.AND.
     1IHARG(7).EQ.'CONF'.AND.IHARG(8).EQ.'INTE')GOTO5312
C
      IF(NUMARG.GE.7.AND.
     1IHARG(5).EQ.'BINO'.AND.IHARG(6).EQ.'PROD'.AND.
     1IHARG(7).EQ.'SE  ')GOTO5314
C
CCCCC OCTOBER 2010. ADD FOLLOWING SECTION.
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'EXAC'.AND.IHARG(5).EQ.'BINO'.AND.
     1IHARG(6).EQ.'CONF'.AND.
     1(IHARG(7).EQ.'LIMI'.OR.IHARG(7).EQ.'INTE'))GOTO5318
C
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'BINO'.AND.IHARG(5).EQ.'EXAC'.AND.
     1IHARG(6).EQ.'CONF'.AND.
     1(IHARG(7).EQ.'LIMI'.OR.IHARG(7).EQ.'INTE'))GOTO5318
C
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'EXAC'.AND.IHARG(5).EQ.'BINO'.AND.
     1(IHARG(6).EQ.'LIMI'.OR.IHARG(6).EQ.'INTE'))GOTO5320
C
      IF(NUMARG.GE.4.AND.
     1IHARG(4).EQ.'SORT'.AND.IHARG2(4).EQ.'2   ')GOTO5281
      IF(NUMARG.GE.5.AND.
     1IHARG(5).EQ.'SORT'.AND.IHARG2(5).EQ.'3   ')GOTO5282
      IF(NUMARG.GE.6.AND.
     1IHARG(6).EQ.'SORT'.AND.IHARG2(6).EQ.'4   ')GOTO5283
C
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'GATH')GOTO5285
C
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'SCAT')GOTO5287
C
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'RANK'.AND.IHARG2(3).EQ.'2   ')GOTO5289
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'RANK'.AND.IHARG2(3).EQ.'3   ')GOTO5291
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'RANK'.AND.IHARG2(3).EQ.'4   ')GOTO5293
C
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'SHIF')GOTO5295
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CIRC'.AND.IHARG(4).EQ.'SHIF')GOTO5296
C
      IF(NUMARG.GE.5.AND.
     1IHARG(5).EQ.'BIPL')GOTO5298
C
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'LARG')GOTO15300
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'SMAL')GOTO15301
C
      IF(NUMARG.GE.6.AND.
     1IHARG(6).EQ.'MATR' .AND. IHARG(7).EQ.'ROW ' .AND.
     1IHARG(8).EQ.'FIT ')GOTO5302
      IF(NUMARG.GE.6.AND.
     1IHARG(6).EQ.'MATR' .AND. IHARG(7).EQ.'COLU' .AND.
     1IHARG(8).EQ.'FIT ')GOTO5304
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'COMB')GOTO5316
C
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'BRIT' .AND. IHARG(4).EQ.'FIBE' .AND.
     1IHARG(5).EQ.'WEIB' .AND. IHARG(6).EQ.'PDF')GOTO5322
C
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'BRIT' .AND. IHARG(4).EQ.'FIBE' .AND.
     1IHARG(5).EQ.'WEIB' .AND. IHARG(6).EQ.'CDF')GOTO5324
C
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'BRIT' .AND. IHARG(4).EQ.'FIBE' .AND.
     1IHARG(5).EQ.'WEIB' .AND. IHARG(6).EQ.'PDF')GOTO5326
C
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'END ' .AND. IHARG(4).EQ.'EFFE' .AND.
     1IHARG(5).EQ.'WEIB' .AND. IHARG(6).EQ.'PDF')GOTO5328
C
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'END ' .AND. IHARG(4).EQ.'EFFE' .AND.
     1IHARG(5).EQ.'WEIB' .AND. IHARG(6).EQ.'CDF')GOTO5330
C
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'END ' .AND. IHARG(4).EQ.'EFFE' .AND.
     1IHARG(5).EQ.'WEIB' .AND. IHARG(6).EQ.'PPF')GOTO5332
C
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'VARI' .AND. IHARG(4).EQ.'TO  ' .AND.
     1IHARG(5).EQ.'MATR')GOTO5334
C
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'MATR' .AND. IHARG(4).EQ.'TO  ' .AND.
     1IHARG(5).EQ.'VARI')GOTO5336
C
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'MATR' .AND. IHARG(4).EQ.'COMB' .AND.
     1IHARG(5)(1:3).EQ.'ROW')GOTO5338
C
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'MATR' .AND. IHARG(4).EQ.'COMB' .AND.
     1IHARG(5).EQ.'COLU')GOTO5340
C
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'KEEP')GOTO5342
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'OMIT')GOTO5344
      IF(NUMARG.GE.9.AND.IHARG(5).EQ.'MANN'.AND.
     1   IHARG(6).EQ.'WHIT' .AND. IHARG(7).EQ.'U   ' .AND.
     1   IHARG(8).EQ.'STAT' .AND. IHARG(9).EQ.'FREQ')GOTO5346
C
      IF(NUMARG.GE.5.AND.IHARG(4).EQ.'THRE'.AND.
     1   (IHARG(5).EQ.'MINI' .OR. IHARG(5).EQ.'MIN '))GOTO5348
C
      IF(NUMARG.GE.5.AND.IHARG(4).EQ.'THRE'.AND.
     1   (IHARG(5).EQ.'MAXI' .OR. IHARG(5).EQ.'MAX '))GOTO5350
C
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'EN')GOTO5352
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'PA')GOTO5353
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'DIPE')GOTO55353
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'EXPA')GOTO5354
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'JSCO'.AND.
     1   IHARG(4).NE.'STAT')GOTO5355
      IF(NUMARG.GE.6.AND.IHARG(5).EQ.'JSCO'.AND.
     1   IHARG(6).EQ.'TABL')GOTO55355
      IF(NUMARG.GE.6.AND.IHARG(3).EQ.'ISO '.AND.
     1   IHARG(4).EQ.'1352' .AND. IHARG(5).EQ.'ZSCO')GOTO5356
C
C     2016/02: MAKE THE WORD "SCORE" OPTIONAL
C
      IF(NUMARG.GE.7.AND.IHARG(3).EQ.'ISO '.AND.
     1   IHARG(4).EQ.'1352' .AND. IHARG(5).EQ.'ZPRI' .AND.
     1   IHARG(6).EQ.'SCOR')GOTO5358
      IF(NUMARG.GE.7.AND.IHARG(3).EQ.'ISO '.AND.
     1   IHARG(4).EQ.'1352' .AND. IHARG(5).EQ.'ZETA' .AND.
     1   IHARG(6).EQ.'SCOR')GOTO5360
      IF(NUMARG.GE.7.AND.IHARG(3).EQ.'ISO '.AND.
     1   IHARG(4).EQ.'1352' .AND. IHARG(5).EQ.'EZMI' .AND.
     1   IHARG(6).EQ.'SCOR')GOTO5362
      IF(NUMARG.GE.7.AND.IHARG(3).EQ.'ISO '.AND.
     1   IHARG(4).EQ.'1352' .AND. IHARG(5).EQ.'EZPL' .AND.
     1   IHARG(6).EQ.'SCOR')GOTO5364
      IF(NUMARG.GE.7.AND.IHARG(3).EQ.'ISO '.AND.
     1   IHARG(4).EQ.'1352' .AND. IHARG(5).EQ.'EN  ' .AND.
     1   IHARG(6).EQ.'SCOR')GOTO5366
      IF(NUMARG.GE.7.AND.IHARG(3).EQ.'ISO '.AND.
     1   IHARG(4).EQ.'1352' .AND. IHARG(5).EQ.'PA  ' .AND.
     1   IHARG(6).EQ.'SCOR')GOTO5367
      IF(NUMARG.GE.7.AND.IHARG(3).EQ.'ISO '.AND.
     1   IHARG(4).EQ.'1352' .AND. IHARG(5).EQ.'DIPE' .AND.
     1   IHARG(6).EQ.'SCOR')GOTO45367
      IF(NUMARG.GE.8.AND.IHARG(3).EQ.'ISO '.AND.
     1   IHARG(4).EQ.'1352' .AND. IHARG(5).EQ.'DI  ' .AND.
     1   IHARG(6).EQ.'PERC' .AND. IHARG(7).EQ.'SCOR')GOTO46367
C
      IF(NUMARG.GE.6.AND.IHARG(3).EQ.'ISO '.AND.
     1   IHARG(4).EQ.'1352' .AND. IHARG(5).EQ.'ZPRI')GOTO55358
      IF(NUMARG.GE.6.AND.IHARG(3).EQ.'ISO '.AND.
     1   IHARG(4).EQ.'1352' .AND. IHARG(5).EQ.'ZETA')GOTO55360
      IF(NUMARG.GE.6.AND.IHARG(3).EQ.'ISO '.AND.
     1   IHARG(4).EQ.'1352' .AND. IHARG(5).EQ.'EZMI')GOTO55362
      IF(NUMARG.GE.6.AND.IHARG(3).EQ.'ISO '.AND.
     1   IHARG(4).EQ.'1352' .AND. IHARG(5).EQ.'EZPL')GOTO55364
      IF(NUMARG.GE.6.AND.IHARG(3).EQ.'ISO '.AND.
     1   IHARG(4).EQ.'1352' .AND. IHARG(5).EQ.'EN  ')GOTO55366
      IF(NUMARG.GE.6.AND.IHARG(3).EQ.'ISO '.AND.
     1   IHARG(4).EQ.'1352' .AND. IHARG(5).EQ.'PA  ')GOTO55367
      IF(NUMARG.GE.6.AND.IHARG(3).EQ.'ISO '.AND.
     1   IHARG(4).EQ.'1352' .AND. IHARG(5).EQ.'DIPE')GOTO55368
      IF(NUMARG.GE.7.AND.IHARG(3).EQ.'ISO '.AND.
     1   IHARG(4).EQ.'1352' .AND. IHARG(5).EQ.'DI  '.AND.
     1   IHARG(6).EQ.'PERC')GOTO55369
C
      IF(NUMARG.GE.6.AND.IHARG(3).EQ.'WEIB'.AND.
     1   IHARG(4).EQ.'MOME' .AND. IHARG(5).EQ.'ESTI')GOTO5368
      IF(NUMARG.GE.6.AND.IHARG(3).EQ.'LOGN'.AND.
     1   IHARG(4).EQ.'MOME' .AND. IHARG(5).EQ.'ESTI')GOTO5369
      IF(NUMARG.GE.6.AND.IHARG(3).EQ.'LOW '.AND.
     1   IHARG(4).EQ.'PASS' .AND. IHARG(5).EQ.'FILT')GOTO5370
      IF(NUMARG.GE.6.AND.IHARG(3).EQ.'GAMM'.AND.
     1   IHARG(4).EQ.'MOME' .AND. IHARG(5).EQ.'ESTI')GOTO5371
      IF(NUMARG.GE.7.AND.IHARG(3).EQ.'INVE'.AND.
     1   IHARG(4).EQ.'GAUS'.AND.IHARG(5).EQ.'MOME' .AND.
     1   IHARG(6).EQ.'ESTI')GOTO5373
      IF(NUMARG.GE.6.AND.IHARG(3).EQ.'HIGH'.AND.
     1   IHARG(4).EQ.'PASS' .AND. IHARG(5).EQ.'FILT')GOTO5372
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'TRAN'.AND.IHARG(5).EQ.'POIN')GOTO5374
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'EXTR'.AND.IHARG(5).EQ.'POIN')GOTO5376
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'ENCL'.AND.IHARG(5).EQ.'RECT')GOTO5378
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'ENCL'.AND.IHARG(5).EQ.'BOX ')GOTO5378
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'LINE'.AND.IHARG(5).EQ.'INTE')GOTO5380
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'INTE'.AND.IHARG(5).EQ.'LINE')GOTO5380
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'PARA'.AND.IHARG(5).EQ.'LINE')GOTO5382
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'PERP'.AND.IHARG(5).EQ.'LINE')GOTO5384
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'NEAR'.AND.IHARG(4).EQ.'NEIG'.AND.
     1   IHARG(5).EQ.'INDE')GOTO5386
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'NEAR'.AND.IHARG(4).EQ.'NEIG'.AND.
     1   IHARG(5).EQ.'DIST')GOTO5388
      IF(NUMARG.GE.5.AND.
     1   IHARG(4).EQ.'NEAR'.AND.IHARG(5).EQ.'NEIG')GOTO5390
      IF(NUMARG.GE.4.AND.
     1   IHARG(3).EQ.'NEAR'.AND.IHARG(4).EQ.'NEIG')GOTO5392
      IF(NUMARG.GE.7.AND.
     1   IHARG(5).EQ.'NEAR'.AND.IHARG(6).EQ.'NEIG'.AND.
     1   IHARG(7).EQ.'JOIN')GOTO5394
      IF(NUMARG.GE.7.AND.
     1   IHARG(5).EQ.'FIRS'.AND.IHARG(6).EQ.'NEAR'.AND.
     1   IHARG(7).EQ.'NEIG')GOTO5396
      IF(NUMARG.GE.9.AND.
     1   IHARG(7).EQ.'ALL '.AND.IHARG(8).EQ.'NEAR'.AND.
     1   IHARG(9).EQ.'NEIG')GOTO5398
      IF(NUMARG.GE.4.AND.
     1   IHARG(3).EQ.'SHUF'.AND.IHARG(4).EQ.'GROU')GOTO5400
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'RAND'.AND.IHARG(4).EQ.'ERRO'.AND.
     1   IHARG(5).EQ.'QUAN')GOTO5402
      IF(NUMARG.GE.3.AND.
     1   IHARG(3).EQ.'DIGI')GOTO5404
C
      IF(NUMARG.GE.4.AND.
     1   IHARG(4).EQ.'YFRA')GOTO5406
      IF(NUMARG.GE.4.AND.
     1   IHARG(4).EQ.'XFRA')GOTO5408
C
      IF(NUMARG.GE.5.AND.
     1  (IHARG(3).EQ.'YTIC' .OR. IHARG(3).EQ.'Y1TI').AND.
     1   IHARG(4).EQ.'SCRE'.AND.IHARG(5).EQ.'COOR')GOTO55401
      IF(NUMARG.GE.5.AND.
     1  (IHARG(3).EQ.'YTIC' .OR. IHARG(3).EQ.'Y1TI').AND.
     1   IHARG(4).EQ.'DATA'.AND.IHARG(5).EQ.'COOR')GOTO55402
      IF(NUMARG.GE.5.AND.IHARG(3).EQ.'Y2TI'.AND.
     1   IHARG(4).EQ.'SCRE'.AND.IHARG(5).EQ.'COOR')GOTO55403
      IF(NUMARG.GE.5.AND.IHARG(3).EQ.'Y2TI'.AND.
     1   IHARG(4).EQ.'DATA'.AND.IHARG(5).EQ.'COOR')GOTO55404
      IF(NUMARG.GE.5.AND.
     1  (IHARG(3).EQ.'XTIC' .OR. IHARG(3).EQ.'X1TI').AND.
     1   IHARG(4).EQ.'SCRE'.AND.IHARG(5).EQ.'COOR')GOTO55406
      IF(NUMARG.GE.5.AND.
     1  (IHARG(3).EQ.'XTIC' .OR. IHARG(3).EQ.'X1TI').AND.
     1   IHARG(4).EQ.'DATA'.AND.IHARG(5).EQ.'COOR')GOTO55407
      IF(NUMARG.GE.5.AND.IHARG(3).EQ.'X2TI'.AND.
     1   IHARG(4).EQ.'SCRE'.AND.IHARG(5).EQ.'COOR')GOTO55408
      IF(NUMARG.GE.5.AND.IHARG(3).EQ.'X2TI'.AND.
     1   IHARG(4).EQ.'DATA'.AND.IHARG(5).EQ.'COOR')GOTO55409
C
      IF(NUMARG.GE.6.AND.
     1   IHARG(4).EQ.'VARI'.AND.IHARG(5).EQ.'WELC'.AND.
     1   IHARG(6).EQ.'SATT')GOTO5410
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'GUM '.AND.IHARG(4).EQ.'WELC'.AND.
     1   IHARG(5).EQ.'SATT')GOTO5411
      IF(NUMARG.GE.7.AND.
     1   IHARG(4).EQ.'NORM'.AND.IHARG(5).EQ.'KERN'.AND.
     1   IHARG(6).EQ.'DENS'.AND.IHARG(7).EQ.'MIXT')GOTO5412
      IF(NUMARG.GE.6.AND.
     1   IHARG(4).EQ.'EMPI'.AND.IHARG(5).EQ.'QUAN'.AND.
     1   IHARG(6).EQ.'FUNC')GOTO5414
      IF(NUMARG.GE.6.AND.
     1   IHARG(4).EQ.'INFO'.AND.IHARG(5).EQ.'QUAN'.AND.
     1   IHARG(6).EQ.'FUNC')GOTO5416
      IF(NUMARG.GE.7.AND.
     1   IHARG(4).EQ.'TRUN'.AND.IHARG(5).EQ.'INFO'.AND.
     1   IHARG(6).EQ.'QUAN'.AND.IHARG(7).EQ.'FUNC')GOTO5418
C
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'INSE')GOTO5420
C
CCCCC CHECK FOR:  Y = X
CCCCC CHECK FOR:  Y = X
CCCCC CHECK FOR:  Y = X
CCCCC WHERE X IS A VARIABLE OR PARAMETER
C
CCCCC NOTE 8/2008: CHECK FOR SOMETHING LIKE
CCCCC
CCCCC                 LET ITEMP = OUTEQMAV(3)
CCCCC
CCCCC              WHEN THE VARIABLE NAME ON THE RIGHT HAS
CCCCC              8 (OR MORE) CHARACTERS, WE NEED TO EXPLICITLY
CCCCC              CHECK FOR "(" ANYWHERE ON THE COMMAND STRING.
CCCCC NOTE 3/2012: EXPRESSIONS LIKE
CCCCC                  LET CUTOFF = SDEFFECT*12.7062
CCCCC              SHOULD NOT BE HANDLED HERE.
C
      ISTEPN='2O'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IHARG(2).EQ.'=')THEN
        IF(NUMARG.EQ.3 .OR. IHARG(4).EQ.'SUBS' .OR.
     1     IHARG(4).EQ.'EXCE' .OR. IHARG(4).EQ.'FOR ')THEN
          IH=IHARG(3)
          IH2=IHARG2(3)
          DO77001I=1,NUMNAM
            IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1         IUSE(I).EQ.'V')THEN
C
C              8/2008: CHECK FOR "NAME(INDEX)" SYNTAX.
C
C              3/2012: DO A MORE COMPLETE CHECK OF IANS.
C                      THE VARIABLE NAME AFTER THE "=" MUST
C                      CONTAIN THAT VARIABLE NAME AND NOTHING
C                      ELSE.  FIRST, SEARCH FOR EQUAL SIGN.
C                      THEN SEARCH FOR VARIABLE NAME.
C
CCCCC          DO77003J=1,IWIDTH
CCCCC            IF(IANS(J)(1:1).EQ.'(')GOTO77009
C77003         CONTINUE
               DO7703J=1,IWIDTH
                 IF(IANS(J)(1:1).EQ.'=')THEN
                   IHTEMP=' '
                   ICNT=0
                   DO7704JJ=J+1,IWIDTH
                     IF(IANS(JJ).NE.' ')THEN
                       DO7705KK=JJ,MIN(JJ+11,IWIDTH)
                         IF(IANS(KK).EQ.' ')GOTO7707
                         ICNT=ICNT+1
                         IF(ICNT.GT.8)GOTO77009
                         IHTEMP(ICNT:ICNT)=IANS(KK)(1:1)
 7705                  CONTINUE
                     ENDIF
 7704              CONTINUE
 7707              CONTINUE
                   IF(IHTEMP(1:4).NE.IH(1:4) .OR.
     1                IHTEMP(5:8).NE.IH2(1:4))GOTO77009
                 ENDIF
 7703          CONTINUE
C
               GOTO5241
C
            ENDIF
77001     CONTINUE
77009     CONTINUE
        ENDIF
      ENDIF
C
CCCCC THE FOLLOWING SECTION WAS ADDED DECEMBER 1989
C               *****************************************************
C               **  CHECK FOR (DEX) GENERATOR ARITHMETIC SUBCASES  **
C               *****************************************************
C
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'GENE')GOTO1070
      GOTO1079
C
 1070 CONTINUE
      IF(IHARG(4).EQ.'ADDI')GOTO2701
      IF(IHARG(4).EQ.'SUBT')GOTO2702
      IF(IHARG(4).EQ.'MULT')GOTO2703
 1079 CONTINUE
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED JULY 1991
C               ************************
C               **  CHECK FOR   COCODE (= CORANK)
C               ************************
C
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'COCO'.AND.IHARG2(3).EQ.'DE  ')GOTO2801
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'COCO'.AND.IHARG2(3).EQ.'DED ')GOTO2801
CCCCC THE FOLLOWING 4 LINES WERE ADDED OCTOBER 1991
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CORA'.AND.IHARG2(3).EQ.'NK  ')GOTO2801
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CORA'.AND.IHARG2(3).EQ.'NKED')GOTO2801
C
CCCCC THE FOLLOWING SECTION WAS ADDED JULY 1991
C               ************************
C               **  CHECK FOR   COCOPY
C               ************************
C
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'COCO'.AND.IHARG2(3).EQ.'PY  ')GOTO2802
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'COCO'.AND.IHARG2(3).EQ.'PIED')GOTO2802
C
C               **************************************
C               **  CHECK FOR   CUSUM ARL           **
C               **  CHECK FOR   ONE-SIDED CUSUM ARL **
C               **  CHECK FOR   TWO-SIDED CUSUM ARL **
C               **************************************
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CUSU'.AND.IHARG(4).EQ.'ARL ')GOTO2806
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'TWO'.AND.IHARG(4).EQ.'SIDE'.AND.
     1IHARG(5).EQ.'CUSU'.AND.IHARG(6).EQ.'ARL ')GOTO2808
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'2'.AND.IHARG(4).EQ.'SIDE'.AND.
     1IHARG(5).EQ.'CUSU'.AND.IHARG(6).EQ.'ARL ')GOTO2808
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'ONE'.AND.IHARG(4).EQ.'SIDE'.AND.
     1IHARG(5).EQ.'CUSU'.AND.IHARG(6).EQ.'ARL ')GOTO2810
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'1'.AND.IHARG(4).EQ.'SIDE'.AND.
     1IHARG(5).EQ.'CUSU'.AND.IHARG(6).EQ.'ARL ')GOTO2810
C
C               **************************************
C               **  CHECK FOR   STANDARDIZE         **
C               **  CHECK FOR   LOCATION STANDARDIZE**
C               **  CHECK FOR   ZSCORE STANDARDIZE  **
C               **  CHECK FOR   ZSCORE              **
C               **  CHECK FOR   USCORE              **
C               **  CHECK FOR   MEAN RANK           **
C               **  CHECK FOR   MEDIAN RANK         **
C               **************************************
C
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'STAN')GOTO2812
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'ZSCO')GOTO2818
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'USCO')GOTO2820
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'ZSCO'.AND.IHARG(4).EQ.'STAN')GOTO2814
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'LOCA'.AND.IHARG(4).EQ.'STAN')GOTO2816
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'SCAL'.AND.IHARG(4).EQ.'STAN')GOTO2822
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'MEAN'.AND.IHARG(4).EQ.'RANK')GOTO2819
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'AVER'.AND.IHARG(4).EQ.'RANK')GOTO2819
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'MEDI'.AND.IHARG(4).EQ.'RANK')GOTO2821
C
      IF(NUMARG.GE.4.AND.
     1IHARG(4).EQ.'STAC')GOTO2824
      IF(NUMARG.GE.6.AND.
     1IHARG(5).EQ.'REPL'.AND.IHARG(6).EQ.'STAC')GOTO2825
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'UNST')GOTO2826
C
C               **************************************
C               **  CHECK FOR   CROSS TABULATE      **
C               **              <STAT>              **
C               **************************************
C
CCCCC SEPTEMBER 2001: CROSS TABULATE <STAT>
CCCCC AUGUST 2002: ADD ADDITIONAL STATISTICS, ALSO SET
CCCCC ICASS7 FOR SUBSEQUENT USE IN DPMATC, DPMAT2
CCCCC MARCH 2009: USE "EXTSTA" TO PARSE.
C
CCCCC JANUARY 2013: CHECK FOR "CROSS TABULATE CUMULATIVE"
C
      ISTEPN='2P'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.5.AND.IHARG(3).EQ.'CROS'.AND.IHARG(4).EQ.'TABU'.AND.
     1   IHARG(5).EQ.'CUMU')THEN
        JMIN=6
        JMAX=MIN(NUMARG,JMIN+6)
        CALL EXTSTA(ICOM,ICOM2,IHARG,IHARG2,IARGT,ARG,NUMARG,JMIN,JMAX,
     1              ICASS7,ISTANM,ISTANR,ISTADF,IFOUN7,ILOCV,
     1              ISUBRO,IBUGA3,IERROR)
C
        ICASL7='CTCU'
        IF(IFOUN7.EQ.'YES')GOTO8020
      ENDIF
C
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'CROS'.AND.IHARG(4).EQ.'TABU')THEN
        JMIN=5
        JMAX=MIN(NUMARG,JMIN+6)
        CALL EXTSTA(ICOM,ICOM2,IHARG,IHARG2,IARGT,ARG,NUMARG,JMIN,JMAX,
     1              ICASS7,ISTANM,ISTANR,ISTADF,IFOUN7,ILOCV,
     1              ISUBRO,IBUGA3,IERROR)
C
        ICASL7='CTAB'
        IF(IFOUN7.EQ.'YES')GOTO8020
      ENDIF
C
C               **************************************
C               **  CHECK FOR   MOVING <STAT>       **
C               **************************************
C
      ISTEPN='2Q'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'MOVI')THEN
        JMIN=4
        JMAX=MIN(NUMARG,JMIN+6)
        CALL EXTSTA(ICOM,ICOM2,IHARG,IHARG2,IARGT,ARG,NUMARG,JMIN,JMAX,
     1              ICASS7,ISTANM,ISTANR,ISTADF,IFOUN7,ILOCV,
     1              ISUBRO,IBUGA3,IERROR)
C
        ICASL7='MOVI'
        IF(IFOUN7.EQ.'YES')GOTO8020
      ENDIF
C
C               **************************************
C               **  CHECK FOR   WINDOW <STAT>       **
C               **************************************
C
      ISTEPN='2R'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'WIND')THEN
        JMIN=4
        JMAX=MIN(NUMARG,JMIN+6)
        CALL EXTSTA(ICOM,ICOM2,IHARG,IHARG2,IARGT,ARG,NUMARG,JMIN,JMAX,
     1              ICASS7,ISTANM,ISTANR,ISTADF,IFOUN7,ILOCV,
     1              ISUBRO,IBUGA3,IERROR)
C
        ICASL7='WIND'
        IF(IFOUN7.EQ.'YES')GOTO8020
      ENDIF
C
C               **************************************
C               **  CHECK FOR   VECTOR PERCENTILE   **
C               **************************************
C
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'VECT'.AND.
     1   IHARG(4).EQ.'PERC')GOTO2830
C
C               ********************************
C               **  IF NO MATCH, THEN RETURN  **
C               ********************************
C
      ISTEPN='2S'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFOUN7='NO'
      GOTO9000
C
C               **********************
C               **  STEP 2--        **
C               **  DEFINE ICASL7.  **
C               **********************
C
 1201 CONTINUE
      ICASL7='SORT'
      GOTO8004
C
 1202 CONTINUE
      ICASL7='RANK'
      GOTO8004
C
 1203 CONTINUE
      ICASL7='CODE'
      GOTO8004
C
 1204 CONTINUE
      ICASL7='DIST'
      GOTO8004
C
C     ---------------
C
 1205 CONTINUE
      ICASL7='SEQD'
      GOTO8004
C
 1206 CONTINUE
      ICASL7='SEQD'
      GOTO8005
C
31206 CONTINUE
      ICASL7='SEQS'
      GOTO8005
C
41207 CONTINUE
      ICASL7='SEQP'
      GOTO8005
C
31208 CONTINUE
      ICASL7='SEME'
      GOTO8005
C
31209 CONTINUE
      ICASL7='SEMN'
      GOTO8005
C
31210 CONTINUE
      ICASL7='SEMX'
      GOTO8005
C
31211 CONTINUE
      ICASL7='SEQL'
      GOTO8005
C
31212 CONTINUE
      ICASL7='SEQU'
      GOTO8005
C
51206 CONTINUE
      ICASL7='GSQD'
      GOTO8006
C
51207 CONTINUE
      ICASL7='GSQS'
      GOTO8006
C
51208 CONTINUE
      ICASL7='GSQP'
      GOTO8006
C
51209 CONTINUE
      ICASL7='GSQM'
      GOTO8006
C
51210 CONTINUE
      ICASL7='GQMN'
      GOTO8006
C
51211 CONTINUE
      ICASL7='GQMX'
      GOTO8006
C
51212 CONTINUE
      ICASL7='GSQL'
      GOTO8006
C
51213 CONTINUE
      ICASL7='GSQU'
      GOTO8006
C
11206 CONTINUE
      ICASL7='IART'
      GOTO8005
C
21206 CONTINUE
      ICASL7='CUMD'
      GOTO8005
C
 1207 CONTINUE
      ICASL7='CUMS'
      GOTO8005
C
11207 CONTINUE
      ICASL7='CUMA'
      GOTO8005
C
21207 CONTINUE
      ICASL7='CMIN'
      GOTO8005
C
31207 CONTINUE
      ICASL7='CMAX'
      GOTO8005
C
11208 CONTINUE
      ICASL7='FLIP'
      GOTO8004
C
11209 CONTINUE
      ICASL7='CUMH'
      GOTO8005
C
11211 CONTINUE
      ICASL7='EXPS'
      GOTO8005
C
11210 CONTINUE
      ICASL7='HAZA'
      GOTO8004
C
 1208 CONTINUE
      ICASL7='CUMP'
      GOTO8005
C
 1209 CONTINUE
      ICASL7='CUMI'
      GOTO8005
C
11213 CONTINUE
      ICASL7='MTCH'
      GOTO8004
C
11214 CONTINUE
      ICASL7='REPL'
      GOTO8004
C
11215 CONTINUE
      ICASL7='MTC2'
      GOTO8005
C
C     ---------------
C
 1210 CONTINUE
      ICASL7='CONV'
      GOTO8004
C
 1211 CONTINUE
      ICASL7='DECO'
      GOTO8004
C
 1212 CONTINUE
      ICASL7='SORC'
      GOTO8004
C
 1213 CONTINUE
      ICASL7='FREQ'
      GOTO8004
C
 1216 CONTINUE
      ICASL7='SUMD'
      GOTO8004
C
 1217 CONTINUE
      ICASL7='INTR'
      GOTO8004
C
 1218 CONTINUE
      ICASL7='INTR'
      GOTO8005
C
11218 CONTINUE
      ICASL7='HERI'
      GOTO8005
C
11219 CONTINUE
      ICASL7='HERG'
      GOTO8005
C
11221 CONTINUE
      ICASL7='CORE'
      GOTO8005
C
11222 CONTINUE
      ICASL7='CONF'
      GOTO8006
C
11223 CONTINUE
      ICASL7='CKCL'
      GOTO8006
C
11224 CONTINUE
      ICASL7='CKCP'
      GOTO8007
C
CCCCC FOLLOWING SECTION ADDED MAY 1995.
 1219 CONTINUE
      ICASL7='LINT'
      GOTO8005
C
C     -----CODINGS-----
C
 1220 CONTINUE
      ICASL7='CODH'
      GOTO8004
C
 1221 CONTINUE
      ICASL7='COD1'
      GOTO8004
C
 1222 CONTINUE
      ICASL7='COD2'
      GOTO8004
C
 1223 CONTINUE
      ICASL7='COD3'
      GOTO8004
C
 1224 CONTINUE
      ICASL7='COD4'
      GOTO8004
C
 1225 CONTINUE
      ICASL7='COD5'
      GOTO8004
C
 1226 CONTINUE
      ICASL7='COD6'
      GOTO8004
C
 1227 CONTINUE
      ICASL7='COD7'
      GOTO8004
C
 1228 CONTINUE
      ICASL7='COD8'
      GOTO8004
C
 1229 CONTINUE
      ICASL7='COD9'
      GOTO8004
C
 1230 CONTINUE
      ICASL7='CO10'
      GOTO8004
C
 1231 CONTINUE
      ICASL7='CODZ'
      GOTO8004
C
 1232 CONTINUE
      ICASL7='CODX'
      GOTO8004
C
 1233 CONTINUE
      ICASL7='CDEX'
      GOTO8005
C
 1234 CONTINUE
      ICASL7='CDE2'
      GOTO8007
C
 1235 CONTINUE
      ICASL7='CDE2'
      GOTO8006
C
 1241 CONTINUE
      ICASL7='BIWE'
      GOTO8004
C
 1242 CONTINUE
      ICASL7='TRIC'
      GOTO8004
C
 1243 CONTINUE
      ICASL7='FRAC'
      GOTO8005
C
CCCCC FOLLOWING SECTION ADDED MAY 1994.
 1248 CONTINUE
      ICASL7='BILI'
      GOTO8005
C
CCCCC FOLLOWING SECTION ADDED MAY 1994.
 1249 CONTINUE
      ICASL7='2DIN'
      GOTO8005
C
CCCCC FOLLOWING SECTION ADDED MAY 1994.
 1250 CONTINUE
      ICASL7='BIVA'
      GOTO8005
C
C     -----TRANSFORMS-----
C
 1251 CONTINUE
      ICASL7='SINT'
      GOTO8005
C
 1252 CONTINUE
      ICASL7='COST'
      GOTO8005
C
 1253 CONTINUE
      ICASL7='FOUT'
      IF(NUMARG.LE.6)ICASL7='FOU1'
      IF(NUMARG.GE.7.AND.
     1   IHARG(7).EQ.'SUBS'.AND.IHARG2(7).EQ.'ET  ')ICASL7='FOU1'
      IF(NUMARG.GE.7.AND.
     1   IHARG(7).EQ.'EXCE'.AND.IHARG2(7).EQ.'PT  ')ICASL7='FOU1'
      IF(NUMARG.GE.7.AND.
     1   IHARG(7).EQ.'FOR '.AND.IHARG2(7).EQ.'    ')ICASL7='FOU1'
      GOTO8006
C
 1254 CONTINUE
      ICASL7='IFOU'
      IF(NUMARG.LE.7)ICASL7='IFO1'
      IF(NUMARG.GE.8.AND.
     1   IHARG(8).EQ.'SUBS'.AND.IHARG2(8).EQ.'ET  ')ICASL7='IFO1'
      IF(NUMARG.GE.8.AND.
     1   IHARG(8).EQ.'EXCE'.AND.IHARG2(8).EQ.'PT  ')ICASL7='IFO1'
      IF(NUMARG.GE.8.AND.
     1   IHARG(8).EQ.'FOR '.AND.IHARG2(8).EQ.'    ')ICASL7='IFO1'
      GOTO8007
C
 1255 CONTINUE
      ICASL7='FFT'
      IF(NUMARG.LE.5)ICASL7='FFT1'
      IF(NUMARG.GE.6.AND.
     1   IHARG(6).EQ.'SUBS'.AND.IHARG2(6).EQ.'ET  ')ICASL7='FFT1'
      IF(NUMARG.GE.6.AND.
     1   IHARG(6).EQ.'EXCE'.AND.IHARG2(6).EQ.'PT  ')ICASL7='FFT1'
      IF(NUMARG.GE.6.AND.
     1   IHARG(6).EQ.'FOR '.AND.IHARG2(6).EQ.'    ')ICASL7='FFT1'
      GOTO8005
C
 1256 CONTINUE
      ICASL7='IFFT'
      IF(NUMARG.LE.6)ICASL7='IFF1'
      IF(NUMARG.GE.7.AND.
     1   IHARG(7).EQ.'SUBS'.AND.IHARG2(7).EQ.'ET  ')ICASL7='IFF1'
      IF(NUMARG.GE.7.AND.
     1   IHARG(7).EQ.'EXCE'.AND.IHARG2(7).EQ.'PT  ')ICASL7='IFF1'
      IF(NUMARG.GE.7.AND.
     1   IHARG(7).EQ.'FOR '.AND.IHARG2(7).EQ.'    ')ICASL7='IFF1'
      GOTO8006
C
 1261 CONTINUE
      ICASL7='LAPT'
      GOTO8005
C
 1262 CONTINUE
      ICASL7='ILAT'
      GOTO8006
C
CCCCC THE FOLLOWING SECTION WAS ADDED JANUARY 1989
 1271 CONTINUE
      ICASL7='BOOT'
      GOTO8005
C
CCCCC THE FOLLOWING SECTION WAS ADDED JANUARY 1990
 1272 CONTINUE
      ICASL7='SUBS'
      GOTO8004
C
CCCCC THE FOLLOWING SECTION WAS ADDED JANUARY 1990
 1273 CONTINUE
      ICASL7='SUBS'
      GOTO8005
CCCCC THE FOLLOWING SECTION WAS ADDED OCTOBER 1993
 1274 CONTINUE
      ICASL7='JAIN'
      GOTO8005
C
 1275 CONTINUE
      ICASL7='SRNP'
      GOTO8007
C
C     -----COMPLEX NUMBERS-----
C
 2101 CONTINUE
      ICASL7='COAD'
      GOTO8006
C
 2102 CONTINUE
      ICASL7='COSU'
      GOTO8006
C
 2103 CONTINUE
      ICASL7='COMU'
      GOTO8006
C
 2104 CONTINUE
      ICASL7='CODI'
      GOTO8006
C
 2105 CONTINUE
      ICASL7='COEX'
      GOTO8006
C
 2106 CONTINUE
      ICASL7='COSR'
      GOTO8007
C
 2107 CONTINUE
      ICASL7='CORO'
      IF(NUMARG.LE.6)ICASL7='COR1'
      IF(NUMARG.GE.7.AND.
     1   IHARG(7).EQ.'SUBS'.AND.IHARG2(7).EQ.'ET  ')ICASL7='COR1'
      IF(NUMARG.GE.7.AND.
     1   IHARG(7).EQ.'EXCE'.AND.IHARG2(7).EQ.'PT  ')ICASL7='COR1'
      IF(NUMARG.GE.7.AND.
     1   IHARG(7).EQ.'FOR '.AND.IHARG2(7).EQ.'    ')ICASL7='COR1'
      GOTO8006
C
 2108 CONTINUE
      ICASL7='COCO'
      GOTO8006
C
C     -----POLYNOMIALS-----
C
 2201 CONTINUE
      ICASL7='POAD'
      GOTO8005
C
 2202 CONTINUE
      ICASL7='POSU'
      GOTO8005
C
 2203 CONTINUE
      ICASL7='POMU'
      GOTO8005
C
 2204 CONTINUE
      ICASL7='PODI'
      GOTO8006
C
 2205 CONTINUE
      ICASL7='POSQ'
      GOTO8005
C
 2206 CONTINUE
      ICASL7='POSR'
      GOTO8006
C
 2207 CONTINUE
      ICASL7='POGC'
      GOTO8005
C
 2208 CONTINUE
      ICASL7='POLC'
      GOTO8005
C
 2209 CONTINUE
      ICASL7='POEV'
      GOTO8005
C
 2210 CONTINUE
      ICASL7='PODI'
      GOTO8005
C
C     -----VECTORS-----
C
 2301 CONTINUE
      ICASL7='VEAD'
      GOTO8005
C
 2302 CONTINUE
      ICASL7='VESU'
      GOTO8005
C
 2303 CONTINUE
      ICASL7='VEDP'
      GOTO8006
C
 2304 CONTINUE
      ICASL7='VECP'
      GOTO8006
C
 2305 CONTINUE
      ICASL7='VELE'
      GOTO8005
C
 2306 CONTINUE
      ICASL7='VEDI'
      GOTO8005
C
 2307 CONTINUE
      ICASL7='VEAN'
      GOTO8005
C
C     -----SETS-----
C
 2401 CONTINUE
      ICASL7='SEUN'
      GOTO8005
C
 2402 CONTINUE
      ICASL7='SEIN'
      GOTO8005
C
 2403 CONTINUE
      ICASL7='SECO'
      GOTO8005
C
 2404 CONTINUE
      ICASL7='SECA'
      GOTO8005
C
 2405 CONTINUE
      ICASL7='SECP'
      GOTO8007
C
 2406 CONTINUE
      ICASL7='SEEL'
      GOTO8005
C
C     -----LOGICALS-----
C
 2501 CONTINUE
      ICASL7='LOAN'
      GOTO8005
C
 2502 CONTINUE
      ICASL7='LOOR'
      GOTO8005
C
 2503 CONTINUE
      ICASL7='LONA'
      GOTO8005
C
 2504 CONTINUE
      ICASL7='LONO'
      GOTO8005
C
 2505 CONTINUE
      ICASL7='LOIM'
      GOTO8005
C
 2506 CONTINUE
      ICASL7='LOEQ'
      GOTO8005
C
 2507 CONTINUE
      ICASL7='LONT'
      GOTO8005
C
 2508 CONTINUE
      ICASL7='LOXO'
      GOTO8005
C
C     -----MATRICES-----
C
 2601 CONTINUE
      ICASL7='MAAD'
      GOTO8005
C
 2602 CONTINUE
      ICASL7='MASU'
      GOTO8005
C
 2603 CONTINUE
      ICASL7='MAMU'
      GOTO8005
C
 2604 CONTINUE
      ICASL7='MASO'
      GOTO8005
C
 2605 CONTINUE
      ICASL7='MAIN'
      GOTO8005
C
 2606 CONTINUE
      ICASL7='MATR'
      GOTO8005
C
 2607 CONTINUE
      ICASL7='MAAJ'
      GOTO8005
C
 2608 CONTINUE
      ICASL7='MACE'
      GOTO8006
C
 2609 CONTINUE
      ICASL7='MAEA'
      GOTO8005
C
 2610 CONTINUE
      ICASL7='MAEA'
      GOTO8006
C
 2611 CONTINUE
      ICASL7='MAEE'
      GOTO8005
C
 2612 CONTINUE
      ICASL7='MAEE'
      GOTO8006
C
 2613 CONTINUE
      ICASL7='MARA'
      GOTO8005
C
 2614 CONTINUE
      ICASL7='MADE'
      GOTO8005
C
 2615 CONTINUE
      ICASL7='MAPE'
      GOTO8005
C
 2616 CONTINUE
      ICASL7='MASN'
      GOTO8006
C
 2617 CONTINUE
      ICASL7='MASR'
      GOTO8006
C
 2618 CONTINUE
      ICASL7='MANR'
      GOTO8006
C
 2619 CONTINUE
      ICASL7='MANR'
      GOTO8007
C
 2620 CONTINUE
      ICASL7='MANC'
      GOTO8006
C
 2621 CONTINUE
      ICASL7='MANC'
      GOTO8007
C
 2622 CONTINUE
      ICASL7='MASS'
      GOTO8006
C
 2623 CONTINUE
      ICASL7='MASS'
      GOTO8005
C
 2624 CONTINUE
      ICASL7='MARN'
      GOTO8005
C
 2631 CONTINUE
      ICASL7='MATC'
      GOTO8005
C
 2632 CONTINUE
      ICASL7='MASM'
      GOTO8005
C
 2633 CONTINUE
      ICASL7='MAMI'
      GOTO8005
C
 2634 CONTINUE
      ICASL7='MACF'
      GOTO8005
C
 2635 CONTINUE
      ICASL7='MADF'
      GOTO8005
C
 2636 CONTINUE
      ICASL7='MAEN'
      GOTO8006
C
 2637 CONTINUE
      ICASL7='MAEN'
      GOTO8005
C
 2641 CONTINUE
      ICASL7='MAVC'
      GOTO8006
C
 2642 CONTINUE
      ICASL7='MACO'
      GOTO8005
C
 2643 CONTINUE
      ICASL7='MAPC'
      IMSUBC='EVEC'
      GOTO8006
 2644 CONTINUE
      ICASL7='MAPC'
      IMSUBC='EVAL'
      GOTO8006
 2645 CONTINUE
      ICASL7='MAPC'
      IMSUBC='PC'
      GOTO8005
CCCCC JULY 1993.  FOLLOWING LINES ADDED FOR SINGULAR VALUE DECOMP.
 2646 CONTINUE
      ICASL7='MASD'
      GOTO8008
 2647 CONTINUE
      ICASL7='MASV'
      GOTO8005
 2648 CONTINUE
      ICASL7='MASF'
      GOTO8008
CCCCC END CHANGE
CCCCC SEPTEMBER 1993.  FOLLOWING LINES ADDED FOR MATRIX ROW,
CCCCC MATRIX ELEMENT.
 2649 CONTINUE
      ICASL7='MARW'
      GOTO8005
 2650 CONTINUE
      ICASL7='MAEL'
      GOTO8005
CCCCC END CHANGE
CCCCC OCTOBER 1993.  FOLLOWING SECTION ADDED FOR CHOLESKY DECOMP
 2651 CONTINUE
      ICASL7='MACH'
      GOTO8006
 2652 CONTINUE
      ICASL7='MACH'
      GOTO8005
C
 2653 CONTINUE
      IMSUBC='EVEC'
      ICASL7='MAP1'
      IF(IHARG(3).EQ.'SECO')ICASL7='MAP2'
      IF(IHARG(3).EQ.'THIR')ICASL7='MAP3'
      IF(IHARG(3).EQ.'FOUR')ICASL7='MAP4'
      IF(IHARG(3).EQ.'FIFT')ICASL7='MAP5'
      IF(IHARG(3).EQ.'SIXT')ICASL7='MAP6'
      IF(IHARG(3).EQ.'SEVE')ICASL7='MAP7'
      IF(IHARG(3).EQ.'EIGH')ICASL7='MAP8'
      IF(IHARG(3).EQ.'NINT')ICASL7='MAP9'
      IF(IHARG(3).EQ.'TENT')ICASL7='MA10'
      GOTO8007
 2654 CONTINUE
      IMSUBC='EVAL'
      ICASL7='MAP1'
      IF(IHARG(3).EQ.'SECO')ICASL7='MAP2'
      IF(IHARG(3).EQ.'THIR')ICASL7='MAP3'
      IF(IHARG(3).EQ.'FOUR')ICASL7='MAP4'
      IF(IHARG(3).EQ.'FIFT')ICASL7='MAP5'
      IF(IHARG(3).EQ.'SIXT')ICASL7='MAP6'
      IF(IHARG(3).EQ.'SEVE')ICASL7='MAP7'
      IF(IHARG(3).EQ.'EIGH')ICASL7='MAP8'
      IF(IHARG(3).EQ.'NINT')ICASL7='MAP9'
      IF(IHARG(3).EQ.'TENT')ICASL7='MA10'
      GOTO8007
 2655 CONTINUE
      IMSUBC='PC'
      ICASL7='MAP1'
      IF(IHARG(3).EQ.'SECO')ICASL7='MAP2'
      IF(IHARG(3).EQ.'THIR')ICASL7='MAP3'
      IF(IHARG(3).EQ.'FOUR')ICASL7='MAP4'
      IF(IHARG(3).EQ.'FIFT')ICASL7='MAP5'
      IF(IHARG(3).EQ.'SIXT')ICASL7='MAP6'
      IF(IHARG(3).EQ.'SEVE')ICASL7='MAP7'
      IF(IHARG(3).EQ.'EIGH')ICASL7='MAP8'
      IF(IHARG(3).EQ.'NINT')ICASL7='MAP9'
      IF(IHARG(3).EQ.'TENT')ICASL7='MA10'
      GOTO8006
C
 2656 CONTINUE
      ICASL7='MPCO'
      GOTO8006
C
 2657 CONTINUE
      ICASL7='MPCC'
      GOTO8007
C
 2658 CONTINUE
      ICASL7='MPCP'
      GOTO8007
C
 2659 CONTINUE
      ICASL7='MACC'
      GOTO8006
C
 2660 CONTINUE
      ICASL7='MACP'
      GOTO8006
C
 2661 CONTINUE
      ICASL7='MAEE'
      GOTO8004
C
 2662 CONTINUE
      ICASL7='MAEA'
      GOTO8004
CCCCC OCTOBER 1993.  FOLLOWING SECTION ADDED FOR CHOLESKY DECOMP
 2666 CONTINUE
      ICASL7='MACH'
      GOTO8004
C
 2668 CONTINUE
      ICASL7='MATZ'
      GOTO8005
C
 2669 CONTINUE
      ICASL7='MATZ'
      GOTO8006
C
 2670 CONTINUE
      ICASL7='MAUZ'
      GOTO8006
C
 2672 CONTINUE
      ICASL7='MACM'
      GOTO8005
C
CCCCC THE FOLLOWING SECTION WAS ADDED DECEMBER 1989
C     -----(DEX) GENERATORS-----
C
 2701 CONTINUE
      ICASL7='GEAD'
      GOTO8005
C
 2702 CONTINUE
      ICASL7='GESU'
      GOTO8005
C
 2703 CONTINUE
      ICASL7='GEMU'
      GOTO8005
C
CCCCC THE FOLLOWING WAS ADDED JULY 1991
 2801 CONTINUE
      ICASL7='COCD'
      GOTO8004
C
CCCCC THE FOLLOWING WAS ADDED JULY 1991
 2802 CONTINUE
      ICASL7='COCP'
      GOTO8004
C
CCCCC THE FOLLOWING WAS ADDED JUNE 1999
 2806 CONTINUE
      ICASL7='CUSA'
      GOTO8005
C
CCCCC THE FOLLOWING WAS ADDED JUNE 1999
 2808 CONTINUE
      ICASL7='CUSA'
      GOTO8007
C
CCCCC THE FOLLOWING WAS ADDED JUNE 1999
 2810 CONTINUE
      ICASL7='CU1A'
      GOTO8007
C
CCCCC THE FOLLOWING WAS ADDED MARCH 2001
 2812 CONTINUE
      ICASL7='STAN'
      GOTO8004
C
CCCCC THE FOLLOWING WAS ADDED MARCH 2001
 2814 CONTINUE
      ICASL7='LSST'
      GOTO8005
C
CCCCC THE FOLLOWING WAS ADDED MARCH 2001
 2816 CONTINUE
      ICASL7='LSTA'
      GOTO8005
C
CCCCC THE FOLLOWING WAS ADDED MARCH 2001
 2818 CONTINUE
      ICASL7='ZSCO'
      GOTO8004
C
CCCCC THE FOLLOWING WAS ADDED JUNE 2018
 2819 CONTINUE
      ICASL7='MNRK'
      GOTO8005
C
CCCCC THE FOLLOWING WAS ADDED MARCH 2001
 2820 CONTINUE
      ICASL7='USCO'
      GOTO8004
C
CCCCC THE FOLLOWING WAS ADDED JUNE 2018
 2821 CONTINUE
      ICASL7='MDRK'
      GOTO8005
C
CCCCC THE FOLLOWING WAS ADDED MARCH 2001
 2822 CONTINUE
      ICASL7='LSST'
      GOTO8005
C
CCCCC THE FOLLOWING WAS ADDED MARCH 2001
 2824 CONTINUE
      ICASL7='STAC'
      GOTO8005
C
 2825 CONTINUE
      ICASL7='RSTA'
      GOTO8007
C
CCCCC THE FOLLOWING WAS ADDED AUGUST 2016
 2826 CONTINUE
      ICASL7='UNST'
      GOTO8004
C
 2830 CONTINUE
      ICASL7='VPER'
      GOTO8005
C
CCCCC THE FOLLOWING SECTION WAS ADDED OCTOBER 1993
C     -----MORE MATRIX COMMANDS-
C
 2902 CONTINUE
      ICASL7='MAAU'
      GOTO8005
C
 2912 CONTINUE
      ICASL7='MADI'
      GOTO8005
C
 2922 CONTINUE
      ICASL7='MARR'
      GOTO8006
C
 2932 CONTINUE
      ICASL7='MARE'
      GOTO8006
C
 2942 CONTINUE
      ICASL7='DIMA'
      GOTO8005
C
 2952 CONTINUE
      ICASL7='MATD'
      GOTO8005
C
 2962 CONTINUE
      ICASL7='MAIS'
      GOTO8006
C
 2972 CONTINUE
      ICASL7='MATS'
      GOTO8005
C
 2982 CONTINUE
      ICASL7='MATI'
      GOTO8005
C
 4252 CONTINUE
      ICASL7='BLOC'
      GOTO8005
C
 4253 CONTINUE
      ICASL7='FLOC'
      GOTO8005
C
 4254 CONTINUE
      ICASL7='FLEN'
      GOTO8005
C
 4256 CONTINUE
      ICASL7='2DGR'
      GOTO8006
C
 4258 CONTINUE
      ICASL7='3DGR'
      GOTO8007
C
 4260 CONTINUE
      ICASL7='4DGR'
      GOTO8008
C
 5002 CONTINUE
      ICASL7='MPIN'
      GOTO8005
C
 5012 CONTINUE
      ICASL7='MQFO'
      GOTO8005
C
 5022 CONTINUE
      ICASL7='MHT1'
      GOTO8007
C
 5023 CONTINUE
      ICASL7='MHT2'
      GOTO8007
C
 5032 CONTINUE
      ICASL7='MDER'
      GOTO8006
C
 5033 CONTINUE
      ICASL7='MDEC'
      GOTO8006
C
 5034 CONTINUE
      ICASL7='MCSR'
      GOTO8006
C
 5035 CONTINUE
      ICASL7='MCSC'
      GOTO8006
C
 5036 CONTINUE
      ICASL7='MCDR'
      GOTO8006
C
 5037 CONTINUE
      ICASL7='MCDC'
      GOTO8006
C
 5038 CONTINUE
      ICASL7='MJSR'
      GOTO8006
C
 5039 CONTINUE
      ICASL7='MJSC'
      GOTO8006
C
 5040 CONTINUE
      ICASL7='MJDR'
      GOTO8006
C
 5041 CONTINUE
      ICASL7='MJDC'
      GOTO8006
C
 5042 CONTINUE
      ICASL7='MDMR'
      GOTO8006
C
 5044 CONTINUE
      ICASL7='MDMC'
      GOTO8006
C
 5045 CONTINUE
      ICASL7='MZSR'
      GOTO8007
C
 5046 CONTINUE
      ICASL7='MASC'
      GOTO8007
C
 5047 CONTINUE
      ICASL7='MZDR'
      GOTO8007
C
 5048 CONTINUE
      ICASL7='MADC'
      GOTO8007
C
 5049 CONTINUE
      ICASL7='MPDR'
      GOTO8006
C
55049 CONTINUE
      ICASL7='MPSR'
      GOTO8006
C
 5050 CONTINUE
      ICASL7='MPDC'
      GOTO8006
C
55050 CONTINUE
      ICASL7='MPSC'
      GOTO8006
C
 5051 CONTINUE
      ICASL7='MHDR'
      GOTO8006
C
 5052 CONTINUE
      ICASL7='MQRD'
      GOTO8005
C
 5053 CONTINUE
      ICASL7='MHDC'
      GOTO8006
C
 5054 CONTINUE
      ICASL7='MXDR'
      GOTO8006
C
 5055 CONTINUE
      ICASL7='MXDC'
      GOTO8006
C
 5062 CONTINUE
      ICASL7='MDKR'
      GOTO8006
C
 5064 CONTINUE
      ICASL7='MDKC'
      GOTO8006
C
 5072 CONTINUE
      ICASL7='MDBR'
      GOTO8006
C
 5074 CONTINUE
      ICASL7='MDBC'
      GOTO8006
C
 5082 CONTINUE
      ICASL7='MDCR'
      GOTO8006
C
 5084 CONTINUE
      ICASL7='MDCC'
      GOTO8006
C
 5086 CONTINUE
      ICASL7='MPVC'
      GOTO8007
C
 5087 CONTINUE
      ICASL7='MPVC'
      GOTO8006
C
 5088 CONTINUE
      ICASL7='MAAR'
      GOTO8006
C
 5090 CONTINUE
      ICASL7='MADR'
      GOTO8006
C
 5092 CONTINUE
      ICASL7='MAMM'
      GOTO8005
C
 5093 CONTINUE
      ICASL7='MSUM'
      GOTO8005
C
 5094 CONTINUE
      ICASL7='MADM'
      GOTO8006
C
 5096 CONTINUE
      ICASL7='MALC'
      GOTO8005
C
 5098 CONTINUE
      ICASL7='MAVT'
      GOTO8006
C
 5102 CONTINUE
      ICASL7='MAGM'
      GOTO8006
C
 5104 CONTINUE
      ICASL7='MAGS'
      GOTO8006
C
 5106 CONTINUE
      ICASL7='MAGS'
      GOTO8007
C
 5108 CONTINUE
      ICASL7='CBIN'
      GOTO8007
C
 5109 CONTINUE
      ICASL7='CBIR'
      GOTO8008
C
 5110 CONTINUE
      ICASL7='BINN'
      GOTO8005
C
 5112 CONTINUE
      ICASL7='BINN'
      GOTO8006
C
 5114 CONTINUE
      ICASL7='BINR'
      GOTO8006
C
 5116 CONTINUE
      ICASL7='BINR'
      GOTO8007
C
55112 CONTINUE
      ICASL7='BINP'
      GOTO8008
C
55113 CONTINUE
      ICASL7='BINP'
      GOTO8007
C
55114 CONTINUE
      ICASL7='BIRP'
      GOTO8009
C
55115 CONTINUE
      ICASL7='BIRP'
      GOTO8008
C
55212 CONTINUE
      ICASL7='PEAR'
      GOTO8006
C
55214 CONTINUE
      ICASL7='PEAK'
      GOTO8005
C
 5118 CONTINUE
      ICASL7='MVRN'
      GOTO8007
C
 5119 CONTINUE
      ICASL7='MTRN'
      GOTO8007
C
 5120 CONTINUE
      ICASL7='MACA'
      GOTO8005
C
 5122 CONTINUE
      ICASL7='MURN'
      GOTO8006
C
 5123 CONTINUE
      ICASL7='MPDF'
      GOTO8005
C
 5124 CONTINUE
      ICASL7='WIRN'
      GOTO8006
C
 5125 CONTINUE
      ICASL7='DIRN'
      GOTO8006
C
15125 CONTINUE
      ICASL7='DPDF'
      GOTO8005
C
 5126 CONTINUE
      ICASL7='VINF'
      GOTO8006
C
15127 CONTINUE
      ICASL7='DLPD'
      GOTO8006
C
 5128 CONTINUE
      ICASL7='CIND'
      GOTO8005
C
 5130 CONTINUE
      ICASL7='XTXI'
      GOTO8005
C
 5132 CONTINUE
      ICASL7='CRMA'
      GOTO8005
C
 5134 CONTINUE
      ICASL7='MACN'
      GOTO8006
C
 5136 CONTINUE
      ICASL7='MARC'
      GOTO8007
C
 5152 CONTINUE
      ICASL7='WINS'
      GOTO8004
C
 5154 CONTINUE
      ICASL7='NCDF'
      GOTO8006
C
 5156 CONTINUE
      ICASL7='TCDF'
      GOTO8006
C
 5158 CONTINUE
      ICASL7='IURN'
      GOTO8007
C
 5160 CONTINUE
      ICASL7='INRN'
      GOTO8007
C
 5190 CONTINUE
      ICASL7='FRAW'
      GOTO8006
C
 5192 CONTINUE
      ICASL7='ASHR'
      GOTO8006
C
 5193 CONTINUE
      ICASL7='ASHR'
      GOTO8005
C
 5194 CONTINUE
      ICASL7='ASHC'
      GOTO8007
C
 5195 CONTINUE
      ICASL7='IFRT'
      GOTO8008
C
 5196 CONTINUE
      ICASL7='CFRT'
      GOTO8008
C
 5197 CONTINUE
      ICASL7='MATB'
      GOTO8006
C
 5198 CONTINUE
      ICASL7='MATB'
      GOTO8007
C
 5199 CONTINUE
      ICASL7='MARB'
      GOTO8007
C
 5202 CONTINUE
      ICASL7='HCON'
      GOTO8006
C
 5203 CONTINUE
      ICASL7='HCON'
      GOTO8005
C
 5204 CONTINUE
      ICASL7='KCON'
      GOTO8006
C
 5205 CONTINUE
      ICASL7='KCON'
      GOTO8005
C
 5206 CONTINUE
      ICASL7='HCO2'
      GOTO8008
C
 5207 CONTINUE
      ICASL7='HCO2'
      GOTO8007
C
 5208 CONTINUE
      ICASL7='KCO2'
      GOTO8008
C
 5209 CONTINUE
      ICASL7='KCO2'
      GOTO8007
C
 5211 CONTINUE
      ICASL7='LMOM'
      GOTO8005
C
 5213 CONTINUE
      ICASL7='PWMO'
      GOTO8006
C
 5215 CONTINUE
      ICASL7='BPWM'
      GOTO8007
C
 5217 CONTINUE
      ICASL7='JITT'
      GOTO8004
C
 5219 CONTINUE
      ICASL7='AGCO'
      GOTO8007
C
 5220 CONTINUE
      ICASL7='AGCO'
      GOTO8008
C
 5221 CONTINUE
      ICASL7='EBLL'
      GOTO8007
C
 5223 CONTINUE
      ICASL7='EBUL'
      GOTO8007
C
 5224 CONTINUE
      ICASL7='BRAT'
      GOTO8009
C
 5225 CONTINUE
      ICASL7='2DCH'
      GOTO8007
C
 5226 CONTINUE
      ICASL7='POPL'
      GOTO8006
C
 5227 CONTINUE
      ICASL7='MSPT'
      GOTO8008
C
 5229 CONTINUE
      ICASL7='MSP2'
      GOTO8007
C
 5231 CONTINUE
      ICASL7='EDGV'
      GOTO8008
C
 5233 CONTINUE
      ICASL7='NEXS'
      GOTO8005
C
 5235 CONTINUE
      ICASL7='NEXP'
      GOTO8005
C
 5237 CONTINUE
      ICASL7='KNSE'
      GOTO8009
C
 5239 CONTINUE
      ICASL7='NEXC'
      GOTO8005
C
 5240 CONTINUE
      ICASL7='NEPA'
      GOTO8006
C
 5241 CONTINUE
      ICASL7='COPV'
      GOTO8003
C
 5246 CONTINUE
      ICASL7='NEXE'
      GOTO8007
C
 5248 CONTINUE
      ICASL7='SPF1'
      GOTO8007
C
 5250 CONTINUE
      ICASL7='SPF2'
      GOTO8008
C
 5252 CONTINUE
      ICASL7='ADMA'
      GOTO8005
C
 5253 CONTINUE
      ICASL7='ADMD'
      GOTO8006
C
 5254 CONTINUE
      ICASL7='ADMA'
      GOTO8007
C
 5255 CONTINUE
      ICASL7='ADMD'
      GOTO8008
C
 5256 CONTINUE
      ICASL7='NEYT'
      GOTO8006
C
 5257 CONTINUE
      ICASL7='CYTB'
      GOTO8007
C
 5258 CONTINUE
      ICASL7='SORG'
      GOTO8005
C
 5260 CONTINUE
      ICASL7='YTHL'
      GOTO8007
C
 5262 CONTINUE
      ICASL7='DPCL'
      GOTO8010
C
 5264 CONTINUE
      ICASL7='DPTS'
      GOTO8008
C
 5266 CONTINUE
      ICASL7='DPLT'
      GOTO8010
C
 5268 CONTINUE
      ICASL7='DPUT'
      GOTO8010
C
 5270 CONTINUE
      ICASL7='R1TS'
      GOTO8008
C
 5272 CONTINUE
      ICASL7='R1LT'
      GOTO8010
C
 5274 CONTINUE
      ICASL7='R1UT'
      GOTO8010
C
 5276 CONTINUE
      ICASL7='R2TS'
      GOTO8008
C
 5278 CONTINUE
      ICASL7='R2LT'
      GOTO8010
C
 5280 CONTINUE
      ICASL7='R2UT'
      GOTO8010
C
 5281 CONTINUE
      ICASL7='SOR2'
      GOTO8005
C
 5282 CONTINUE
      ICASL7='SOR3'
      GOTO8006
C
 5283 CONTINUE
      ICASL7='SOR4'
      GOTO8007
C
 5285 CONTINUE
      ICASL7='GATH'
      GOTO8004
C
 5287 CONTINUE
      ICASL7='SCAT'
      GOTO8004
C
 5289 CONTINUE
      ICASL7='RAN2'
      GOTO8004
C
 5291 CONTINUE
      ICASL7='RAN3'
      GOTO8004
C
 5293 CONTINUE
      ICASL7='RAN4'
      GOTO8004
C
 5294 CONTINUE
      ICASL7='RANI'
      GOTO8005
C
 5295 CONTINUE
      ICASL7='SHIF'
      GOTO8004
C
 5296 CONTINUE
      ICASL7='CSHI'
      GOTO8005
C
 5298 CONTINUE
      ICASL7='BIPL'
      GOTO8006
C
 5299 CONTINUE
      ICASL7='PERA'
      GOTO8005
C
15300 CONTINUE
      ICASL7='LARG'
      GOTO8004
C
15301 CONTINUE
      ICASL7='SMAL'
      GOTO8004
C
 5300 CONTINUE
      ICASL7='CDCT'
      GOTO8006
C
 5302 CONTINUE
      ICASL7='MFTR'
      GOTO8009
C
 5304 CONTINUE
      ICASL7='MFTC'
      GOTO8009
C
 5306 CONTINUE
      ICASL7='R3TS'
      GOTO8008
C
 5308 CONTINUE
      ICASL7='R3LT'
      GOTO8010
C
 5310 CONTINUE
      ICASL7='R3UT'
      GOTO8010
C
 5312 CONTINUE
      ICASL7='BPSE'
      GOTO8009
C
 5314 CONTINUE
      ICASL7='BPSE'
      GOTO8008
C
 5316 CONTINUE
      ICASL7='COMB'
      GOTO8004
C
 5318 CONTINUE
      ICASL7='EBCL'
      GOTO8008
C
 5320 CONTINUE
      ICASL7='EBCL'
      GOTO8007
C
 5322 CONTINUE
      ICASL7='BFPD'
      GOTO8007
C
 5324 CONTINUE
      ICASL7='BFCD'
      GOTO8007
C
 5326 CONTINUE
      ICASL7='BFPP'
      GOTO8007
C
 5328 CONTINUE
      ICASL7='EEPD'
      GOTO8007
C
 5330 CONTINUE
      ICASL7='EECD'
      GOTO8007
C
 5332 CONTINUE
      ICASL7='EEPP'
      GOTO8007
C
 5334 CONTINUE
      ICASL7='VMAT'
      GOTO8006
C
 5336 CONTINUE
      ICASL7='MVAR'
      GOTO8006
C
 5338 CONTINUE
      ICASL7='MCRO'
      GOTO8006
C
 5340 CONTINUE
      ICASL7='MCCO'
      GOTO8006
C
 5342 CONTINUE
      ICASL7='KEEP'
      GOTO8004
C
 5344 CONTINUE
      ICASL7='OMIT'
      GOTO8004
C
 5346 CONTINUE
      ICASL7='MWUF'
      GOTO8010
C
 5348 CONTINUE
      ICASL7='TMIN'
      GOTO8006
C
 5350 CONTINUE
      ICASL7='TMAX'
      GOTO8006
C
 5352 CONTINUE
      ICASL7='EN'
      GOTO8004
C
 5353 CONTINUE
      ICASL7='PA'
      GOTO8004
C
55353 CONTINUE
      ICASL7='DIPE'
      GOTO8004
C
 5354 CONTINUE
      ICASL7='EXPA'
      GOTO8004
C
 5355 CONTINUE
      ICASL7='JSCO'
      GOTO8004
C
55355 CONTINUE
      ICASL7='JSCT'
      GOTO8007
C
 5356 CONTINUE
      ICASL7='IZSC'
      GOTO8006
C
 5358 CONTINUE
      ICASL7='ZPRI'
      GOTO8007
C
 5360 CONTINUE
      ICASL7='IZET'
      GOTO8007
C
 5362 CONTINUE
      ICASL7='EZMI'
      GOTO8007
C
 5364 CONTINUE
      ICASL7='EZPL'
      GOTO8007
C
 5366 CONTINUE
      ICASL7='EN  '
      GOTO8007
C
 5367 CONTINUE
      ICASL7='PA  '
      GOTO8007
C
45367 CONTINUE
      ICASL7='DIPE'
      GOTO8007
C
46367 CONTINUE
      ICASL7='DIPE'
      GOTO8008
C
55358 CONTINUE
      ICASL7='ZPRI'
      GOTO8006
C
55360 CONTINUE
      ICASL7='IZET'
      GOTO8006
C
55362 CONTINUE
      ICASL7='EZMI'
      GOTO8006
C
55364 CONTINUE
      ICASL7='EZPL'
      GOTO8006
C
55366 CONTINUE
      ICASL7='EN  '
      GOTO8006
C
55367 CONTINUE
      ICASL7='PA  '
      GOTO8006
C
55368 CONTINUE
      ICASL7='DIPE'
      GOTO8006
C
55369 CONTINUE
      ICASL7='DIPE'
      GOTO8007
C
 5368 CONTINUE
      ICASL7='WMOM'
      GOTO8006
C
 5369 CONTINUE
      ICASL7='LNMO'
      GOTO8006
C
 5370 CONTINUE
      ICASL7='LPFI'
      GOTO8006
C
 5371 CONTINUE
      ICASL7='GAMO'
      GOTO8006
C
 5372 CONTINUE
      ICASL7='HPFI'
      GOTO8006
C
 5373 CONTINUE
      ICASL7='IGMO'
      GOTO8007
C
 5374 CONTINUE
      ICASL7='TPOI'
      GOTO8006
C
 5376 CONTINUE
      ICASL7='EXTP'
      GOTO8006
C
 5378 CONTINUE
      ICASL7='ENCB'
      GOTO8006
C
 5380 CONTINUE
      ICASL7='INTL'
      GOTO8006
C
 5382 CONTINUE
      ICASL7='PARL'
      GOTO8006
C
 5384 CONTINUE
      ICASL7='PERL'
      GOTO8006
C
 5386 CONTINUE
      ICASL7='NNE1'
      GOTO8006
C
 5388 CONTINUE
      ICASL7='NNE2'
      GOTO8006
C
 5390 CONTINUE
      ICASL7='NNE3'
      GOTO8006
C
 5392 CONTINUE
      ICASL7='NNE4'
      GOTO8005
C
 5394 CONTINUE
      ICASL7='JOIN'
      GOTO8008
C
 5396 CONTINUE
      ICASL7='FNNE'
      GOTO8008
C
 5398 CONTINUE
      ICASL7='ANNE'
      GOTO8010
C
 5400 CONTINUE
      ICASL7='GRPS'
      GOTO8005
C
 5402 CONTINUE
      ICASL7='RAEQ'
      GOTO8006
C
 5404 CONTINUE
      ICASL7='DIGI'
      GOTO8004
C
 5406 CONTINUE
      ICASL7='YFRA'
      GOTO8005
C
55401 CONTINUE
      ICASL7='Y1TS'
      GOTO8007
C
55402 CONTINUE
      ICASL7='Y1TD'
      GOTO8007
C
55403 CONTINUE
      ICASL7='Y2TS'
      GOTO8007
C
55404 CONTINUE
      ICASL7='Y2TD'
      GOTO8007
C
55406 CONTINUE
      ICASL7='X1TS'
      GOTO8007
C
55407 CONTINUE
      ICASL7='X1TD'
      GOTO8007
C
55408 CONTINUE
      ICASL7='X2TS'
      GOTO8007
C
55409 CONTINUE
      ICASL7='X2TD'
      GOTO8007
C
 5408 CONTINUE
      ICASL7='XFRA'
      GOTO8005
C
 5410 CONTINUE
      ICASL7='WSAT'
      GOTO8007
C
 5411 CONTINUE
      ICASL7='GWSA'
      GOTO8006
C
 5412 CONTINUE
      ICASL7='NKDM'
      GOTO8008
C
 5414 CONTINUE
      ICASL7='EQUF'
      GOTO8007
C
 5416 CONTINUE
      ICASL7='IQUF'
      GOTO8007
C
 5418 CONTINUE
      ICASL7='TIQF'
      GOTO8008
C
 5420 CONTINUE
      ICASL7='INSE'
      GOTO8004
C
C               *****************************************************
C               **  STEP 80--                                      **
C               **  DETERMINE IF THE WORD (OR COLUMN DESIGNATION)  **
C               **  AFTER THE KEY WORD (SORT, RANK, ETC.) IS A     **
C               **  VALID DATA VARIABLE OR COLUMN.                 **
C               **  DEFINE ILOCV.                                  **
C               *****************************************************
C
C8002 CONTINUE
CCCCC ILOCV=2
CCCCC GOTO8020
C
 8003 CONTINUE
      ILOCV=3
      GOTO8020
C
 8004 CONTINUE
      ILOCV=4
      GOTO8020
C
 8005 CONTINUE
      ILOCV=5
      GOTO8020
C
 8006 CONTINUE
      ILOCV=6
      GOTO8020
C
 8007 CONTINUE
      ILOCV=7
      GOTO8020
CCCCC JULY 1993.  FOLLOWING ADDED FOR SINGULAR VALUE DECOMPOSITION.
 8008 CONTINUE
      ILOCV=8
      GOTO8020
C
CCCCC JUNE 1998.  FOLLOWING ADDED FOR MATRIX <ROW/COLU> <STAT>
 8009 CONTINUE
      ILOCV=9
      GOTO8020
C
 8010 CONTINUE
      ILOCV=10
      GOTO8020
C
C8011 CONTINUE
CCCCC ILOCV=11
CCCCC GOTO8020
C
C8012 CONTINUE
CCCCC ILOCV=12
CCCCC GOTO8020
C
C8013 CONTINUE
CCCCC ILOCV=13
CCCCC GOTO8020
C
 8020 CONTINUE
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATH')
     1   CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASL7.EQ.'Y1TS')GOTO8040
      IF(ICASL7.EQ.'Y1TD')GOTO8040
      IF(ICASL7.EQ.'Y2TS')GOTO8040
      IF(ICASL7.EQ.'Y2TD')GOTO8040
      IF(ICASL7.EQ.'X1TS')GOTO8040
      IF(ICASL7.EQ.'X1TD')GOTO8040
      IF(ICASL7.EQ.'X2TS')GOTO8040
      IF(ICASL7.EQ.'X2TD')GOTO8040
      IF(ILOCV.GT.NUMARG)GOTO8039
C
C     FOLLOWING ACCEPT SCALAR AS FIRST ARGUMENT
C
      IF(ICASL7.EQ.'JAIN')GOTO8040
      IF(ICASL7.EQ.'AGCO')GOTO8040
      IF(ICASL7.EQ.'EBLL')GOTO8040
      IF(ICASL7.EQ.'EBUL')GOTO8040
      IF(ICASL7.EQ.'EBCL')GOTO8040
      IF(ICASL7.EQ.'DPCL')GOTO8040
      IF(ICASL7.EQ.'DPTS')GOTO8040
      IF(ICASL7.EQ.'DPLT')GOTO8040
      IF(ICASL7.EQ.'DPUT')GOTO8040
      IF(ICASL7.EQ.'R1TS')GOTO8040
      IF(ICASL7.EQ.'R1LT')GOTO8040
      IF(ICASL7.EQ.'R1UT')GOTO8040
      IF(ICASL7.EQ.'R2TS')GOTO8040
      IF(ICASL7.EQ.'R2LT')GOTO8040
      IF(ICASL7.EQ.'R2UT')GOTO8040
      IF(ICASL7.EQ.'R3TS')GOTO8040
      IF(ICASL7.EQ.'R3LT')GOTO8040
      IF(ICASL7.EQ.'R3UT')GOTO8040
      IF(ICASL7.EQ.'BPSE')GOTO8040
      IF(ICASL7.EQ.'BRAT')GOTO8040
      IF(ICASL7.EQ.'NEXS')GOTO8040
      IF(ICASL7.EQ.'NEXP')GOTO8040
      IF(ICASL7.EQ.'KNSE')GOTO8040
      IF(ICASL7.EQ.'NEXC')GOTO8040
      IF(ICASL7.EQ.'NEPA')GOTO8040
      IF(ICASL7.EQ.'NEXE')GOTO8040
      IF(ICASL7.EQ.'NEYT')GOTO8040
      IF(ICASL7.EQ.'COMB')GOTO8040
      IF(ICASL7.EQ.'VMAT')GOTO8040
      IF(ICASL7.EQ.'MWUF')GOTO8040
      IF(ICASL7.EQ.'INTL')GOTO8040
      IF(ICASL7.EQ.'PARL')GOTO8040
      IF(ICASL7.EQ.'PERL')GOTO8040
      IF(ICASL7.EQ.'DIGI')GOTO8040
      IF(ICASL7.EQ.'SRNP')GOTO8040
C
      IH=IHARG(ILOCV)
      IH2=IHARG2(ILOCV)
      DO8030I=1,NUMNAM
      IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO8040
      IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'M')GOTO8040
 8030 CONTINUE
 8039 CONTINUE
      IFOUN7='NO'
      ICASL7='UNKN'
      GOTO9000
 8040 CONTINUE
      IFOUN7='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MATH')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF CKMATH--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)IBUGA3,ISUBRO
 9013   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)IFOUN7,ICASL7,IMSUBC,ILOCV
 9014   FORMAT('IFOUN7,ICASL7,IMSUBC,ILOCV = ',3(A4,2X),I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE CKPREF(ICASFI,ILOCFI,IBUGA3,IFOUND,IERROR)
C
C     PURPOSE--CHECK TO SEE THE TYPE OF PRE-FIT COMMAND
C              THAT HAS BEEN GIVEN
C              (E.G., WHAT DEGREE).
C     OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO')
C                     --IERROR ('YES' OR 'NO')
C                     --ICASFI ('FIT', '1FIT', '2FIT', '3FIT', ETC.)
C                     --ILOCFI (AN INTEGER VALUE WHICH GIVES
C                              THE ARGUMENT NUMBER (1, 2, 3, ...)
C                              OF THE WORD    FIT     .
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--AUGUST    1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASFI
      CHARACTER*4 IBUGA3
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
C               *****************************
C               **  CHECK FOR PRE-FITTING  **
C               *****************************
C
      IFOUND='NO'
      IERROR='NO'
      ICASFI='UNKN'
      ILOCFI=-99
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 CKPREF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMARG
   53 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ICOM,ICOM2
   54 FORMAT('ICOM,ICOM2 = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I),IHARG2(I)
   56 FORMAT('I,IHARG(I),IHARG2(I) = ',I8,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               *********************************
C               **  STEP 1.1--                 **
C               **  SEARCH FOR PRE-FIT         **
C               **  (WITH UNSPECIFIED DEGREE)  **
C               *********************************
C
      ICASFI='FIT'
C
      IF(ICOM.EQ.'PREF')GOTO110
      IF(ICOM.EQ.'PRE ')GOTO111
C
      DO210I=1,NUMARG
      I2=I
      IF(IHARG(I).EQ.'PREF'.AND.IHARG2(I).EQ.'IT  ')GOTO219
  210 CONTINUE
      GOTO249
  219 CONTINUE
C
      NUMARG=NUMARG+1
      I2P1=I2+1
      IF(I2P1.GT.NUMARG)GOTO239
      DO230I=I2P1,NUMARG
      IREV=NUMARG-I+I2P1
      IREVM1=IREV-1
      IHARG(IREV)=IHARG(IREVM1)
      IHARG2(IREV)=IHARG2(IREVM1)
      IARGT(IREV)=IARGT(IREVM1)
      ARG(IREV)=ARG(IREVM1)
  230 CONTINUE
  239 CONTINUE
C
      IHARG(I2)='PRE '
      IHARG2(I2)='    '
      IARGT(I2)='WORD'
      IARG(I2)=-999
      ARG(I2)=-999.0
      IHARG(I2P1)='FIT '
      IHARG2(I2P1)='    '
      IARGT(I2P1)='WORD'
      IARG(I2P1)=-999
      ARG(I2P1)=-999.0
  249 CONTINUE
C
C               *********************************
C               **  STEP 1.2--                 **
C               **  SEARCH FOR ROBUST FITTING  **
C               *********************************
C
      ICASFI='RFIT'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'ROBU'.AND.IHARG(2).EQ.'PRE ')GOTO113
C
C               *******************************************
C               **  STEP 1.20--                          **
C               **  SEARCH FOR 0-TH DEGREE    FITTING     **
C               *******************************************
C
      ICASFI='0FIT'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'0'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'PRE ')GOTO114
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'0TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'ZERO'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'0'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'0'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'ZERO'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'CONS'.AND.IHARG(1).EQ.'PRE ')GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RECT'.AND.IHARG(1).EQ.'PRE ')GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'FLAT'.AND.IHARG(1).EQ.'PRE ')GOTO112
C
C               *******************************************
C               **  STEP 1.21--                          **
C               **  SEARCH FOR 1-ST DEGREE    FITTING     **
C               *******************************************
C
      ICASFI='1FIT'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'1'.AND.IHARG(1).EQ.'ST'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'PRE ')GOTO114
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'1ST'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'FIRS'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'1'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'ONE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'1'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'ONE'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'LINE'.AND.IHARG(1).EQ.'PRE ')GOTO112
C
C               *******************************************
C               **  STEP 1.22--                          **
C               **  SEARCH FOR 2-ND DEGREE    FITTING     **
C               *******************************************
C
      ICASFI='2FIT'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'2'.AND.IHARG(1).EQ.'ND'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'PRE ')GOTO114
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'2ND'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SECO'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'2'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'TWO'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'2'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'TWO'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'QUAD'.AND.IHARG(1).EQ.'PRE ')GOTO112
C
C               *******************************************
C               **  STEP 1.23--                          **
C               **  SEARCH FOR 3-RD DEGREE    FITTING     **
C               *******************************************
C
      ICASFI='3FIT'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'3'.AND.IHARG(1).EQ.'RD'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'PRE ')GOTO114
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'3RD'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'THIR'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'3'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'THRE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'3'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'THRE'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'CUBI'.AND.IHARG(1).EQ.'PRE ')GOTO112
C
C               *******************************************
C               **  STEP 1.24--                          **
C               **  SEARCH FOR 4-TH DEGREE    FITTING     **
C               *******************************************
C
      ICASFI='4FIT'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'4'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'PRE ')GOTO114
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'4TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'FOUR'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'4'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'FOUR'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'4'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'FOUR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'QUAR'.AND.IHARG(1).EQ.'PRE ')GOTO112
C
C               *******************************************
C               **  STEP 1.25--                          **
C               **  SEARCH FOR 5-TH DEGREE    FITTING     **
C               *******************************************
C
      ICASFI='5FIT'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'5'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'PRE ')GOTO114
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'5TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'FIFT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'5'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'FIVE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'5'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'FIVE'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'QUIN'.AND.IHARG(1).EQ.'PRE ')GOTO112
C
C               *******************************************
C               **  STEP 1.26--                          **
C               **  SEARCH FOR 6-TH DEGREE    FITTING     **
C               *******************************************
C
      ICASFI='6FIT'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'6'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'PRE ')GOTO114
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'6TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SIXT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'6'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SIX'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'6'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'SIX'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SEXT'.AND.IHARG(1).EQ.'PRE ')GOTO112
C
C               *******************************************
C               **  STEP 1.27--                          **
C               **  SEARCH FOR 7-TH DEGREE    FITTING     **
C               *******************************************
C
      ICASFI='7FIT'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'7'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'PRE ')GOTO114
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'7TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SEVE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'7'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SEVE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'7'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'SEVE'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SEPT'.AND.IHARG(1).EQ.'PRE ')GOTO112
C
C               *******************************************
C               **  STEP 1.28--                          **
C               **  SEARCH FOR 8-TH DEGREE    FITTING     **
C               *******************************************
C
      ICASFI='8FIT'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'8'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'PRE ')GOTO114
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'8TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'EIGH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'8'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'EIGH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'8'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'EIGH'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'OCTI'.AND.IHARG(1).EQ.'PRE ')GOTO112
C
C               *******************************************
C               **  STEP 1.29--                          **
C               **  SEARCH FOR 9-TH DEGREE    FITTING     **
C               *******************************************
C
      ICASFI='9FIT'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'9'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'PRE ')GOTO114
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'9TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'NINT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'9'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'NINE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'9'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'NINE'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'NONI'.AND.IHARG(1).EQ.'PRE ')GOTO112
C
C               *******************************************
C               **  STEP 1.20--                          **
C               **  SEARCH FOR 10-TH DEGREE   FITTING     **
C               *******************************************
C
      ICASFI='10FI'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'10'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'PRE ')GOTO114
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'10TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'TENT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'10'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'TEN'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'10'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'TEN'.AND.IHARG(2).EQ.'PRE ')
     1GOTO113
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'DEXI'.AND.IHARG(1).EQ.'PRE ')GOTO112
C
C               ********************************************
C               **  STEP 1.31--                           **
C               **  SINCE VALID COMMAND NOT FOUND, EXIT.  **
C               ********************************************
C
      ICASFI='    '
C
      IFOUND='NO'
      GOTO9000
C
  110 CONTINUE
      ILASTC=0
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  112 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  113 CONTINUE
      ILASTC=3
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  114 CONTINUE
      ILASTC=4
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      ILOCFI=ILASTC
      IFOUND='YES'
      GOTO190
C
  190 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 CKPREF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASFI,ILOCFI
 9013 FORMAT('ICASFI,ILOCFI = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NUMARG
 9016 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)ICOM,ICOM2
 9017 FORMAT('ICOM,ICOM2 = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,NUMARG
      WRITE(ICOUT,9021)I,IHARG(I),IHARG2(I)
 9021 FORMAT('I,IHARG(I),IHARG2(I) = ',I8,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE CKPRPA(ANOPL1,ANOPL2,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--CHECK THE PARAMETERS NEEDED
C              FOR THE PROPORTION (= ANOP) STATISTIC.

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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/6
C     ORIGINAL VERSION--MAY       1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
CCCCC CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
CCCCC CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='CKPR'
      ISUBN2='PA  '
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'PRPA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF CKPRPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR
   52 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C     --------------------------
C
      IHP='LOWE'
      IHP2='R   '
      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')GOTO1110
      ANOPL1=VALUE(ILOCP)
      GOTO1119
C
 1110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN CKPRPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      IN COMPUTING THE PROPORTION STATISTIC,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
 1114 FORMAT('      THE LOWER BOUND (PARAMETER LOWER) OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)
 1115 FORMAT('     REGION OF INTEREST MUST BE PRE-DEFINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1116)
 1116 FORMAT('      USE THE LET COMMAND TO PRE-DEFINE    LOWER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1117)
 1117 FORMAT('      AS IN         LET LOWER = 900')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
C     --------------------------
C
      IHP='UPPE'
      IHP2='R   '
      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')GOTO2110
      ANOPL2=VALUE(ILOCP)
      GOTO2119
C
 2110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2111)
 2111 FORMAT('***** ERROR IN CKPRPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2112)
 2112 FORMAT('      IN COMPUTING THE PROPORTION STATISTIC,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2114)
 2114 FORMAT('      THE UPPER BOUND (PARAMETER UPPER) OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2115)
 2115 FORMAT('     REGION OF INTEREST MUST BE PRE-DEFINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2116)
 2116 FORMAT('      USE THE LET COMMAND TO PRE-DEFINE    UPPER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2117)
 2117 FORMAT('      AS IN         LET UPPER = 1100')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2119 CONTINUE
C
C     --------------------------
C
      IF(ANOPL1.LT.ANOPL2)GOTO3129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3111)
 3111 FORMAT('***** ERROR IN CKPRPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3112)
 3112 FORMAT('      IN COMPUTING THE PROPORTION STATISTIC,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3114)
 3114 FORMAT('      THE VALUE OF THE LOWER REGION LIMIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3115)
 3115 FORMAT('      (PARAMETER LOWER) MUST BE STRICTLY')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3116)
 3116 FORMAT('      LESS THAN THE VALUE OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3117)
 3117 FORMAT('      UPPER REGION LIMIT (PARAMETER UPPER).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3118)
 3118 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3119)ANOPL1
 3119 FORMAT('            LOWER = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3120)ANOPL2
 3120 FORMAT('            UPPER = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3129 CONTINUE
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'PRPA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF CKPRPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG3,ISUBRO,IERROR
 9012 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ANOPL1,ANOPL2
 9013 FORMAT('ANOPL1,ANOPL2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE CKPRSC(X,N,ISORSW,ICASAX,
     1ISUBG4,IBUGPL,IERRG4)
C
C     PURPOSE--CHECK THAT ALL DATA IN X(.) ARE VALID
C              (IN THIS CASE, MEANING    0 < X(.) < 100   )
C              IN PREPARATION FOR A PROBABILITY SCALE TRANSFORMATION.
C              (SUCH AS (0 TO 100) WEIBULL OR NORMAL)
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--88.10
C     ORIGINAL VERSION--MAY        1983.
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--SEPTEMBER 1988.
C     UPDATED         --JULY       1993 ADD NORMAL TO WEIBULL
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 ISORSW
      CHARACTER*4 ICASAX
C
      CHARACTER*4 ISUBG4
      CHARACTER*4 IBUGPL
      CHARACTER*4 IERRG4
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      IERRG4='NO'
      AHUNDR=100.0
C
      IF(IBUGPL.EQ.'OFF'.AND.ISUBG4.NE.'PRSC')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF CKPRSC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGPL,ISUBG4,IERRG4
   52 FORMAT('IBUGPL,ISUBG4,IERRG4 = ',3A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ISORSW,ICASAX
   53 FORMAT('ISORSW,ICASAX = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)N
   61 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO62I=1,N
      WRITE(ICOUT,63)I,X(I)
   63 FORMAT('I,X(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   62 CONTINUE
   90 CONTINUE
C
C               **************************************************
C               **  STEP 11--                                   **
C               **  CHECK THAT ALL X(.) ARE > 0 AND < 100       **
C               **************************************************
C
      DO1135I=1,N
      J=I
      IF(X(J).LE.0.0.OR.X(J).GE.100.0)GOTO1150
 1135 CONTINUE
      GOTO9000
C
 1150 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN CKPRSC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      AN ILLEGAL DATA OR LIMITS VALUE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      WAS ENCOUNTERED IN FORMING A PLOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)
 1154 FORMAT('      DATA MUST BE STRICTLY GREATER THAN 0')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      AND STRICTLY LESS THAN 100')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)
 1156 FORMAT('      WHEN A WEIBULL OR NORMAL SCALE PLOT IS USED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1157)X(J)
 1157 FORMAT('      THE VALUE = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1160)
 1160 FORMAT('      THIS VALUE CAME FROM THE ')
      IF(ICASAX.EQ.'2DHO')WRITE(ICOUT,1161)
 1161 FORMAT('      2-D HORIZONTAL AXIS VARIABLE.')
      IF(ICASAX.EQ.'2DHO')CALL DPWRST('XXX','BUG ')
      IF(ICASAX.EQ.'2DVE')WRITE(ICOUT,1162)
 1162 FORMAT('      2-D VERTICAL AXIS VARIABLE.')
      IF(ICASAX.EQ.'2DVE')CALL DPWRST('XXX','BUG ')
      IF(ICASAX.EQ.'3DH1')WRITE(ICOUT,1163)
 1163 FORMAT('      FIRST 3-D HORIZONTAL AXIS VARIABLE.')
      IF(ICASAX.EQ.'3DH1')CALL DPWRST('XXX','BUG ')
      IF(ICASAX.EQ.'3DH2')WRITE(ICOUT,1164)
 1164 FORMAT('      2ND 3-D HORIZONTAL AXIS VARIABLE.')
      IF(ICASAX.EQ.'3DH2')CALL DPWRST('XXX','BUG ')
      IF(ICASAX.EQ.'3DVE')WRITE(ICOUT,1165)
 1165 FORMAT('      3-D VERTICAL AXIS VARIABLE.')
      IF(ICASAX.EQ.'3DVE')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1171)
 1171 FORMAT('      CORRECTIVE ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1172)
 1172 FORMAT('      CHANGE DATA OR CHANGE LIMITS.')
      CALL DPWRST('XXX','BUG ')
      IERRG4='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGPL.EQ.'OFF'.AND.ISUBG4.NE.'PRSC')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF CKPRSC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGPL,ISUBG4,IERRG4
 9012 FORMAT('IBUGPL,ISUBG4,IERRG4 = ',3A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ISORSW,ICASAX
 9013 FORMAT('ISORSW,ICASAX = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)N,J
 9021 FORMAT('N,J = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9022I=1,N
      WRITE(ICOUT,9023)I,X(I)
 9023 FORMAT('I,X(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE CKRAND(ICASRA,ILOCNU,NUMSHA,
     1                  SHAPE1,SHAPE2,SHAPE3,SHAPE4,
     1                  SHAPE5,SHAPE6,SHAPE7,
     1                  IBUGA3,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CHECK TO SEE IF A RANDOM NUMBER
C              COMMAND HAS BEEN GIVEN.
C     OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO')
C                     --IERROR ('YES' OR 'NO')
C                     --ICASRA ('UNIF', 'NORM', 'LOGI', ETC.)
C                     --ILOCNU (AN INTEGER VALUE WHICH GIVES
C                              THE ARGUMENT NUMBER (1, 2, 3, ...)
C                              OF THE WORD    NUMBER     .
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MAY       1978.
C     UPDATED         --JUNE      1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1988.  EXTENSIVE. TO SIMPLIFY CALL
C     UPDATED         --DECEMBER  1988.  DISCRETE UNIFORM
C     UPDATED         --DECEMBER  1988.  BOOTSTRAP INDEX
C     UPDATED         --DECEMBER  1988.  RANDOM INDEX = BOOTSTRAP INDEX
C     UPDATED         --DECEMBER  1988.  RANDOM PERMUTATION
C     UPDATED         --DECEMBER  1988.  RAND SAMP FOR RAND NUMB
C     UPDATED         --JANUARY   1988.  JACKNIFE INDEX
C     UPDATED         --MAY       1990.  IG, WALD, RIG, FL (SAUNDERS)
C     UPDATED         --MAY       1993.  ADD GUMBEL AND FRECHET NAMES
C     UPDATED         --OCTOBER   1993.  MOVED JACKNIFE INDEX TO CKMATH
C     UPDATED         --DECEMBER  1993.  ADD EV1 AND EV2 NAMES
C     UPDATED         --DECEMBER  1993.  GENERALIZED PARETO
C     UPDATED         --APRIL     1995.  POWER FUNCTION
C     UPDATED         --AUGUST    1995.  HYPERGEOMETRIC
C     UPDATED         --AUGUST    1995.  NON-CENTRAL CHI-SQUARE
C     UPDATED         --AUGUST    1995.  NON-CENTRAL F
C     UPDATED         --AUGUST    1995.  DOUBLY NON-CENTRAL F
C     UPDATED         --OCTOBER   1995.  FOLDED NORMAL
C     UPDATED         --OCTOBER   1995.  HALF-CAUCHY
C     UPDATED         --MAY       1998.  NORMAL MIXTURE
C     UPDATED         --MAY       1998.  POWER LAW
C     UPDATED         --AUGUST    2001.  GENERALIZED LAMBDA
C     UPDATED         --SEPTEMBER 2001.  INVERTED WEIBULL
C     UPDATED         --OCTOBER   2001.  DOUBLE WEIBULL
C     UPDATED         --OCTOBER   2001.  DOUBLE GAMMA
C     UPDATED         --OCTOBER   2001.  LOG GAMMA
C     UPDATED         --OCTOBER   2001.  INVERTED GAMMA
C     UPDATED         --OCTOBER   2001.  COSINE
C     UPDATED         --OCTOBER   2001.  ANGLIT
C     UPDATED         --OCTOBER   2001.  HYPERBOLIC SECANT
C     UPDATED         --OCTOBER   2001.  ARCSIN
C     UPDATED         --OCTOBER   2001.  LOG DOUBLE EXPONENTIAL
C     UPDATED         --OCTOBER   2001.  GENERALIZED EXTREME VALUE
C     UPDATED         --OCTOBER   2001.  EXPONENTIATED WEIBULL
C     UPDATED         --OCTOBER   2001.  GOMPERTZ
C     UPDATED         --OCTOBER   2001.  HALF-LOGISTIC
C     UPDATED         --OCTOBER   2001.  POWER EXPONENTIAL
C     UPDATED         --OCTOBER   2001.  ALPHA
C     UPDATED         --OCTOBER   2001.  BRADFORD
C     UPDATED         --OCTOBER   2001.  RECIPROCAL
C     UPDATED         --OCTOBER   2001.  JOHNSON SU
C     UPDATED         --OCTOBER   2001.  JOHNSON SB
C     UPDATED         --OCTOBER   2001.  POWER NORMAL
C     UPDATED         --OCTOBER   2001.  LOG-LOGISTIC
C     UPDATED         --NOVEMBER  2001.  GEOMETRIC EXTREME EXPONENTIAL
C     UPDATED         --NOVEMBER  2001.  POWER LOGNORMAL
C     UPDATED         --DECEMBER  2001.  BETA-BINOMIAL
C     UPDATED         --MAY       2002.  TWO-SIDED POWER
C     UPDATED         --MAY       2002.  BIWEIBULL
C     UPDATED         --AUGUST    2002.  LOGARITHMIC SERIES
C     UPDATED         --JANUARY   2003.  G-AND-H
C     UPDATED         --JANUARY   2003.  SLASH
C     UPDATED         --APRIL     2003.  LANDAU
C     UPDATED         --MAY       2003.  INVERTED BETA
C     UPDATED         --MAY       2003.  ERROR (OR SUBBOTIN OR
C                                        EXPONENTIAL POWER)
C     UPDATED         --JUNE      2003.  TRAPEZOID, VON MISES,
C                                        PARETO SECOND KIND,
C                                        WRAPPED CAUCHY,
C                                        GENERALIZED TRAPEZOID
C     UPDATED         --JULY      2003.  TRUNCATED NORMAL, CHI,
C                                        FOLDED CAUCHY,
C                                        MIELKE BETA-KAPPA,
C                                        TRUNCATED EXPONENTIAL,
C                                        GENERALIZED EXPONENTIAL
C     UPDATED         --SEPTEMBER 2003.  GENERALIZED GAMMA
C     UPDATED         --NOVEMBER  2003.  FOLDED T
C     UPDATED         --NOVEMBER  2003.  SKEWED T
C     UPDATED         --NOVEMBER  2003.  SKEWED NORMAL
C     UPDATED         --NOVEMBER  2003.  ZIPF
C     UPDATED         --DECEMBER  2003.  GOMPERTZ-MAKEM
C     UPDATED         --DECEMBER  2003.  GENERALIZED INVERSE GAUSSIAN
C     UPDATED         --MARCH     2004.  LOG SKEWED T
C     UPDATED         --MARCH     2004.  LOG SKEWED NORMAL
C     UPDATED         --MARCH     2004.  NON-CENTRAL T
C     UPDATED         --MARCH     2004.  DOUBLY NON-CENTRAL T
C     UPDATED         --MARCH     2004.  GENERALIZED LOGISTIC
C     UPDATED         --MARCH     2004.  GENERALIZED HALF-LOGISTIC
C     UPDATED         --MARCH     2004.  POLYA
C     UPDATED         --APRIL     2004.  HERMITE
C     UPDATED         --APRIL     2004.  YULE
C     UPDATED         --APRIL     2004.  WARING
C     UPDATED         --APRIL     2004.  GENERALIZED WARING
C     UPDATED         --APRIL     2004.  NON-CENTRAL BETA
C     UPDATED         --MAY       2004.  DOUBLY NON-CENTRAL BETA
C     UPDATED         --JUNE      2004.  SKEW DOUBLE EXPONENTIAL
C     UPDATED         --JUNE      2004.  ASYMMETRIC DOUBLE EXPONENTIAL
C     UPDATED         --JUNE      2004.  GENERALIZED ASYMMETRIC LAPLACE
C     UPDATED         --JUNE      2004.  MAXWELL
C     UPDATED         --JUNE      2004.  RAYLEIGH
C     UPDATED         --AUGUST    2004.  MCLEISH
C     UPDATED         --AUGUST    2004.  BESSEL I FUNCTION
C     UPDATED         --AUGUST    2004.  BESSEL K FUNCTION
C     UPDATED         --SEPTEMBER 2004.  GENERALIZED MCLEISH
C     UPDATED         --SEPTEMBER 2004.  HYPERBOLIC
C     UPDATED         --FEBRUARY  2006.  GENERALIZED LOGISTIC TYPE 5
C     UPDATED         --FEBRUARY  2006.  WAKEBY
C     UPDATED         --MARCH     2006.  BETA-NORMAL
C     UPDATED         --MARCH     2006.  GENERALIZED LOGISTIC TYPE 2
C     UPDATED         --MARCH     2006.  GENERALIZED LOGISTIC TYPE 3
C     UPDATED         --MARCH     2006.  GENERALIZED LOGISTIC TYPE 4
C     UPDATED         --MARCH     2006.  ASYMMETRIC LOG LAPLACE
C     UPDATED         --MAY       2006.  BETA-GEOMETRIC
C     UPDATED         --MAY       2006.  ZETA
C     UPDATED         --MAY       2006.  BOREL-TANNER
C     UPDATED         --MAY       2006.  BETA-NEGATIVE BINOMIAL
C                                        (SYNONYM FOR GENERALZIED
C                                        WARING)
C     UPDATED         --JUNE      2006.  LAGRANGE POISSON
C     UPDATED         --JUNE      2006.  LEADS IN COIN TOSSING
C                                        (DISCRETE ARCSINE)
C     UPDATED         --JUNE      2006.  MATCHING
C     UPDATED         --JUNE      2006.  CLASSICAL OCCUPANCY (NOT ACTIVE)
C     UPDATED         --JUNE      2006.  LOG BETA (NOT ACTIVE)
C     UPDATED         --JUNE      2006.  POLYA-AEPPLI
C     UPDATED         --JUNE      2006.  LOST GAMES
C     UPDATED         --JUNE      2006.  NEYMAN TYPE A (NOT ACTIVE)
C     UPDATED         --JUNE      2006.  DXG (NOT ACTIVE)
C     UPDATED         --JUNE      2006.  GENERALIZED LOGARITHMIC SERIES
C     UPDATED         --JULY      2006.  GENERALIZED NEGATIVE BINOMIAL
C     UPDATED         --JULY      2006.  GEETA
C     UPDATED         --JULY      2006.  QUASI BINOMIAL TYPE I
C     UPDATED         --JULY      2006.  POISSON-INVERSE GAUSSIAN
C                                        (NOT ACTIVE)
C     UPDATED         --AUGUST    2006.  CONSUL
C     UPDATED         --AUGUST    2006.  LAGRANGE KATZ (NOT ACTIVE)
C     UPDATED         --SEPTEMBER 2006.  KATZ
C     UPDATED         --NOVEMBER  2006.  DISCRETE WEIBULL
C     UPDATED         --NOVEMBER  2006.  GENERALIZED LOST GAMES
C     UPDATED         --JANUARY   2007.  TRUNCATED GENERALIZED
C                                        NEGATIVE BINOMIAL
C     UPDATED         --FEBRUARY  2007.  TOPP AND LEONE
C     UPDATED         --FEBRUARY  2007.  GENERALIZED TOPP AND LEONE
C     UPDATED         --FEBRUARY  2007.  REFLECTED GENERALIZED TOPP
C                                        AND LEONE
C     UPDATED         --SEPTEMBER 2007.  SLOPE
C     UPDATED         --SEPTEMBER 2007.  TWO-SIDED SLOPE
C     UPDATED         --SEPTEMBER 2007.  OGIVE
C     UPDATED         --SEPTEMBER 2007.  TWO-SIDED OGIVE
C     UPDATED         --OCTOBER   2007.  BURR TYPE 1
C     UPDATED         --OCTOBER   2007.  BURR TYPE 2
C     UPDATED         --OCTOBER   2007.  BURR TYPE 3
C     UPDATED         --OCTOBER   2007.  BURR TYPE 4
C     UPDATED         --OCTOBER   2007.  BURR TYPE 5
C     UPDATED         --OCTOBER   2007.  BURR TYPE 6
C     UPDATED         --OCTOBER   2007.  BURR TYPE 7
C     UPDATED         --OCTOBER   2007.  BURR TYPE 8
C     UPDATED         --OCTOBER   2007.  BURR TYPE 9
C     UPDATED         --OCTOBER   2007.  BURR TYPE 10
C     UPDATED         --OCTOBER   2007.  BURR TYPE 11
C     UPDATED         --OCTOBER   2007.  BURR TYPE 12
C     UPDATED         --OCTOBER   2007.  UNEVEN TWO-SIDED POWER
C     UPDATED         --OCTOBER   2007.  DOUBLY UNIFORM PARETO
C     UPDATED         --OCTOBER   2007.  KUMARASWAMY
C     UPDATED         --DECEMBER  2007.  REFLECTED POWER
C     UPDATED         --JANUARY   2008.  MUTH
C     UPDATED         --FEBRUARY  2008.  LOGISTIC-EXPONENTIAL
C     UPDATED         --MARCH     2008.  TRUNCATED PARETO
C     UPDATED         --MARCH     2008.  BRITTLE FRACTURE
C     UPDATED         --MARCH     2008.  3-PARAMETER
C                                        LOGISTIC-EXPONENTIAL
C     UPDATED         --APRIL     2008.  RANDOM SUBSET
C     UPDATED         --APRIL     2008.  RANDOM K-SET OF N-SET
C     UPDATED         --APRIL     2008.  RANDOM COMPOSITION
C     UPDATED         --APRIL     2008.  RANDOM PARTITION
C     UPDATED         --MAY       2008.  KAPPA
C     UPDATED         --MAY       2008.  PEARSON TYPE 3
C     UPDATED         --JUNE      2008.  RANDOM EQUIVALENCE RELATION
C     UPDATED         --JULY      2008.  RANDOM YOUNG TABLEAUX
C     UPDATED         --SEPTEMBER 2009.  USE "EXTDIS" TO DETERMINE
C                                        DISTRIBUTION NAME (A FEW
C                                        COMMANDS ARE HANDLED
C                                        SEPARATELY, E.G. RANDOM SUBSET)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASRA
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
      CHARACTER*4  ISTEPN
      CHARACTER*4  ISUBN1
      CHARACTER*4  ISUBN2
      CHARACTER*60 IDIST
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
C               ******************************************
C               **  CHECK FOR RANDOM NUMBER GENERATION  **
C               ******************************************
C
      IFOUND='NO'
      IERROR='NO'
      ICASRA='UNKN'
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'RAND')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF CKRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA3,NUMARG
   52   FORMAT('IBUGA3,NUMARG = ',A4,2X,I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)SHAPE1,SHAPE2,SHAPE3,SHAPE4
   53   FORMAT('SHAPE1,SHAPE2,SHAPE3,SHAPE4 = ',4G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,54)SHAPE5,SHAPE6,SHAPE7
   54   FORMAT('SHAPE5,SHAPE6,SHAPE7 = ',3G15.7)
        CALL DPWRST('XXX','BUG ')
        DO55I=1,NUMARG
          WRITE(ICOUT,56)I,IHARG(I),IHARG2(I)
   56     FORMAT('I,IHARG(I),IHARG2(I) = ',I8,A4,2X,A4)
          CALL DPWRST('XXX','BUG ')
   55   CONTINUE
      ENDIF
C
      IF(IHARG(3).EQ.'RAND' .AND. IHARG(4).EQ.'PART')THEN
        IF(NUMARG.LE.3)GOTO9000
      ELSEIF(IHARG(3).EQ.'INDE' .AND. IHARG(4).EQ.'UNIF' .AND.
     1       IHARG(5).EQ.'RAND')THEN
        GOTO9000
      ELSEIF(IHARG(3).EQ.'CORR' .AND. IHARG(4).EQ.'UNIF' .AND.
     1       IHARG(5).EQ.'RAND')THEN
        GOTO9000
      ELSEIF(IHARG(3).EQ.'MULT' .AND. IHARG(4).EQ.'NORM' .AND.
     1       IHARG(5).EQ.'RAND')THEN
        GOTO9000
      ELSEIF(IHARG(3).EQ.'MULT' .AND. IHARG(4).EQ.'T   ' .AND.
     1       IHARG(5).EQ.'RAND')THEN
        GOTO9000
      ELSEIF(IHARG(3).EQ.'MULT' .AND. IHARG(4).EQ.'RAND')THEN
        GOTO9000
      ELSEIF(IHARG(3).EQ.'WISH' .AND. IHARG(4).EQ.'RAND')THEN
        GOTO9000
      ELSEIF(IHARG(3).EQ.'DIRC' .AND. IHARG(4).EQ.'RAND')THEN
        GOTO9000
      ELSE
        IF(NUMARG.LE.4)GOTO9000
      ENDIF
C
      JSTART=1
      JMAX=NUMARG-1
      DO100J=1,JMAX
        JP1=J+1
        JP2=J+2
        JP3=J+3
        JP4=J+4
        JP5=J+5
        IF(J.GE.4.AND.IHARG(J).EQ.'RAND'.AND.
     1     (IHARG(JP1).EQ.'NUMB' .OR. IHARG(JP1).EQ.'SAMP'))THEN
          JMIN=3
          JMAX=J-1
          GOTO190
        ELSEIF(IHARG(J).EQ.'BOOT'.AND.IHARG(JP1).EQ.'INDE')THEN
          ICASRA='BOOT'
          ILOCNU=4
          GOTO1190
        ELSEIF(IHARG(J).EQ.'RAND'.AND.IHARG(JP1).EQ.'INDE')THEN
          ICASRA='BOOT'
          ILOCNU=4
          GOTO1190
        ELSEIF(IHARG(J).EQ.'RAND'.AND.IHARG(JP1).EQ.'PERM')THEN
          IF(J.GE.2 .AND. IHARG(J-1).EQ.'SAMP')GOTO9000
          ICASRA='PERM'
          ILOCNU=4
          GOTO1190
        ELSEIF(IHARG(J).EQ.'RAND'.AND.IHARG(JP1).EQ.'SUBS')THEN
          ICASRA='SUBS'
          ILOCNU=5
          GOTO1190
        ELSEIF(IHARG(J).EQ.'RAND'.AND.IHARG(JP1).EQ.'COMP')THEN
          ICASRA='RANC'
          ILOCNU=5
          GOTO1190
        ELSEIF(IHARG(J).EQ.'RAND'.AND.IHARG(JP1).EQ.'PART')THEN
          ICASRA='RANP'
          ILOCNU=5
          GOTO1190
        ELSEIF(IHARG(J)  .EQ.'RAND' .AND. IHARG(JP1).EQ.'K   '.AND.
     1         IHARG(JP2).EQ.'SET ' .AND. IHARG(JP3).EQ.'OF  '.AND.
     1         IHARG(JP4).EQ.'N   ' .AND. IHARG(JP5).EQ.'SET ')THEN
          ICASRA='KNSE'
          ILOCNU=9
          GOTO1190
        ELSEIF(IHARG(J).EQ.'RAND'.AND.IHARG(JP1).EQ.'EQUI'.AND.
     1     IHARG(JP2).EQ.'RELA')THEN
          ICASRA='RANE'
          ILOCNU=6
          GOTO1190
        ELSEIF(IHARG(J).EQ.'RAND'.AND.IHARG(JP1).EQ.'YOUN'.AND.
     1     IHARG(JP2).EQ.'TABL')THEN
          ICASRA='RAYT'
          ILOCNU=6
          GOTO1190
        ELSEIF(IHARG(J)  .EQ.'EXCL' .AND. IHARG(JP1).EQ.'ZONE'.AND.
     1         IHARG(JP2).EQ.'UNIF' .AND. IHARG(JP3).EQ.'RAND'.AND.
     1         IHARG(JP4).EQ.'NUMB')THEN
          ICASRA='UNEX'
          ILOCNU=8
          GOTO1190
        ENDIF
C
  100 CONTINUE
      IFOUND='NO'
      GOTO9000
  190 CONTINUE
C
C  END OF SEARCH
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'RAND')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,211)JMIN,JMAX
  211   FORMAT('CKRAND: BEFORE CALL EXTDIS JMIN,JMAX=',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      CALL EXTDIS(ICOM,ICOM2,IHARG,IHARG2,NUMARG,JMIN,JMAX,
     1            ICASRA,IDIST,NUMSHA,IFOUND,ILOCNU,
     1            ISUBRO,IBUGA3,IERROR)
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'RAND')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,251)
  251   FORMAT('***** AFTER CALL EXTDIS--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,252)ICASRA,NUMSHA,IDIST
  252   FORMAT('ICASRA,NUMSHA,IDIST = ',A4,2X,I8,2X,A60)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      GOTO1190
C
 1190 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'RAND')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF CKRAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IFOUND,IERROR
 9012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)ICASRA,ILOCNU
 9013   FORMAT('ICASRA,ILOCNU = ',A4,I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE CKSTAT(IBUGA3,IFOUN8,ICASL8,ILOCV,ISTANR)
C
C     PURPOSE--CHECK TO SEE IF A TYPE 8 LET COMMAND HAS BEEN GIVEN--
C
C              CASE 1: SINGLE RESPONSE VARIABLE
C
C              LOCATION STATISTICS (ONE RESPONSE VARIABLE)
C                      MIDRANGE
C                      MEAN
C                      AVERAGE
C                      MIDMEAN
C                      MEDIAN
C                      TRIMMED MEAN
C                      WINSORIZED MEAN
C                      GEOMETRIC MEAN
C                      HARMONIC MEAN
C                      BIWEIGHT LOCATION
C                      HODGES LEHMAN LOCATION
C                      STANDARD DEVIATION OF THE MEAN
C                      STANDARD DEVIATION OF MEAN
C                      STANDARD DEVIATION MEAN
C                      VARIANCE OF THE MEAN
C                      VARIANCE OF MEAN
C                      VARIANCE MEAN
C                      TRIMMED MEAN STANDARD ERROR (OR SD)
C                      LP LOCATION
C                      VARIANCE OF LP LOCATION
C                      SD OF LP LOCATION
C
C              SCALE STATISTICS (ONE RESPONSE VARIABLE)
C                      STANDARD DEVIATION (& SD)
C                      WINSORIZED STANDARD DEVIATION (OR SD)
C                      TRIMMED SD
C                      GEOMETRIC STANDARD DEVIATION
C                      VARIANCE (& VAR)
C                      WINSORIZED VARIANCE
C                      AVERAGE ABSOLUTE DEVIATION
C                      MAD (MEDIAN ABSOLUTE DEVIATION)
C                      MADN (RESCALED MEDIAN ABSOLUTE DEVIATION)
C                      SN
C                      QN
C                      INTERQUARTILE RANGE
C                      BIWEIGHT SCALE
C                      BIWEIGHT MIDVARIANCE
C                      PERCENTAGE BEND MIDVARIANCE
C                      COEFFICIENT OF VARIATION
C                      RELATIVE STANDARD DEVIATION
C                      RELATIVE VARIANCE
C                      RANGE
C
C              PERCENTILE STATISTICS (ONE RESPONSE VARIABLE)
C                      QUANTILE
C                      QUANTILE STANDARD ERROR
C                      <VALUE> PERCENTILE
C                      FIRST/SECOND/THIRD/FOURTH/FIFTH/SIXTH/SEVENTH/
C                      EIGHTH/NINTH DECILE
C                      LOWER HINGE
C                      UPPER HINGE
C                      LOWER QUARTILE
C                      UPPER QUARTILE
C                      MINIMUM (MIN)
C                      MAXIMUM (MAX)
C                      EXTREME
C                      INDEX MINIMUM
C                      INDEX MAXIMUM
C                      INDEX EXTREME
C
C                HIGHER MOMENTS
C                      SKEWNESS
C                      KURTOSIS
C
C                LOCATION AND SCALE STATISTICS (TWO RESPONSE VARIABLES)
C                      WEIGHTED MEAN
C                      WEIGHTED MEDIAN
C                      WEIGHTED STANDARD DEVIATION
C                      WEIGHTED VARIANCE
C                      WEIGHTED TRIMMED MEAN
C
C                TIME SERIES STATISTICS:
C                      AUTOCORRELATION
C                      AUTOCOVARIANCE
C                      SIN FREQUENCY
C                      SIN AMPLITUDE
C
C                QUALITY CONTROL STATISTICS:
C                      CP
C                      CPL
C                      CPU
C                      CPK
C                      CPM
C                      CC
C                      CNPK
C                      (ACTUAL) PERCENT DEFECTIVE
C                      (THEORETICAL) PERCENT DEFECTIVE
C                      EXPECTED LOSS
C                      (TAGUCHI) SN- SN0 SN+ SN00
C
C                 STATISTICAL TESTS:
C                      BINOMIAL PROPORTION
C                      GRUBB
C                      GRUBB CDF
C                      GRUBB DIRECTION
C                      GRUBB INDEX
C                      TIETJEN-MOORE
C                      DIXON TEST
C                      ONE SAMPLE T-TEST
C                      ONE SAMPLE T-TEST CDF
C                      CHI-SQUARE SD
C                      CHI-SQUARE SD CDF
C                      FREQUENCY TEST
C                      FREQUENCY TEST CDF
C                      FREQUENCY WITHIN A BLOCK TEST
C                      FREQUENCY WITHIN A BLOCK TEST CDF
C
C                 DISTRIBUTIONS:
C                      NORMAL PPCC
C
C                 MISCELLANEOUS STATISTICS (ONE RESPONSE VARIABLE)
C                      NUMBER (SIZE, COUNT, SAMPLE SIZE)
C                      SUM
C                      PRODUCT
C                      INTEGRAL
C                      COMMON DIGITS
C                      NUMBER OF COMMON DIGITS
C
C              CASE 2: TWO RESPONSE VARIABLES
C
C                 WEIGHTED STATISTICS:
C                      WEIGHTED MEAN
C                      WEIGHTED STANDARD DEVIATION
C                      WEIGHTED VARIANCE
C                      WEIGHTED TRIMMED MEAN
C
C                 CO-RELATION
C                      COVARIANCE
C                      RANK COVARIANCE
C                      CORRELATION
C                      RANK CORRELATION
C                      KENDELL TAU
C                      COMOVEMENT (LEIGH-PEARLMAN)
C                      RANK COMOVEMENT
C                      WINSORIZED COVARIANCE
C                      WINSORIZED CORRELATION
C                      BIWEIGHT MIDCOVARIANCE
C                      BIWEIGHT MIDCORRELATION
C                      PERCENTAGE BEND CORRELATION
C
C                  REGRESSION/FITTING:
C                      LINEAR INTERCEPT
C                      LINEAR SLOPE
C                      LINEAR RESSD
C                      LINEAR CORRELATION
C                      REPEATABILITY STANDARD DEVIATION
C                      REPRODUCABILITY STANDARD DEVIATION
C
C                  CATEGORICAL DATA
C                      RATIO
C                      ODDS RATIO
C                      ODDS RATIO STANDARD ERROR
C                      LOG ODDS RATIO
C                      LOG ODDS RATIO STANDARD ERROR
C                      RELATIVE RISK
C                      CRAMER CONTINGENCY COEFFICIENT
C                      PEARSON CONTINGENCY COEFFICIENT
C                      FALSE POSITIVES
C                      FALSE NEGATIVES
C                      TRUE POSITIVES
C                      TRUE NEGATIVES
C                      TEST SENSITIVITY
C                      TEST SPECIFICITY
C                      POSITIVE PREDICTIVE VALUE
C                      NEGATIVE PREDICTIVE VALUE
C
C
C                  DIFFERENCE OF LOCATION:
C                      DIFFERENCE OF MEANS
C                      DIFFERENCE OF MIDMEANS
C                      DIFFERENCE OF MEDIANS
C                      DIFFERENCE OF TRIMMED MEANS
C                      DIFFERENCE OF WINSORIZED MEANS
C                      DIFFERENCE OF GEOMETRIC MEANS
C                      DIFFERENCE OF HARMONIC MEANS
C                      DIFFERENCE OF HODGES-LEHMAN
C                      DIFFERENCE OF BIWEIGHT LOCATION
C                      DIFFERENCE OF LP LOCATION
C
C                  DIFFERENCE OF SCALE:
C                      DIFFERENCE OF STANDARD DEVIATIONS
C                      DIFFERENCE OF VARIANCES
C                      DIFFERENCE OF AAD
C                      DIFFERENCE OF MAD
C                      DIFFERENCE OF MADN
C                      DIFFERENCE OF SN
C                      DIFFERENCE OF QN
C                      DIFFERENCE OF INTERQUARTILE RANGE
C                      DIFFERENCE OF WINSORIZED SD
C                      DIFFERENCE OF WINSORIZED VARIANCE
C                      DIFFERENCE OF BIWEIGHT MIDVARIANCE
C                      DIFFERENCE OF BIWEIGHT SCALE
C                      DIFFERENCE OF PERCENTAGE BEND
C                      DIFFERENCE OF GEOMETRIC SD
C                      DIFFERENCE OF RANGE
C                      DIFFERENCE OF MIDRANGE
C                      DIFFERENCE OF QUANTILE
C                      DIFFERENCE OF SKEWNESS
C                      DIFFERENCE OF KURTOSIS
C                      DIFFERENCE OF RELATIVE SD
C                      DIFFERENCE OF SD OF MEAN
C                      DIFFERENCE OF RELATIVE VARIANCE
C                      DIFFERENCE OF VARIANCE OF THE MEAN
C                      DIFFERENCE OF MINIMUM
C                      DIFFERENCE OF MAXIMUM
C                      DIFFERENCE OF EXTREMES
C                      DIFFERENCE OF VARIANCE OF LP LOCATION
C                      DIFFERENCE OF SD OF LP LOCATION
C
C                  MISCELLANEOUS:
C                      DIFFERENCE OF BINOMIAL PROBABILITY
C                      DIFFERENCE OF COUNTS
C                      DIFFERENCE OF SUMS
C
C     OUTPUT ARGUMENTS--IFOUN8 ('YES' OR 'NO')
C                     --ICASL8 ('NUMB', 'SUM', ETC.)
C                     --ILOCV (LOCATION IN THE ARGUMENT LIST IHARG(.)
C                             OF THE VARIABLE OR COLUMN
C                             TO BE OPERATED ON.
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MARCH     1979.
C     UPDATED         --APRIL     1979.
C     UPDATED         --JUNE      1979.
C     UPDATED         --JUNE      1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --SEPTEMBER 1987.  (DECILES)
C     UPDATED         --AUGUST    1988.  (WEIGHTED MEAN, MEDIAN, SD, VARIANCE)
C     UPDATED         --JANUARY   1989.  AVERAGE ABSOLUTE DEVIATION (ALAN)
C     UPDATED         --APRIL     1990.  EXTREME
C     UPDATED         --SEPTEMBER 1990.  CP, CPK, % DEF, EXP LOSS
C     UPDATED         --SEPTEMBER 1990.  SD FOR STAN. DEVIATION
C     UPDATED         --SEPTEMBER 1990.  WINDSORIZED TO WINSORIZED
C     UPDATED         --AUGUST    1991.  MOVE FORMS FOR CORR COEF
C     UPDATED         --AUGUST    1991.  COMOVEMENT
C     UPDATED         --MAY       1993.  CORRELATION => CORR
C     UPDATED         --FEBRUARY  1994.  CHANGE ICASL8: SDM => SDME
C     UPDATED         --FEBRUARY  1994.  CHANGE ICASL8: RSD => RESD
C     UPDATED         --FEBRUARY  1994.  EXTREME
C     UPDATED         --FEBRUARY  1994.  RENUMBER 3XX => 7XX STATEMENTS
C     UPDATED         --FEBRUARY  1994.  SYNONYM: ST. DEV. OF MEAN =>
C     UPDATED         --FEBRUARY  1994.  SYNONYM: ST. DEV. => SD
C     UPDATED         --FEBRUARY  1994.  SYNONYM: VARI => VAR
C     UPDATED         --FEBRUARY  1994.  RELATIVE VARIANCE
C     UPDATED         --FEBRUARY  1994.  VARIANCE OF THE MEAN
C     UPDATED         --FEBRUARY  1994.  NORMAL PPCC
C     UPDATED         --FEBRUARY  1994.  TAGUCHI SN- SN0 SN+ SN00
C     UPDATED         --NOVEMBER  1994.  DISTINGUISH RELATIVE SD AND
C                                        COEF OF VARIATION CASES
C     UPDATED         --MARCH     1995.  MEDIAN ABSOLUTE DEVIATION
C     UPDATED         --NOVEMBER  1998. <VALUE> PERCENTILE
C     UPDATED         --NOVEMBER  1998. CPM, CC
C     UPDATED         --MARCH     1999. CNPK
C     UPDATED         --MARCH     1999. GEOMETRIC MEAN
C     UPDATED         --MARCH     1999. GEOMETRIC STANDARD DEVIATION
C     UPDATED         --MARCH     1999. HARMONIC MEAN
C     UPDATED         --APRIL     2001. CPL AND CPU
C     UPDATED         --AUGUST    2001. COMMON DIGITS
C     UPDATED         --SEPTEMBER 2001. INTERQUARTILE RANGE
C     UPDATED         --NOVEMBER  2001. BIWEIGHT LOCATION
C     UPDATED         --NOVEMBER  2001. BIWEIGHT SCALE
C     UPDATED         --JULY      2002. WINSORIZED VARIANCE
C     UPDATED         --JULY      2002. WINSORIZED STANDARD DEVIATION
C     UPDATED         --JULY      2002. WINSORIZED COVARIANCE
C     UPDATED         --JULY      2002. WINSORIZED CORRELATION
C     UPDATED         --JULY      2002. HODGES LEHMAN
C     UPDATED         --JULY      2002. PERCENTAGE BEND MIDVARIANCE
C     UPDATED         --JULY      2002. BIWEIGHT MIDVARIANCE
C     UPDATED         --JULY      2002. BIWEIGHT MIDCOVARIANCE
C     UPDATED         --JULY      2002. BIWEIGHT MIDCORRELATION
C     UPDATED         --MARCH     2003. 35 "DIFFERENCE OF" STATISTICS
C     UPDATED         --APRIL     2003. SN AND QN (AND DIFFERENCE OF)
C     UPDATED         --MAY       2003. WEIGHTED TRIMMED MEAN
C     UPDATED         --OCTOBER   2004. KENDELL'S TAU
C     UPDATED         --SEPTEMBER 2005. RATIO
C     UPDATED         --MARCH     2007. RELATIVE RISK
C     UPDATED         --MARCH     2007. CRAMER CONTINGENCY COEFFICIENT
C     UPDATED         --MARCH     2007. PEARSON CONTINGENCY COEFFICIENT
C     UPDATED         --MARCH     2007. FALSE POSITIVE
C     UPDATED         --MARCH     2007. FALSE NEGATIVE
C     UPDATED         --MARCH     2007. TRUE POSITIVE
C     UPDATED         --MARCH     2007. TRUE NEGATIVE
C     UPDATED         --MARCH     2007. TEST SENSITIVITY
C     UPDATED         --MARCH     2007. TEST SPECIFICITY
C     UPDATED         --APRIL     2007. ODDS RATIO
C     UPDATED         --APRIL     2007. ODDS RATIO STANDARD ERROR
C     UPDATED         --APRIL     2007. LOG ODDS RATIO
C     UPDATED         --APRIL     2007. LOG ODDS RATIO STANDARD ERROR
C     UPDATED         --NOVEMBER  2007. LP LOCATION
C     UPDATED         --NOVEMBER  2007. VARIANCE OF LP LOCATION
C     UPDATED         --SEPTEMBER 2008. BINOMIAL PROBABILITY
C     UPDATED         --SEPTEMBER 2008. DIFFERENCE OF BINOMIAL
C                                       PROBABILITY
C     UPDATED         --FEBRUARY  2009. INDEX MINIMUM
C     UPDATED         --FEBRUARY  2009. INDEX MAXIMUM
C     UPDATED         --FEBRUARY  2009. INDEX EXTREME
C     UPDATED         --FEBRUARY  2009. GRUBB
C                                       GRUBB CDF
C                                       GRUBB DIRECTION
C                                       GRUBB INDEX
C     UPDATED         --FEBRUARY  2009. ONE SAMPLE T TEST
C                                       ONE SAMPLE T TEST CDF
C     UPDATED         --FEBRUARY  2009. CHI-SQUARE SD TEST
C                                       CHI-SQUARE SD TEST CDF
C     UPDATED         --FEBRUARY  2009. FREQUENCY TEST
C                                       FREQUENCY TEST CDF
C     UPDATED         --FEBRUARY  2009. FREQUENCY WITHIN A BLOCK TEST
C                                       FREQUENCY WITHIN A BLOCK TEST CDF
C     UPDATED         --MARCH     2009. FUNNEL PARSING THROUGH
C                                       EXTSTA ROUTINE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IFOUN8
      CHARACTER*4 ICASL8
      CHARACTER*4 IERROR
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*60 ISTANM
      CHARACTER*4  ISTADF
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHO.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      ISUBRO='    '
      ISUBN1='CKST'
      ISUBN2='AT  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
C
      IERROR='NO'
C
C               ***********************************
C               **  CHECK FOR A TYPE 8 LET CASE  **
C               ***********************************
C
      IFOUN8='NO'
      ICASL8='UNKN'
      ILOCV=-1
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF CKSTAT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMARG
   53 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE IF OF THIS TYPE  **
C               **  AND BRANCH ACCORDINGLY.    **
C               *********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.3)GOTO9000
C
      JMIN=3
      JMAX=MIN(NUMARG,JMIN+6)
      CALL EXTSTA(ICOM,ICOM2,IHARG,IHARG2,IARGT,ARG,NUMARG,JMIN,JMAX,
     1            ICASL8,ISTANM,ISTANR,ISTADF,IFOUN8,ILOCV,
     1            ISUBRO,IBUGA3,IERROR)
C
      IF(IFOUN8.EQ.'NO')GOTO9000
C
C               *****************************************************
C               **  STEP 3--                                       **
C               **  DETERMINE IF THE WORD (OR COLUMN DESIGNATION)  **
C               **  AFTER THE KEY WORD (SORT, RANK, ETC.) IS A     **
C               **  VALID DATA VARIABLE OR COLUMN.                 **
C               *****************************************************
C
      IF(ILOCV.GT.NUMARG)GOTO739
      IH=IHARG(ILOCV)
      IH2=IHARG2(ILOCV)
      DO730I=1,NUMNAM
      IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO740
      IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'M')GOTO740
      IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO740
  730 CONTINUE
  739 CONTINUE
      IFOUN8='NO'
      ICASL8='UNKN'
      GOTO9000
  740 CONTINUE
      IFOUN8='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF CKSTAT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IFOUN8,ICASL8,ILOCV,NUMARG
 9014 FORMAT('IFOUN8,ICASL8,ILOCV,NUMARG = ',A4,2X,A4,2I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE CKTMPA(PROP1,PROP2,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--CHECK THE PARAMETERS NEEDED
C              FOR THE TRIMMED MEAN STATISTIC

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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/6
C     ORIGINAL VERSION--MAY       1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
CCCCC CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
CCCCC CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='CKTM'
      ISUBN2='PA  '
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'TMPA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF CKTMPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR
   52 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C     --------------------------
C
      IHP='P1  '
      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')GOTO1110
      PROP1=VALUE(ILOCP)
      GOTO1119
C
 1110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN CKCPPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      IN COMPUTING THE TRIMMED MEAN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      AND THE WINSORIZED MEAN STATISTICS,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
 1114 FORMAT('      THE VALUE OF THE PROPORTION (%)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)
 1115 FORMAT('      TO BE TRIMMED/WINSORIZED BELOW')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1116)
 1116 FORMAT('      MUST BE PRE-DEFINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1117)
 1117 FORMAT('      USE THE LET COMMAND TO PRE-DEFINE P1,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1118)
 1118 FORMAT('      AS IN         LET P1 = 25')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO1149
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN CKCPPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      IN COMPUTING THE TRIMMED MEAN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)
 1133 FORMAT('      AND THE WINSORIZED MEAN STATISTICS,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1134)
 1134 FORMAT('      THE VALUE OF THE PROPORTION (%)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('      TO BE TRIMMED/WINSORIZED BELOW')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      MUST BE BETWEEN 0 AND 100.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1138)
 1138 FORMAT('      THE CURRENT VALUE OF THE PARAMETER P1 = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1139)
 1139 FORMAT('      USE THE LET COMMAND TO RE-DEFINE P1,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1140)
 1140 FORMAT('      AS IN         LET P1 = 25')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1149 CONTINUE
C
C     --------------------------
C
      IHP='P2  '
      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')GOTO2110
      PROP2=VALUE(ILOCP)
      GOTO2119
C
 2110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2111)
 2111 FORMAT('***** ERROR IN CKCPPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2112)
 2112 FORMAT('      IN COMPUTING THE TRIMMED MEAN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2113)
 2113 FORMAT('      AND THE WINSORIZED MEAN STATISTICS,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2114)
 2114 FORMAT('      THE VALUE OF THE PROPORTION (%)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2115)
 2115 FORMAT('      TO BE TRIMMED/WINSORIZED ABOVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2116)
 2116 FORMAT('      MUST BE PRE-DEFINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2117)
 2117 FORMAT('      USE THE LET COMMAND TO PRE-DEFINE P2,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2118)
 2118 FORMAT('      AS IN         LET P2 = 25')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2119 CONTINUE
C
      IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO2149
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2131)
 2131 FORMAT('***** ERROR IN CKCPPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2132)
 2132 FORMAT('      IN COMPUTING THE TRIMMED MEAN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2133)
 2133 FORMAT('      AND THE WINSORIZED MEAN STATISTICS,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2134)
 2134 FORMAT('      THE VALUE OF THE PROPORTION (%)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2135)
 2135 FORMAT('      TO BE TRIMMED/WINSORIZED ABOVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2136)
 2136 FORMAT('      MUST BE BETWEEN 0 AND 100.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2137)
 2137 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2138)
 2138 FORMAT('      THE CURRENT VALUE OF THE PARAMETER P2 = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2139)
 2139 FORMAT('      USE THE LET COMMAND TO RE-DEFINE P2,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2140)
 2140 FORMAT('      AS IN         LET P2 = 25')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2149 CONTINUE
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'TMPA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF CKTMPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG3,ISUBRO,IERROR
 9012 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)PROP1,PROP2
 9013 FORMAT('PROP1,PROP2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      DOUBLE PRECISION FUNCTION CLAUSN(XVALUE)
C
C DESCRIPTION:
C
C   This program calculates Clausen's integral defined by
C
C          CLAUSN(x) = integral 0 to x of (-ln(2*sin(t/2))) dt
C
C   The code uses Chebyshev expansions with the coefficients
C   given to 20 decimal places.
C
C
C ERROR RETURNS:
C
C   If |x| is too large it is impossible to reduce the argument
C   to the range [0,2*pi] with any precision. An error message
C   is printed and the program returns the value 0.0
C
C
C MACHINE-DEPENDENT CONSTANTS:
C
C   NTERMS - INTEGER - the no. of terms of the array ACLAUS
C                      to be used. The recommended value is
C                      such that ABS(ACLAUS(NTERMS)) < EPS/100
C                      subject to 1 <= NTERMS <= 15
C
C   XSMALL - DOUBLE PRECISION - the value below which Cl(x) can be
C                   approximated by x (1-ln x). The recommended
C                   value is pi*sqrt(EPSNEG/2).
C
C   XHIGH - DOUBLE PRECISION - The value of |x| above which we cannot
C                  reliably reduce the argument to [0,2*pi].
C                  The recommended value is   1/EPS.
C
C     For values of EPS and EPSNEG refer to the file MACHCON.TXT
C
C     The machine-dependent constants are computed internally by
C     using the D1MACH subroutine.
C
C
C INTRINSIC FUNCTIONS USED:
C
C   AINT , LOG , SQRT
C
C
C   OTHER MISCFUN SUBROUTINES USED:
C
C          CHEVAL , ERRPRN, D1MACH
C
C
C AUTHOR:  Dr. Allan J. MacLeod,
C          Dept. of Mathematics and Statistics,
C          University of Paisley,
C          High St.
C          PAISLEY
C          SCOTLAND
C
C          ( e-mail: macl_ms0@paisley.ac.uk )
C
C
C LATEST MODIFICATION: 23 January, 1996
C
      INTEGER INDX,NTERMS
      DOUBLE PRECISION ACLAUS(0:15),CHEVAL,HALF,ONE,ONEHUN,PI,PISQ,T,
     &     TWOPI,TWOPIA,TWOPIB,X,XHIGH,XSMALL,XVALUE,ZERO
CCCCC CHARACTER FNNAME*6,ERRMSG*26
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOP2.INC'
C
CCCCC DATA FNNAME/'CLAUSN'/
CCCCC DATA ERRMSG/'ARGUMENT TOO LARGE IN SIZE'/
      DATA ZERO,HALF,ONE/0.0 D 0 , 0.5 D 0 , 1.0 D 0/
      DATA ONEHUN/100.0 D 0/
      DATA PI/3.14159 26535 89793 2385 D 0/
      DATA PISQ/9.86960 44010 89358 6188 D 0/
      DATA TWOPI/6.28318 53071 79586 4769 D 0/
      DATA TWOPIA,TWOPIB/6.28125 D 0 , 0.19353 07179 58647 69253 D -2/
      DATA ACLAUS/2.14269 43637 66688 44709  D    0,
     1            0.72332 42812 21257 9245   D   -1,
     2            0.10164 24750 21151 164    D   -2,
     3            0.32452 50328 53164 5      D   -4,
     4            0.13331 51875 71472        D   -5,
     5            0.62132 40591 653          D   -7,
     6            0.31300 41353 37           D   -8,
     7            0.16635 72305 6            D   -9,
     8            0.91965 9293               D  -11,
     9            0.52400 462                D  -12,
     X            0.30580 40                 D  -13,
     1            0.18196 9                  D  -14,
     2            0.11004                    D  -15,
     3            0.675                      D  -17,
     4            0.42                       D  -18,
     5            0.3                        D  -19/
C
C  Start execution
C
      X = XVALUE
C
C   Compute the machine-dependent constants.
C
      T = D1MACH(3)
      XHIGH = ONE / T
C
C   Error test
C
      IF ( ABS(X) .GT. XHIGH ) THEN
CCCCC    CALL ERRPRN(FNNAME,ERRMSG)
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,101)
         CALL DPWRST('XXX','BUG ')
         CLAUSN = ZERO
         RETURN
      ENDIF
  999 FORMAT(1X)
  101 FORMAT('***** ERROR FROM CLAUSN--ARGUMENT TOO LARGE.  ',
     1       'ARGUMENT = ',G15.7)
C
C   Continue with machine-dependent constants
C
      XSMALL = PI * SQRT ( HALF * T )
      T = T / ONEHUN
      DO 10 NTERMS = 15 , 0 , -1
         IF ( ABS(ACLAUS(NTERMS)) .GT. T ) GOTO 19
 10   CONTINUE
C
C  Continue with computation
C
 19   INDX = 1
      IF ( X .LT. ZERO ) THEN
         X = -X
         INDX = -1
      ENDIF
C
C  Argument reduced using simulated extra precision
C
      IF ( X .GT. TWOPI ) THEN
         T = AINT( X / TWOPI )
         X =  ( X - T * TWOPIA ) - T * TWOPIB
      ENDIF
      IF ( X .GT. PI ) THEN
         X = ( TWOPIA - X ) + TWOPIB
         INDX = -INDX
      ENDIF
C
C  Set result to zero if X multiple of PI
C
      IF ( X .EQ. ZERO ) THEN
         CLAUSN = ZERO
         RETURN
      ENDIF
C
C  Code for X < XSMALL
C
      IF ( X .LT. XSMALL ) THEN
         CLAUSN = X * ( ONE - LOG( X ) )
      ELSE
C
C  Code for XSMALL < =  X < =  PI
C
         T =  ( X * X ) / PISQ - HALF
         T = T + T
         IF ( T .GT. ONE ) T = ONE
         CLAUSN = X * CHEVAL( NTERMS,ACLAUS,T ) - X * LOG( X )
      ENDIF
      IF ( INDX .LT. 0 ) CLAUSN = -CLAUSN
      RETURN
      END
      COMPLEX FUNCTION CLBETA(A,B)
C***BEGIN PROLOGUE  CLBETA
C***DATE WRITTEN   770701   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  C7B
C***KEYWORDS  BETA FUNCTION,COMPLETE BETA FUNCTION,COMPLEX,LOGARITHM,
C             SPECIAL FUNCTION
C***AUTHOR  FULLERTON, W., (LANL)
C***PURPOSE  CLBETA computes the natural log of the complex valued
C            complete Beta function of complex parameters A and B.
C***DESCRIPTION
C
C CLBETA computes the natural log of the complex valued complete beta
C function of complex parameters A and B.  This is a preliminary version
C which is not accurate.
C
C Input Parameters:
C       A   complex and the real part of A positive
C       B   complex and the real part of B positive
C***REFERENCES  (NONE)
C***ROUTINES CALLED  CLNGAM,XERROR
C***END PROLOGUE  CLBETA
      COMPLEX A, B, CLNGAM
C
      INCLUDE 'DPCOP2.INC'
C
C***FIRST EXECUTABLE STATEMENT  CLBETA
      IF (REAL(A).LE.0.0 .OR. REAL(B).LE.0.0) THEN
CCCCC   CALL XERROR ( 'CLBETA  REA
CCCCC1L PART OF BOTH ARGUMENTS MUST BE GT 0', 48, 1, 2)
        WRITE(ICOUT,11)
        CALL DPWRST('XXX','BUG ')
      ENDIF
   11 FORMAT('***** ERROR FROM CLBETA: REAL PARTS OF PARAMETER',
     1       'MUST BE POSITIVE')
C
      CLBETA = CLNGAM(A) + CLNGAM(B) - CLNGAM(A+B)
C
      RETURN
      END
      COMPLEX FUNCTION CLNGAM(ZIN)
C***BEGIN PROLOGUE  CLNGAM
C***DATE WRITTEN   780401   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  C7A
C***KEYWORDS  ABSOLUTE VALUE,COMPLETE GAMMA FUNCTION,COMPLEX,
C             GAMMA FUNCTION,LOGARITHM,SPECIAL FUNCTION
C***AUTHOR  FULLERTON, W., (LANL)
C***PURPOSE  CLNGAM computes the natural log of the complex valued Gamma
C            function at ZIN, where ZIN is a complex number.
C***DESCRIPTION
C
C CLNGAM computes the natural log of the complex valued gamma function
C at ZIN, where ZIN is a complex number.  This is a preliminary version,
C which is not accurate.
C***REFERENCES  (NONE)
C***ROUTINES CALLED  C9LGMC,CARG,CLNREL,R1MACH,XERROR
C***END PROLOGUE  CLNGAM
      COMPLEX ZIN, Z, CORR, CEXP, CLOG, CLNREL, C9LGMC
C
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOP2.INC'
C
      EXTERNAL CARG
      DATA PI / 3.1415926535 8979324E0 /
      DATA SQ2PIL / 0.9189385332 0467274E0 /
      DATA BOUND, DXREL / 2*0.0 /
C***FIRST EXECUTABLE STATEMENT  CLNGAM
      IF (BOUND.NE.0.) GO TO 10
      N = INT(-0.30*LOG(R1MACH(3)))
C BOUND = N*(0.1*EPS)**(-1/(2*N-1))/(PI*EXP(1))
      BOUND = 0.1171*FLOAT(N)*(0.1*R1MACH(3))**(-1./(2.*FLOAT(N)-1.))
      DXREL = SQRT (R1MACH(4))
C
 10   Z = ZIN
      X = REAL(ZIN)
      Y = AIMAG(ZIN)
C
      CORR = (0.0, 0.0)
      CABSZ = CABS(Z)
      IF (X.GE.0.0 .AND. CABSZ.GT.BOUND) GO TO 50
      IF (X.LT.0.0 .AND. ABS(Y).GT.BOUND) GO TO 50
C
      IF (CABSZ.LT.BOUND) GO TO 20
C
C USE THE REFLECTION FORMULA FOR REAL(Z) NEGATIVE, CABS(Z) LARGE, AND
C ABS(AIMAG(Y)) SMALL.
C
      IF (Y.GT.0.0) Z = CONJG (Z)
      CORR = CEXP (-CMPLX(0.0,2.0*PI)*Z)
      IF (REAL(CORR).EQ.1.0 .AND. AIMAG(CORR).EQ.0.0) THEN
CCCCC   CALL XERROR ( 'CLN
CCCCC1GAM  Z IS A NEGATIVE INTEGER', 31, 3, 2)
        WRITE(ICOUT,11)
        CALL DPWRST('XXX','BUG ')
      ENDIF
   11 FORMAT('***** ERROR FROM CLNGAM: ARGUMENT IS A NEGATIVE ',
     1       'INTEGER')
C
      CLNGAM = SQ2PIL + 1.0 - CMPLX(0.0,PI)*(Z-0.5) - CLNREL(-CORR)
     1  + (Z-0.5)*CLOG(1.0-Z) - Z - C9LGMC(1.0-Z)
      IF (Y.GT.0.0) CLNGAM = CONJG (CLNGAM)
      RETURN
C
C USE THE RECURSION RELATION FOR CABS(Z) SMALL.
C
 20   IF (X.GE.(-0.5) .OR. ABS(Y).GT.DXREL) GO TO 30
      IF (CABS((Z-AINT(X-0.5))/X).LT.DXREL) THEN
CCCCC   CALL XERROR ( 'CLNGAM  ANSWE
CCCCC1R LT HALF PRECISION BECAUSE Z TOO NEAR NEGATIVE INTEGER', 68,1,1)
        WRITE(ICOUT,21)
        CALL DPWRST('XXX','BUG ')
      ENDIF
   21 FORMAT('***** ERROR FROM CLNGAM: ARGUMENT IS TOO NEAR A ',
     1'NEGATIVE INTEGER')
C
   30 CONTINUE
      N = INT(SQRT (BOUND**2 - Y**2) - X + 1.0)
      ARGSUM = 0.0
      CORR = (1.0, 0.0)
      DO 40 I=1,N
        ARGSUM = ARGSUM + CARG(Z)
        CORR = Z*CORR
        Z = 1.0 + Z
 40   CONTINUE
C
      IF (REAL(CORR).EQ.0.0 .AND. AIMAG(CORR).EQ.0.0) THEN
CCCCC   CALL XERROR ( 'CLN
CCCCC1GAM  Z IS A NEGATIVE INTEGER', 31, 3, 2)
        WRITE(ICOUT,31)
        CALL DPWRST('XXX','BUG ')
      ENDIF
   31 FORMAT('***** ERROR FROM CLNGAM: ARGUMENT IS A NEGATIVE ',
     1       'INTEGER')
C
      CORR = -CMPLX (LOG(CABS(CORR)), ARGSUM)
C
C USE STIRLING-S APPROXIMATION FOR LARGE Z.
C
 50   CLNGAM = SQ2PIL + (Z-0.5)*CLOG(Z) - Z + CORR + C9LGMC(Z)
      RETURN
C
      END
      COMPLEX FUNCTION CLNREL(Z)
C***BEGIN PROLOGUE  CLNREL
C***DATE WRITTEN   770401   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  C4B
C***KEYWORDS  COMPLEX,ELEMENTARY FUNCTION,LOGARITHM,RELATIVE ERROR
C***AUTHOR  FULLERTON, W., (LANL)
C***PURPOSE  Computes the principal value of the complex natural
C            logarithm of 1+Z with relative error accuracy for small
C            CABS(Z).
C***DESCRIPTION
C
C CLNREL(Z) = CLOG(1+Z) with relative error accuracy near Z = 0.
C Let   RHO = CABS(Z)  and
C       R**2 = CABS(1+Z)**2 = (1+X)**2 + Y**2 = 1 + 2*X + RHO**2 .
C Now if RHO is small we may evaluate CLNREL(Z) accurately by
C       CLOG(1+Z) = CMPLX  (LOG(R), CARG(1+Z))
C                 = CMPLX  (0.5*LOG(R**2), CARG(1+Z))
C                 = CMPLX  (0.5*ALNREL(2*X+RHO**2), CARG(1+Z))
C***REFERENCES  (NONE)
C***ROUTINES CALLED  ALNREL,CARG,R1MACH,XERROR
C***END PROLOGUE  CLNREL
      COMPLEX Z, CLOG
C
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOP2.INC'
C
      EXTERNAL CARG
      DATA SQEPS /0.0/
C
      CLNREL = CMPLX (0.0, 0.0)
C
C***FIRST EXECUTABLE STATEMENT  CLNREL
      IF (SQEPS.EQ.0.) SQEPS = SQRT (R1MACH(4))
C
      IF (CABS(1.+Z).LT.SQEPS) THEN
CCCCC   CALL XERROR ( 'CLNREL  ANSWER LT HALF PRE
CCCCC1CISION BECAUSE Z TOO NEAR -1', 54,    1, 1)
        WRITE(ICOUT,102)
        CALL DPWRST('XXX','BUG ')
      ENDIF
 102  FORMAT('***** INTERNAL WARNING FROM CLNREL: ANSWER IS LESS THAN'
     1,' HALF PRECISION BECAUSE ARGUMENT TOO NEAR -1')
C
      RHO = CABS(Z)
      IF (RHO.GT.0.375) CLNREL = CLOG (1.0+Z)
      IF (RHO.GT.0.375) RETURN
C
      X = REAL(Z)
      CLNREL = CMPLX (0.5*ALNREL(2.*X+RHO**2), CARG(1.0+Z))
C
      RETURN
      END
      SUBROUTINE CMESUB(X,N,THRESH,SLOPE,R1,X2,R,NX,INDR,SDC)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C  SUBROUTINE TO COMPUTE CME             C
C  (=MRL) FUNCTION :                     C
C  MAIN FORMULA:                         C
C    E[X-u | X > u] = (A + cu)/(1 - c)   C
C  INPUT ARGUMENTS:                      C
C    X  - ARRAY OF DATA (ALREADY         C
C         SORTED)                        C
C    N  - NUMBER OF POINTS IN X TO       C
C         USE                            C
C  OUTPUT ARGUMENTS:                     C
C    SLOPE  - = c/(1-c)                  C
C             (OR c = SLOPE/(1+SLOPE)    C
C    R1     - R(1) (= INTERCEPT)         C
C  NOTE THAT THE CALLING ROUTINE IS      C
C  REALLY INTERESTED IN A AND C.         C
C    C = SLOPE/(1+SLOPE)                 C
C    A = R(1)*(1 - C)                    C
C  THE CALCULATIONS FOR A AND C ARE DONE C
C  IN THE CALLING ROUTINE FROM THE       C
C  RETURNED VALUES OF SLOPE AND R(1)     C
C                                        C
C  NOTE THAT A AND C ARE THE SCALE AND   C
C  SHAPE PARAMETERS FOR THE GENERALIZED  C
C  PARETO DISTRIBUTION.                  C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C  MAY 2005: ADD COMPUTATION OF SD(CHAT)
C
C  SD(CHAT) = SQRT(TERM1)*SQRT(TERM2)/(TERM3*TERM4*SQRT(TERM5 - TERM6))
C
C  WHERE
C
C  TERM1 = SUM[i=1 to n-1][n-i]
C  TERM2 = SUM[i=1 to n-1][(n-i)*(y(i) - intercept - x(i)*slope))**2]
C  TERM3 = SQRT(N-3)
C  TERM4 = (1 + SLOPE)**2
C  TERM5 = SUM[i=1 to n-1][n-i]*SUM[i=1 to n-1][(n-i)**x(i)**2]
C  TERM6 = {SUM[i=1 to n-1][(n-i)*x(i)]}**2
C
C  x(i) = INPUT WIND SPEEDS
C  y(i) = R(i)
C
C  REFERENCE: GROSS, HECKERT, LECHNER, AND SIMIU (1995).  "EXTREME
C             WIND ESTIMATES BY THE CONDITIONAL MEAN EXCEEDANCE
C             PROCEDURE", NISTIT 5531.
C
C  OCTOBER 2010: IF X(N-1) = X(N), GET "NAN" IN COMPUTATION.  NEED
C                TO FIND INDEX FOR THE MAXIMUM VALUE OF X(I) THAT IS
C                LESS THAN THE MAXIMUM.
C
      REAL X(*)
      REAL X2(*)
      REAL R(*)
      REAL NX(*)
      INTEGER INDR(*)
C
      INTEGER NM1
      REAL SMALLX,RSUM,NSUM,SLOPE
C
      DOUBLE PRECISION SUMRX
      DOUBLE PRECISION SUMXSQ
      DOUBLE PRECISION SUMI
      DOUBLE PRECISION SUMX
      DOUBLE PRECISION SUMR
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DTERM2
      DOUBLE PRECISION DTERM3
      DOUBLE PRECISION DTERM4
      DOUBLE PRECISION DTERM5
      DOUBLE PRECISION DTERM6
      DOUBLE PRECISION DSD
      DOUBLE PRECISION DR1
      DOUBLE PRECISION DSLOPE
      DOUBLE PRECISION DX
      DOUBLE PRECISION DY
C
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCOP2.INC'
C
      IF(ISUBG4.EQ.'ESUB')THEN
        WRITE(ICOUT,12)
   12   FORMAT('FROM THE BEGINNING OF CMESUB')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,13)N,THRESH
   13   FORMAT('N,THRESH = ',I8,G15.7)
        CALL DPWRST('XXX','BUG ')
        DO15I=1,N
          WRITE(ICOUT,14)I,X(I)
   14     FORMAT('I,X(I) = ',I8,G15.7)
          CALL DPWRST('XXX','BUG ')
   15   CONTINUE
      ENDIF
C
      DTERM1=0.0D0
      DTERM2=0.0D0
      DTERM3=0.0D0
      DTERM4=0.0D0
      DTERM5=0.0D0
C
      DO 1 I=N,1,-1
        IF(X(I).NE.X(N))THEN
          NLAST=I
          GOTO9
        ENDIF
1     CONTINUE
      SLOPE=CPUMIN
      R1=CPUMIN
      SDC=CPUMIN
      GOTO9000
C
9     CONTINUE
C
      NM1=NLAST
C
      DO 10 I=1,N
        INDR(I)=1
10    CONTINUE
C
      DO 11 I=1,NM1
        R(I)=0.
        NX(I)=1.
11    CONTINUE
CC
      DO 50 K=1,NM1
C
        SMALLX=X(K)
C
        NSUM=0.
C
        DO 21 I=K,N
          IF(X(I).GT.SMALLX) NSUM=NSUM+1.
21      CONTINUE
C
        NX(K)=NSUM
C
        DO 22 I=1,N
          X2(I)=X(I)-SMALLX
22      CONTINUE
C
        RSUM=0.
        DO 23 I=K,N
          IF(X(I).GT.SMALLX) RSUM=RSUM+X2(I)
23      CONTINUE
C
        R(K)=RSUM
CC
50    CONTINUE
CC
      DO 60 I=1,NM1
        R(I)=R(I)/NX(I)
60    CONTINUE
CC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C  CME HAVING BEEN COMPUTED C
C  AT THIS POINT, IT REMAINS
C  TO COMPUTE THE TERMINAL  C
C  SLOPE.                   C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CC
CCCCCCCCCCCCCCCCCC
C  DOT PRODUCT   C
C  NUMERATOR &   C
C  SSQ(X) DEN-   C
C  OMINATOR.     C
CCCCCCCCCCCCCCCCCC
C
      SUMI=0.0D0
      SUMX=0.0D0
      SUMR=0.0D0
      SUMRX=0.0D0
      SUMXSQ=0.0D0
C
      DO 100 I=1,NM1
C
        SUMRX=SUMRX+DBLE(R(I))*DBLE(X(I))
        SUMXSQ=SUMXSQ+DBLE(X(I))*DBLE(X(I))
        SUMI = SUMI + 1.0D0
        SUMX = SUMX + DBLE(X(I))
        SUMR = SUMR + DBLE(R(I))
C
100   CONTINUE
C
      DSLOPE=(SUMRX - SUMR*SUMX/SUMI)/(SUMXSQ-SUMX**2/SUMI)
      SLOPE=REAL(DSLOPE)
      R1=R(1)
C
CCCCC MAY 2005.  NOW COMPUTE THE STANDARD DEVIAITION
C
      DR1=DBLE(R(1))
      DSLOPE=DBLE(SLOPE)
C
      DTERM1=0.0D0
      DTERM2=0.0D0
      DTERM3=DSQRT(DBLE(N-3))
      DTERM4=(1.0D0 + DSLOPE)**2
      DTERM6=0.0D0
C
      DO 900 I=1,NM1
C
         DY=DBLE(R(I))
         DX=DBLE(X(I))
C
         DTERM1=DTERM1 + DBLE(N-I)
         DTERM2=DTERM2 + DBLE(N-I)*(DY - DR1 - DSLOPE*DY)**2
         DTERM6=DTERM6 + DBLE(N-I)*DX
         DTERM5=DTERM5 + DBLE(N-I)*DX**2
C
  900 CONTINUE
      DTERM5=DTERM1*DTERM5
      DTERM6=DTERM6*DTERM6
C
      DSD=DSQRT(DTERM1)*DSQRT(DTERM2)/
     1    (DTERM3*DTERM4*DSQRT(DTERM5 - DTERM6))
      SDC=REAL(DSD)
C
CCCCCCCCCCCCCCCCCCCCCCCC
C  RETURN CONTROL TO   C
C  DRIVER ROUTINE      C
CCCCCCCCCCCCCCCCCCCCCCCC
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE CMPDIS(Y,CENSOR,XLEVEL,N,MAXNXT,ICASPL,ICASP2,
     1                  TEMP1,TEMP2,TEMP3,
     1                  DTEMP,DTMP12,DTMP13,ITEMP1,
     1                  ZTEMP1,ZTEMP2,ZTEMP3,ZTEMP4,ZTEMP5,ZTEMP6,
     1                  ZTEMP7,ZTEMP8,ZTEMP9,ZTMP10,ZTMP11,
     1                  YLOWLM,YUPPLM,A,B,MINMAX,NUMSHA,
     1                  SHAP11,SHAP12,SHAP21,SHAP22,
     1                  IADEDF,IGEPDF,IMAKDF,IBEIDF,
     1                  ILGADF,ISKNDF,IGLDDF,IBGEDF,IGETDF,ICONDF,
     1                  IGOMDF,IKATDF,IGIGDF,IGEODF,IGAUDF,
     1                  IEXPBC,IWEIBC,ICENTY,IDFTTY,
     1                  MAXOBV,ICENSO,KSLOC,KSSCAL,IFORSW,ISEED,
     1                  IPPLDP,IMETHD,IPPCBW,IPPCCC,IPPCFO,
     1                  IPPCDP,IPPCAP,IPPCAO,PCHSLM,ILEVEL,
     1                  CLLIMI,CLWIDT,IHSTCW,IHSTOU,IRELAT,IRHSTG,
     1                  SH1,SH2,SH3,SH4,SH5,SH6,SH7,ALOC,ASCALE,STATVA,
     1                  IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--ESTIMATE THE PARAMETERS OF A DISTRIBUTIONS USING ONE
C              OF THE FOLLOWING METHODS:
C
C              1) MAXIMUM LIKELIHOOD
C              2) PPCC/PROBAILITY PLOT
C              3) KOLMOGOROV-SMIRNOV GOODNESS OF FIT
C              4) ANDERSON-DARLING GOODNESS OF FIT
C
C              THIS IS FOR THE RAW DATA CASE AND IS PRIMARILY
C              USED TO OBTAIN THE POINT ESTIMATES.  FOR EXAMPLE,
C              IT IS USED BY THE DISTRIBUTIONAL BOOTSTRAP (DPJBS7)
C              AND THE GOODNESS OF FIT SIMULATIONS (DPGOF2).
C
C     WRITTEN BY--ALAN HECKERT
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2010/3
C     ORIGINAL VERSION--MARCH     2010.
C     UPDATED         --JULY      2019. CALL LIST TO DPPP2
C     UPDATED         --JULY      2019. CALL LIST TO DPPPC2
C     UPDATED         --JULY      2019. REMOVE ZTMP12, ZTMP13,ZTMP14
C                                       FROM CALL LIST
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICASP2
      CHARACTER*4 IFORSW
      CHARACTER*4 IHSTCW
      CHARACTER*4 IHSTOU
      CHARACTER*4 IRELAT
      CHARACTER*4 IRHSTG
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 ICENSO
      CHARACTER*4 IADEDF
      CHARACTER*4 IGEPDF
      CHARACTER*4 IMAKDF
      CHARACTER*4 IBEIDF
      CHARACTER*4 ILGADF
      CHARACTER*4 ISKNDF
      CHARACTER*4 IGLDDF
      CHARACTER*4 IBGEDF
      CHARACTER*4 IGETDF
      CHARACTER*4 ICONDF
      CHARACTER*4 IGOMDF
      CHARACTER*4 IKATDF
      CHARACTER*4 IGIGDF
      CHARACTER*4 IGEODF
      CHARACTER*4 IGAUDF
      CHARACTER*4 IEXPBC
      CHARACTER*4 ICENTY
      CHARACTER*4 IDFTTY
      CHARACTER*4 IWEIBC
      CHARACTER*4 IPPCCC
      CHARACTER*4 IPPCFO
      CHARACTER*4 IPPCAO
      CHARACTER*4 IPPCBW
      CHARACTER*4 IMETHD
      CHARACTER*4 ILEVEL
      CHARACTER*4 IERROR
      CHARACTER*4 IFLAGF
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      REAL KSLOC
      REAL KSSCAL
C
CCCCC DOUBLE PRECISION DM
CCCCC DOUBLE PRECISION DMTEMP
CCCCC DOUBLE PRECISION DTEMP1
CCCCC DOUBLE PRECISION DTEMP2
CCCCC DOUBLE PRECISION DOUT1
CCCCC DOUBLE PRECISION DN
CCCCC DOUBLE PRECISION DCURR
CCCCC DOUBLE PRECISION DCORR
CCCCC DOUBLE PRECISION DPROD
CCCCC DOUBLE PRECISION CDFGLO
CCCCC DOUBLE PRECISION CDFWAK
CCCCC DOUBLE PRECISION XPAR(5)
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION CENSOR(*)
      DIMENSION XLEVEL(*)
C
      DIMENSION TEMP1(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP3(*)
      DIMENSION ZTEMP1(*)
      DIMENSION ZTEMP2(*)
      DIMENSION ZTEMP3(*)
      DIMENSION ZTEMP4(*)
      DIMENSION ZTEMP5(*)
      DIMENSION ZTEMP6(*)
      DIMENSION ZTEMP7(*)
      DIMENSION ZTEMP8(*)
      DIMENSION ZTEMP9(*)
      DIMENSION ZTMP10(*)
      DIMENSION ZTMP11(*)
C
      DIMENSION CLLIMI(*)
      DIMENSION CLWIDT(*)
C
      DOUBLE PRECISION DTEMP(*)
      DOUBLE PRECISION DTMP12(*)
      DOUBLE PRECISION DTMP13(*)
      INTEGER ITEMP1(*)
C
      INTEGER IPPCAP(2)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
C
      ISUBN1='CMPD'
      ISUBN2='IS  '
      IERROR='NO'
C
C     2012/5: FOR BRITTLE FIBER WEIBULL, THE SECOND SHAPE PARAMETER IS
C             ASSUMED TO BE A KNOWN FIXED CONSTANT.  SO SH2 WILL BE AN
C             INPUT PARAMETER.
C
      ALOC=CPUMIN
      ASCALE=CPUMIN
      SH1=CPUMIN
      IF(ICASPL.NE.'BFWE')SH2=CPUMIN
      SH3=CPUMIN
      SH4=CPUMIN
      SH5=CPUMIN
      SH6=CPUMIN
      SH7=CPUMIN
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'PDIS')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,71)
   71   FORMAT('***** AT THE BEGINNING OF CMPDIS--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,72)ICASPL,ICASP2,IPPCBW,IFORSW,N,MINMAX
   72   FORMAT('ICASPL,ICASP2,IPPCBW,IFORSW,N,MINMAX = ',4(A4,2X),2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,75)KSLOC,KSSCAL,NUMSHA,IPPLDP
   75   FORMAT('KSLOC,KSSCAL,NUMSHA,IPPLDP = ',2G15.7,2I8)
        CALL DPWRST('XXX','BUG ')
        IF(N.GE.1)THEN
          DO85I=1,N
            WRITE(ICOUT,86)I,Y(I),CENSOR(I)
   86       FORMAT('I,Y(I),CENSOR(I) = ',I8,3G15.7)
            CALL DPWRST('XXX','BUG ')
   85     CONTINUE
        ENDIF
      ENDIF
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.LT.2)THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,31)
   31   FORMAT('***** ERROR IN ESTIMATING DISTRIBUTION PARAMETERS--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,32)
   32   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST 2.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,34)N
   34   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO60I=1,N
        IF(Y(I).NE.HOLD)GOTO69
   60 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)HOLD
   62 FORMAT('      ALL ELEMENTS OF THE RESPONSE VARIABLE ARE ',
     1       'IDENTICALLY EQUAL TO ',G15.7)

      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   69 CONTINUE
C
C               ****************************************************
C               **  STEP 2--                                      **
C               **  GENERATE THE OUTPUT FOR THE DESIRED STATISTIC **
C               **  TO DETERMINE P-VALUES/CONFIDENCE INTERVALS    **
C               **  FOR THE STATISTIC.                            **
C               ****************************************************
C
      IF(ICASP2.EQ.'MLE')THEN
C
C       MAXIMUM LIKELIHOOD FOR RAW (UNBINNED) DATA
C
C       THE NUMSHA PARAMETER WAS BEING OVERWRITTEN ON MY LINUX
C       PLATFORM.  DON'T KNOW IF THIS IS A COMPILER BUG OR A
C       MEMORY OVERWRITE ISSUE.  IN ANY EVENT, SAVING AND RESTORING
C       THIS VALUE SEEMS TO BE A WORKAROUND.
C
        NUMSHZ=NUMSHA
        IFLAGD=0
        CALL DPML1(Y,CENSOR,N,ICASPL,IFLAGD,IFLAG9,
     1             TEMP1,TEMP2,TEMP3,ZTEMP1,ZTEMP2,ZTEMP3,
     1             DTEMP,DTMP12,DTMP13,ITEMP1,MAXOBV,
     1             ALOC,ASCALE,ALOWLI,AUPPLI,
     1             SH1,SH2,SH3,SH4,
     1             SH5,SH6,SH7,
     1             YLOWLM,YUPPLM,A,B,MINMAX,ISEED,
     1             IADEDF,IGEPDF,IMAKDF,IBEIDF,
     1             ILGADF,ISKNDF,IGLDDF,IGOMDF,IGIGDF,
     1             IGEODF,IBGEDF,IGAUDF,
     1             ICENSO,IEXPBC,IWEIBC,ICENTY,IDFTTY,
     1             CLLIMI,CLWIDT,IHSTCW,IHSTOU,IRELAT,IRHSTG,
     1             IBUGA3,ISUBRO,IERROR)
        NUMSHA=NUMSHZ
C
C       GOODNESS OF FIT FOR RAW (UNBINNED) CASE.  CURRENTLY
C       PPCC, KOLMOGOROV-SMIRNOV, AND ANDERSON DARLING SUPPORTED,
C       BUT ADDITIONAL GOODNESS OF FIT MAY BE ADDED LATER.
C
      ELSEIF(ICASP2.EQ.'PPCC' .OR. ICASP2.EQ.'KS' .OR.
     1        ICASP2.EQ.'AD')THEN
        NCURVE=1
        IFLAGF='OFF'
        PPLOC=0.0
        PPSCAL=1.0
        NHIGH=0
        NJUNK1=0
        NJUNK2=0
        IF(NUMSHA.EQ.0)THEN
          CALL DPPP2(Y,CENSOR,XLEVEL,N,ICASPL,NHIGH,
     1               ZTEMP1,ZTEMP2,ZTEMP3,
     1               YLOWLM,YUPPLM,A,B,MINMAX,
     1               SHAPE1,SHAPE2,SHAPE3,SHAPE4,
     1               SHAPE5,SHAPE6,SHAPE7,
     1               IADEDF,IGEPDF,IMAKDF,IBEIDF,
     1               ILGADF,ISKNDF,IGLDDF,IBGEDF,
     1               IGETDF,ICONDF,IGOMDF,IKATDF,
     1               IGIGDF,IGEODF,
     1               IPPLDP,MAXOBV,ICENSO,IMETHD,ILEVEL,
     1               PPLOC,PPSCAL,
     1               PPA0,PPA1,PPCC,SDPPA0,SDPPA1,XRESSD,XRESDF,
     1               CCALBE,PPA0BW,PPA1BW,
     1               ZTEMP4,ZTEMP5,
     1               TEMP1,TEMP2,TEMP3,NJUNK1,NJUNK2,NCURVE,
     1               IBUGA3,ISUBRO,IERROR)
          IF(IPPCBW.EQ.'BIWE')THEN
            ALOC=PPA0BW
            ASCALE=PPA1BW
          ELSE
            ALOC=PPA0
            ASCALE=PPA1
          ENDIF
          STATVA=PPCC
        ELSEIF(NUMSHA.EQ.1 .OR. NUMSHA.EQ.2)THEN
          IF(KSLOC.EQ.CPUMIN .OR. KSSCAL.EQ.CPUMIN)THEN
            PPLOC=CPUMIN
            PPSCAL=CPUMIN
          ELSE
            PPLOC=KSLOC
            PPSCAL=KSSCAL
          ENDIF
          IF(ICASPL.EQ.'BFWE')SHAPE2=SH2
          CALL DPPPC2(Y,CENSOR,XLEVEL,N,MAXNXT,
     1                ICASP2,ICASPL,
     1                SHAP11,SHAP12,SHAP21,SHAP22,
     1                SHAPE1,SHAPE2,SHAPE3,SHAPE4,SHAPE5,
     1                YLOWLM,YUPPLM,A,B,MINMAX,
     1                TEMP1(1),TEMP1(20001),TEMP1(40001),
     1                TEMP1(60001),NUMSHA,
     1                ZTEMP1,ZTEMP2,ZTEMP3,ZTEMP4,TEMP1(80001),
     1                ZTEMP5,ZTEMP6,ZTEMP7,ZTEMP8,ZTEMP9,IPPCBW,
     1                IADEDF,IGEPDF,IMAKDF,IBEIDF,
     1                ILGADF,ISKNDF,IGLDDF,IBGEDF,
     1                IGETDF,ICONDF,IGOMDF,IKATDF,
     1                IGIGDF,IGEODF,
     1                IPPCCC,IPPCFO,IPPLDP,PPLOC,PPSCAL,
     1                IPPCDP,IPPCAP,IPPCAO,IMETHD,ICENSO,
     1                IFLAGF,NCURVE,
     1                PCHSLM,ILEVEL,
     1                ZTMP10,ZTMP11,TEMP2,TEMP3,NJUNK1,NJUNK2,
     1                PPCCMX,SHA1MX,SHA2MX,A0SAVE,A1SAVE,A0BWSV,A1BWSV,
     1                IBUGA3,ISUBRO,IERROR)
          SH1=SHA1MX
          SH2=SHA2MX
          STATVA=PPCCMX
          ALOC=A0SAVE
          ASCALE=A1SAVE
          IF(IPPCBW.EQ.'BIWE')THEN
            ALOC=A0BWSV
            ASCALE=A1BWSV
          ENDIF
          IF(KSLOC.NE.CPUMIN .AND. KSSCAL.NE.CPUMIN)THEN
            ALOC=KSLOC
            ASCALE=KSSCAL
          ENDIF
        ENDIF
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,31)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8011)
 8011   FORMAT('      THE REQUESTED FITTING METHOD IS NOT SUPPORTED.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8013)ICASP2
 8013   FORMAT('      FITTING METHOD: ',A4)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'PDIS')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF CMPDIS--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)N,NUMSHA,SHAP11,SHAP12
 9013   FORMAT('N,NUMSHA,SHAP11,SHAP12 = ',2I8,2G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)ALOC,ASCALE,SH1,SH2,STATVA
 9015   FORMAT('ALOC,ASCALE,SH1,SH2,STATVA = ',5G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE CMPLMT (WPRIME, KPRIME, SUM)
C
C        ALGORITHM AS 304.5 APPL.STATIST. (1996), VOL.45, NO.3
C
C        Reverse and complement the data in WPRIME
C
C        DATAPLOT NOTE: UTILITY ROUTINE USED BY FISHER TWO SAMPLE
C                       RANDOMIZATION TEST
C
      INTEGER KPRIME
      REAL WPRIME(*), SUM
C
      INTEGER I, J
      REAL TEMP
C
      J = KPRIME
      DO 10 I = 1, KPRIME / 2 + MOD(KPRIME, 2)
         TEMP = WPRIME(I)
         WPRIME(I) = REAL(DBLE(SUM) - DBLE(WPRIME(J)))
         WPRIME(J) = REAL(DBLE(SUM) - DBLE(TEMP))
         J = J - 1
   10 CONTINUE
C
      RETURN
      END
      SUBROUTINE CMPSTA(TEMP,TEMPZ,TEMPZ3,XTEMP1,XTEMP2,XTEMP3,
     1                  MAXNXT,NS2,NSZ,NSZ3,NUMV2,ICASPL,
     1                  ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1                  DTEMP1,DTEMP2,DTEMP3,
     1                  RIGHT,
     1                  ISUBRO,IBUGG3,IERROR)
C
C     PURPOSE--COMPUTE THE VALUE OF ONE OF 100+ STATISTICS.  THIS
C              IS A COMMON ROUTINE CALLED BY:
C                1) CKSTAT  = LET A = <STAT>
C                2) DPSP    = <STAT> STATISTIC PLOT
C                3) DPCRPL  = CROSS TABULATE <STAT> PLOT
C                4) DPFLUC  = FLUCTUATION PLOT <STAT>
C                5) DPBLOC  = <STAT> BLOCK PLOT
C                6) DPJBSP  = BOOTSTRAP <STAT> PLOT
C                           = JACKNIFE <STAT> PLOT
C                7) DPDEXP  = DEX <STAT> PLOT
C                8) DPINCU  = <STAT> INFLUENCE CURVE
C                9) DPTABU  = TABULATE <MEAN>
C               10) DPCRTA  = CROSS TABULATE <STAT>
C               11) DPPOTA  = POSITIONAL TABULATION <STAT>
C               12) CKMATH  = MATRIX COLUMN <STAT>
C               13) CKMATH  = MATRIX ROW <STAT>
C               14) CKMATH  = MATRIX GRAND <STAT>
C               15) CKMATH  = MATRIX PARTITION <STAT>
C               16) CKMATH  = LET V = CROSS TABULATE <STAT>
C               17) CKMATH  = LET V = CROSS TABULATE CUMULATIVE <STAT>
C               18) CKMATH  = LET V = SORT BY <STAT>
C               19) CKMATH  = LET V = MOVING <STAT>
C               20) CKMATH  = LET V = CUMULATIVE <STAT>
C               21) DPISP   = <STAT> INTERACTION PLOT
C
C              NOTE THAT THE DEX ... PLOT, ... BLOCK PLOT, AND
C              ... INFLUENCE CURVE, MATRIX <COLUMN/ROW> ONLY SUPPORT
C              STATISTICS COMPUTED FROM A SINGLE RESPONSE VARIABLE.
C              ALSO, SOME COMMANDS MAY NOT SUPPORT ALL STATISTICS IN
C              THIS LIST (OR, LESS FREQUENTLY, A COMMAND MAY SUPPORT
C              SOME ADDITIONAL STATISTICS NOT COMPUTED HERE).
C
C              USING A COMMON ROUTINE MAKES IT EASIER TO ADD
C              A STATISTIC AND INCORPORATE IT INTO ALL THE
C              RELEVANT PLOTS/TABULATIONS.  SHOULD ALSO REDUCE
C              THE LIKELIHOOD OF BUGS, ETC.
C
C              FOLLOWING STATISTICS ARE SUPPORTED:
C
C              CASE 1: ONE RESPONSE VARIABLE
C
C              LOCATION STATISTICS:  (21)
C                 BIWEIGHT LOCATION
C                 GEOMETRIC MEAN
C                 H10 LOCATION
C                 H12 LOCATION
C                 H15 LOCATION
C                 H17 LOCATION
C                 H20 LOCATION
C                 HARMONIC MEAN
C                 HODGES-LEHMAN
C                 JSCORE
C                 LP LOCATION
C                 MEAN (OR AVERAGE)
C                 MEDIAN
C                 MIDHINGE
C                 MIDMEAN
C                 MIDRANGE
C                 SHORTEST HALF MIDMEAN
C                 SHORTEST HALF MIDRANGE
C                 STANDARD DEVIATION OF LP LOCATION
C                 STANDARD DEVIATION OF THE MEAN
C                 TRIMEAN
C                 TRIMMED MEAN
C                 TRIMMED MEAN STANDARD ERROR
C                 VARIANCE OF THE MEAN
C                 VARIANCE OF LP LOCATION
C                 WINSORIZED MEAN
C
C              SCALE STATISTICS: (32)
C                 AVERAGE ABSOLUTE DEVIATION (AAD)
C                 AVERAGE ABSOLUTE DEVIATION FROM THE MEDIAN
C                 BIWEIGHT MIDVARIANCE
C                 BIWEIGHT SCALE
C                 COEFFICIENT OF DISPERSION
C                 COEFFICIENT OF VARIATION
C                 GEOMETRIC STANDARD DEVIATION
C                 H10 SCALE
C                 H12 SCALE
C                 H15 SCALE
C                 H17 SCALE
C                 H20 SCALE
C                 INDEX OF DISPERSION
C                 INTERQUARTILE RANGE
C                 LOGNORMAL COEFFICIENT OF VARIATION
C                 LOWER SEMI-INTERQUARTILE RANGE
C                 MAD TO MEDIAN
C                 MEDIAN ABSOLUTE DEVIATION (MAD)
C                 NORMALIZED INTERQUARTILE RANGE
C                 PERCENTAGE BEND MIDVARIANCE
C                 PRECISION
C                 QN
C                 Q QUANTILE RANGE
C                 QUARTILE COEFFICIENT OF DISPERSION
C                 RANGE
C                 RELATIVE LABORATORY PERFORMANCE (RLP)
C                 RELATIVE SD
C                 RELATIVE VARIANCE
C                 RESCALED SUM
C                 ROBUST POOLED RANGE
C                 ROBUST POOLED STANDARD DEVIATION
C                 ROOT MEAN SQUARE ERROR (OR RMS)
C                 SCALED MEDIAN ABSOLUTE DEVIATION (MADe)
C                 SIGNAL TO NOISE RATIO
C                 SN
C                 STANDARD DEVIATION (OR SD)
C                 SUM OF SQUARES
C                 SUM OF SQUARES FROM MEAN
C                 TRIMMED SD
C                 UNBIASED COEFFICIENT OF VARIATION
C                 UPPER SEMI-INTERQUARTILE RANGE
C                 VARIANCE
C                 WINSORIZED STANDARD DEVIATION
C                 WINSORIZED VARIANCE
C
C              PERCENTILE STATISTICS (15)
C                 FIRST/SECOND/THIRD/FOURTH/FIFTH/SIXTH/SEVENTH/
C                 EIGHTH/NINTH DECILE
C                 DECILE RATIO
C                 EXTREME
C                 INDEX MINIMUM
C                 INDEX MAXIMUM
C                 INDEX EXTREME
C                 LOWER HINGE
C                 LOWER QUARTILE
C                 MINIMUM (MIN)
C                 MAXIMUM (MAX)
C                 <VALUE> PERCENTILE
C                 QUANTILE STANDARD ERROR
C                 UPPER HINGE
C                 UPPER QUARTILE
C
C              HIGHER MOMENTS (2)
C                 GALTON SKEWNESS
C                 KURTOSIS
C                 PEARSON TWO SKEWNESS
C                 SKEWNESS
C
C              TIME SERIES STATISTICS (4)
C                 AUTOCORRELATION
C                 AUTOCOVARIANCE
C                 SINE FREQUENCY
C                 SINE AMPLITUDE
C
C              QUALITY CONTROL STATISTICS (15)
C                 CC
C                 CNP
C                 CNPK
C                 CNPM
C                 CNPMK
C                 CP
C                 CPK
C                 CPL
C                 CPM
C                 CPMK
C                 CPU
C                 EXPECTED LOSS
C                 (ACTUAL) PERCENT DEFECTIVE
C                 (THEORETICAL) PERCENT DEFECTIVE
C                 TAGUCHI SIGNAL-TO-NOISE (SN+, SN-, SN0, SN00)
C
C              STATISTICAL TESTS:
C                 A BASIS NORMAL
C                 A BASIS LOGNORMAL
C                 A BASIS WEIBULL
C                 A BASIS NONPARAMETRIC
C                 B BASIS NORMAL
C                 B BASIS LOGNORMAL
C                 B BASIS WEIBULL
C                 B BASIS NONPARAMETRIC
C                 ADJACENCY RANDOMNESS TEST   (SYNONM FOR MEAN
C                                             SUCCESSIVE DIFFERENCES)
C                 ADJACENCY RANDOMNESS TEST CDF
C                 ADJACENCY RANDOMNESS TEST PVALUE
C                 ADJACENCY RANDOMNESS TEST CV01
C                 ADJACENCY RANDOMNESS TEST CV05
C                 ADJACENCY RANDOMNESS TEST CV95
C                 ADJACENCY RANDOMNESS TEST CV99
C                 BINOMIAL PROPORTIONS
C                 BINOMIAL PROPORTIONS LOWER CONFIDENCE LIMIT
C                 BINOMIAL PROPORTIONS UPPER CONFIDENCE LIMIT
C                 CHI-SQUARE SD TEST
C                 CHI-SQUARE SD TEST CDF
C                 CHI-SQUARE SD TEST PVALUE
C                 CHI-SQUARE SD TEST LOWER TAIL PVALUE
C                 CHI-SQUARE SD TEST UPPER TAIL PVALUE
C                 CUMULATIVE SUM FORWARD TEST
C                 CUMULATIVE SUM FORWARD TEST PVALUE
C                 CUMULATIVE SUM BACKWARD TEST
C                 CUMULATIVE SUM BACKWARD TEST PVALUE
C                 DAVID
C                 DAVID CDF
C                 DAVID CRITICAL VALUE
C                 DAVID MINIMUM INDEX
C                 DAVID MAXIMUM INDEX
C                 DAVID PVALUE
C                 DIXON TEST
C                 DIXON MINIMUM TEST
C                 DIXON MAXIMUM TEST
C                 EXTREME STUDENTIZED DEVIATE
C                 FREQUENCY TEST
C                 FREQUENCY TEST CDF
C                 FREQUENCY WITHIN A BLOCK TEST
C                 FREQUENCY WITHIN A BLOCK TEST CDF
C                 GRUBB
C                 GRUBB CDF
C                 GRUBB DIRECTION
C                 GRUBB INDEX
C                 JARQUE BERA
C                 JARQUE BERA PVALUE
C                 JARQUE BERA CDF
C                 KURTOSIS OUTLIER
C                 KURTOSIS OUTLIER CDF
C                 KURTOSIS OUTLIER CRITICAL VALUE
C                 KURTOSIS OUTLIER INDEX
C                 KURTOSIS OUTLIER PVALUE
C                 LOWER BONETT STANDARD DEVIATION CONFIDENCE LIMIT
C                 LOWER COEFFICIENT OF DISPERSION CONFIDENCE LIMIT
C                 LOWER COEFFICIENT OF QUARTILE DISPERSION CONFIDENCE LIMIT
C                 LOWER COEFFICIENT OF VARIATION CONFIDENCE LIMIT
C                 LOWER CONFIDENCE LIMIT
C                 LOWER LOGNORMAL COEFFICIENT OF VARIATION CONFIDENCE LIMIT
C                 LOWER PREDICTION BOUND
C                 LOWER PREDICTION LIMIT
C                 LOWER STANDARD DEVIATION CONFIDENCE LIMIT
C                 LOWER STANDARD DEVIATION PREDICTION LIMIT
C                 LJUNG BOX TEST
C                 MCCOOL WEIBULL LOCATION TEST
C                 MCCOOL WEIBULL LOCATION TEST PVALUE
C                 MCCOOL WEIBULL LOCATION TEST CDF
C                 MCCOOL WEIBULL LOCATION TEST CV50
C                 MCCOOL WEIBULL LOCATION TEST CV90
C                 MCCOOL WEIBULL LOCATION TEST CV95
C                 MEAN SUCCESSIVE DIFFERENCE
C                 MEAN SUCCESSIVE DIFFERENCE NORMALIZED
C                 MEAN SUCCESSIVE DIFFERENCE CDF
C                 MEAN SUCCESSIVE DIFFERENCE PVALUE
C                 NORMAL TOLERANCE K FACTOR
C                 NORMAL TOLERANCE LOWER LIMIT
C                 NORMAL TOLERANCE UPPER LIMIT
C                 NORMAL TOLERANCE ONE SIDED K FACTOR
C                 NORMAL TOLERANCE ONE SIDED LOWER LIMIT
C                 NORMAL TOLERANCE ONE SIDED UPPER LIMIT
C                 ONE SAMPLE COEFFICIENT OF VARIATION TEST
C                 ONE SAMPLE COEFFICIENT OF VARIATION TEST CDF
C                 ONE SAMPLE COEFFICIENT OF VARIATION TEST PVALUE
C                 ONE SAMPLE COEFFICIENT OF VARIATION LOWER PVALUE
C                 ONE SAMPLE COEFFICIENT OF VARIATION UPPER PVALUE
C                 ONE SAMPLE SIGN TEST
C                 ONE SAMPLE SIGN TEST CDF
C                 ONE SAMPLE SIGN TEST PVALUE
C                 ONE SAMPLE SIGN TEST LOWER TAIL PVALUE
C                 ONE SAMPLE SIGN TEST UPPER TAIL PVALUE
C                 ONE SAMPLE T-TEST
C                 ONE SAMPLE T-TEST CDF
C                 ONE SAMPLE T-TEST PVALUE
C                 ONE SAMPLE T-TEST LOWER TAIL PVALUE
C                 ONE SAMPLE T-TEST UPPER TAIL PVALUE
C                 ONE SAMPLE WILCOXON SIGNED RANK TEST
C                 ONE SAMPLE WILCOXON SIGNED RANK TEST CDF
C                 ONE SAMPLE WILCOXON SIGNED RANK TEST PVALUE
C                 ONE SAMPLE WILCOXON SIGNED RANK TEST LOWER TAIL PVALUE
C                 ONE SAMPLE WILCOXON SIGNED RANK TEST UPPER TAIL PVALUE
C                 ONE-SIDED LOWER AGRESTI-COUL
C                 ONE-SIDED UPPER AGRESTI-COUL
C                 ONE-SIDED LOWER COEFFICIENT OF DISPERSION CONFIDENCE LIMIT
C                 ONE-SIDED UPPER COEFFICIENT OF DISPERSION CONFIDENCE LIMIT
C                 ONE-SIDED LOWER COEFFICIENT OF VARIATION CONFIDENCE LIMIT
C                 ONE-SIDED UPPER COEFFICIENT OF VARIATION CONFIDENCE LIMIT
C                 ONE-SIDED LOWER CONFIDENCE LIMIT
C                 ONE-SIDED UPPER CONFIDENCE LIMIT
C                 ONE-SIDED LOWER EXACT BINOMIAL
C                 ONE-SIDED UPPER EXACT BINOMIAL
C                 ONE-SIDED LOWER PREDICTION BOUND
C                 ONE-SIDED LOWER STANDARD DEVIATION CONFIDENCE LIMIT
C                 ONE-SIDED LOWER STANDARD DEVIATION PREDICTION LIMIT
C                 ONE-SIDED UPPER PREDICTION BOUND
C                 ONE-SIDED LOWER PREDICTION LIMIT
C                 ONE-SIDED UPPER PREDICTION LIMIT
C                 ONE-SIDED UPPER STANDARD DEVIATION CONFIDENCE LIMIT
C                 ONE-SIDED UPPER STANDARD DEVIATION PREDICTION LIMIT
C                 POISSON DISPERSION TEST
C                 POISSON DISPERSION TEST CDF
C                 POISSON DISPERSION TEST CDF PVALUE
C                 SKEW OUTLIER
C                 SKEW OUTLIER CDF
C                 SKEW OUTLIER CRITICAL VALUE
C                 SKEW OUTLIER INDEX
C                 SKEW OUTLIER PVALUE
C                 TWO-SIDED LOWER AGRESTI-COUL
C                 TWO-SIDED UPPER AGRESTI-COUL
C                 TWO-SIDED LOWER EXACT BINOMIAL
C                 TWO-SIDED UPPER EXACT BINOMIAL
C                 UPPER BONETT STANDARD DEVIATION CONFIDENCE LIMIT
C                 UPPER COEFFICIENT OF DISPERSION CONFIDENCE LIMIT
C                 UPPER COEFFICIENT OF QUARTILE DISPERSION CONFIDENCE LIMIT
C                 UPPER COEFFICIENT OF VARIATION CONFIDENCE LIMIT
C                 UPPER CONFIDENCE LIMIT
C                 UPPER LOGNORMAL COEFFICIENT OF VARIATION CONFIDENCE LIMIT
C                 UPPER PREDICTION BOUND
C                 UPPER PREDICTION LIMIT
C                 UPPER STANDARD DEVIATION CONFIDENCE LIMIT
C                 UPPER STANDARD DEVIATION PREDICTION LIMIT
C                 WILK SHAPIRO TEST
C                 WILK SHAPIRO TEST PVALUE
C
C              SPATIAL DATA
C                 VARIATIONAL DISTANCE
C                 RELATIVE DISPERSION INDEX
C                 UNIFORM CHI-SQUARE
C
C              DISTRIBUTION: (98)
C                 BOX COX NORMALITY  PPCC
C                 BOX COX NORMALITY  LAMBDA
C                 KAPPENMAN R        (TO SELECT LOGNORMAL/WEIBULL)
C                 KAPPENMAN R CUTOFF
C
C                 ANGLIT             PPCC
C                 ANGLIT             PPCC LOCATION
C                 ANGLIT             PPCC SCALE
C                 ARCSINE            PPCC
C                 ARCSINE            PPCC LOCATION
C                 ARCSINE            PPCC SCALE
C                 CAUCHY             PPCC
C                 CAUCHY             PPCC LOCATION
C                 CAUCHY             PPCC SCALE
C                 COSINE             PPCC
C                 COSINE             PPCC LOCATION
C                 COSINE             PPCC SCALE
C                 DOUBLE EXPONENTIAL PPCC
C                 DOUBLE EXPONENTIAL PPCC LOCATION
C                 DOUBLE EXPONENTIAL PPCC SCALE
C                 EXPONENTIAL        PPCC
C                 EXPONENTIAL        PPCC LOCATION
C                 EXPONENTIAL        PPCC SCALE
C                 FATIGUE LIFE       PPCC LOCATION
C                 FATIGUE LIFE       PPCC SCALE
C                 FATIGUE LIFE       PPCC SHAPE
C                 FATIGUE LIFE       PPCC STATISITC
C                 GAMMA              PPCC LOCATION
C                 GAMMA              PPCC SCALE
C                 GAMMA              PPCC SHAPE
C                 GAMMA              PPCC STATISTIC
C                 GENERALIZED PARETO PPCC LOCATION
C                 GENERALIZED PARETO PPCC SCALE
C                 GENERALIZED PARETO PPCC SHAPE
C                 GENERALIZED PARETO PPCC STATISITC
C                 GH                 PPCC LOCATION
C                 GH                 PPCC SCALE
C                 GH                 PPCC SHAPE ONE
C                 GH                 PPCC SHAPE TWO
C                 GH                 PPCC STATISTIC
C                 HALF-NORMAL        PPCC
C                 HALF-NORMAL        PPCC LOCATION
C                 HALF-NORMAL        PPCC SCALE
C                 HALF-CAUCHY        PPCC
C                 HALF-CAUCHY        PPCC LOCATION
C                 HALF-CAUCHY        PPCC SCALE
C                 HYPERBOLIC SECANT  PPCC
C                 HYPERBOLIC SECANT  PPCC LOCATION
C                 HYPERBOLIC SECANT  PPCC SCALE
C                 INVERTED WEIBULL   PPCC LOCATION
C                 INVERTED WEIBULL   PPCC SCALE
C                 INVERTED WEIBULL   PPCC SHAPE
C                 INVERTED WEIBULL   PPCC STATISTIC
C                 LOGISITC           PPCC
C                 LOGISITC           PPCC LOCATION
C                 LOGISITC           PPCC SCALE
C                 LOGNORMAL          PPCC LOCATION
C                 LOGNORMAL          PPCC SCALE
C                 LOGNORMAL          PPCC SHAPE
C                 LOGNORMAL          PPCC STATISTIC
C                 MAXWELL            PPCC
C                 MAXWELL            PPCC LOCATION
C                 MAXWELL            PPCC SCALE
C                 MINIMUM GUMBEL     PPCC
C                 MINIMUM GUMBEL     PPCC LOCATION
C                 MINIMUM GUMBEL     PPCC SCALE
C                 MAXIMUM GUMBEL     PPCC
C                 MAXIMUM GUMBEL     PPCC LOCATION
C                 MAXIMUM GUMBEL     PPCC SCALE
C                 NORMAL             PPCC
C                 NORMAL             PPCC LOCATION
C                 NORMAL             PPCC SCALE
C                 RAYLEIGH           PPCC
C                 RAYLEIGH           PPCC LOCATION
C                 RAYLEIGH           PPCC SCALE
C                 SEMI-CIRCULAR      PPCC
C                 SEMI-CIRCULAR      PPCC LOCATION
C                 SEMI-CIRCULAR      PPCC SCALE
C                 SINE               PPCC
C                 SINE               PPCC LOCATION
C                 SINE               PPCC SCALE
C                 SLASH              PPCC
C                 SLASH              PPCC LOCATION
C                 SLASH              PPCC SCALE
C                 TUKEY-LAMBDA       PPCC LOCATION
C                 TUKEY-LAMBDA       PPCC SCALE
C                 TUKEY-LAMBDA       PPCC SHAPE
C                 TUKEY-LAMBDA       PPCC STATISTIC
C                 UNIFORM            PPCC
C                 UNIFORM            PPCC LOCATION
C                 UNIFORM            PPCC SCALE
C                 WALD               PPCC LOCATION
C                 WALD               PPCC SCALE
C                 WALD               PPCC SHAPE
C                 WALD               PPCC STATISTIC
C                 WEIBULL            PPCC LOCATION
C                 WEIBULL            PPCC SCALE
C                 WEIBULL            PPCC SHAPE
C                 WEIBULL            PPCC STATISTIC
C                 2PAR WEIBULL       PPCC SCALE
C                 2PAR WEIBULL       PPCC SHAPE
C                 2PAR WEIBULL       PPCC STATISTIC
C
C                 DOUBLE EXPONENTIAL ANDERSON DARLING
C                 DOUBLE EXPONENTIAL ANDERSON DARLING LOCATION
C                 DOUBLE EXPONENTIAL ANDERSON DARLING SCALE
C                 EXPONENTIAL        ANDERSON DARLING
C                 EXPONENTIAL        ANDERSON DARLING LOCATION
C                 EXPONENTIAL        ANDERSON DARLING SCALE
C                 GAMMA (2-PAR)      ANDERSON DARLING
C                 GAMMA (2-PAR)      ANDERSON DARLING LOCATION
C                 GAMMA (2-PAR)      ANDERSON DARLING SCALE
C                 GUMBEL             ANDERSON DARLING
C                 GUMBEL             ANDERSON DARLING LOCATION
C                 GUMBEL             ANDERSON DARLING SCALE
C                 LOGISTIC           ANDERSON DARLING
C                 LOGISTIC           ANDERSON DARLING LOCATION
C                 LOGISTIC           ANDERSON DARLING SCALE
C                 LOGNORMAL (2-PAR)  ANDERSON DARLING
C                 LOGNORMAL (2-PAR)  ANDERSON DARLING LOCATION
C                 LOGNORMAL (2-PAR)  ANDERSON DARLING SCALE
C                 MAXWELL            ANDERSON DARLING
C                 MAXWELL            ANDERSON DARLING LOCATION
C                 MAXWELL            ANDERSON DARLING SCALE
C                 NORMAL             ANDERSON DARLING
C                 NORMAL             ANDERSON DARLING LOCATION
C                 NORMAL             ANDERSON DARLING SCALE
C                 RAYLEIGH           ANDERSON DARLING
C                 RAYLEIGH           ANDERSON DARLING LOCATION
C                 RAYLEIGH           ANDERSON DARLING SCALE
C                 UNIFORM            ANDERSON DARLING
C                 UNIFORM            ANDERSON DARLING LOCATION
C                 UNIFORM            ANDERSON DARLING SCALE
C                 WEIBULL (2-PAR)    ANDERSON DARLING
C                 WEIBULL (2-PAR)    ANDERSON DARLING LOCATION
C                 WEIBULL (2-PAR)    ANDERSON DARLING SCALE
C
C              MISCELLANOUS: (12)
C                 COMMON DIGITS
C                 INTEGRAL
C                 INTERVAL COUNT
C                 NUMBER (OR COUNT OR SIZE)
C                 PRODUCT
C                 RAW SHANNON DIVERSITY INDEX
C                 RAW SHANNON EQUITABILITY INDEX
C                 RAW SIMPSON DIVERSITY INDEX
C                 SHANNON DIVERSITY INDEX
C                 SHANNON EQUITABILITY INDEX
C                 SIMPSON DIVERSITY INDEX
C                 SUM
C                 UNIQUE (NUMBER OF DISTINCT VALUES)
C                 VALUE COUNT
C                 PYTHON MEAN
C
C              FOLLOWING ARE USED BY LET ... = CROSS TABULATE ...
C                 GROUP ONE
C                 GROUP TWO
C                 GROUP THREE
C                 GROUP FOUR
C                 GROUP FIVE
C                 GROUP SIX
C
C              CASE 2: TWO RESPONSE VARIABLES
C
C              GROUP STATISTICS
C                 COMMON COEFFICIENT OF VARIATION
C                 COMMON BIAS CORRECTED COEFFICIENT OF VARIATION
C                 LOWER COMMON COEFFICIENT OF VARIATION CONFIDENCE LIMIT
C                 UPPER COMMON COEFFICIENT OF VARIATION CONFIDENCE LIMIT
C
C              WEIGHTED STATISTICS: (9)
C                 WEIGHTED MEAN
C                 WEIGHTED ORDER STATISTIC MEAN
C                 WEIGHTED STANDARD DEVIATION
C                 WEIGHTED SKEWNESS
C                 WEIGHTED SUM
C                 WEIGHTED SUM OF ABSOLUTE VALUES
C                 WEIGHTED SUM OF SQUARES
C                 WEIGHTED TRIMMED MEAN
C                 WEIGHTED VARIANCE
C
C              CO-RELATION: (30)
C                 ANGULAR COSINE DISTANCE
C                 ANGULAR COSINE SIMILARITY
C                 BINARY ASYMMETRIC DICE MATCH DISSIMILARITY
C                 BINARY ASYMMETRIC DICE MATCH SIMILARITY
C                 BINARY ASYMMETRIC SOKAL MATCH DISSIMILARITY
C                 BINARY ASYMMETRIC SOKAL MATCH SIMILARITY
C                 BINARY GAMMA COEFFICIENT
C                 BINARY JACCARD DISSIMILARITY
C                 BINARY JACCARD SIMILARITY
C                 BINARY MATCH DISSIMILARITY
C                 BINARY MATCH SIMILARITY
C                 BINARY ROGERS MATCH DISSIMILARITY
C                 BINARY ROGERS MATCH SIMILARITY
C                 BINARY SOKAL MATCH DISSIMILARITY
C                 BINARY SOKAL MATCH SIMILARITY
C                 BIWEIGHT MIDCOVARIANCE
C                 BIWEIGHT MIDCORRELATION
C                 CANBERRA DISTANCE
C                 CHEBYCHEV DISTANCE
C                 COMOVEMENT
C                 CORRELATION
C                 CORRELATION ABSOLUTE VALUE
C                 CORRELATION PVALUE
C                 CORRELATION CDF
C                 CORRELATION RATIO
C                 COSINE DISTANCE
C                 COSINE SIMILARITY
C                 COVARIANCE
C                 DOT PRODUCT
C                 EUCLIDEAN DISTANCE
C                 EUCLIDEAN LENGTH
C                 GENERALIZED JACCARD COEFFCIENT
C                 GENERALIZED JACCARD DISTANCE
C                 HAMMING DISTANCE
C                 INTRACLASS CORRELATION
C                 KENDALLS TAU (GAMMA CORRELATION COEFFICIENT)
C                 KENDALLS TAU A
C                 KENDALLS TAU B
C                 KENDALLS TAU C
C                 KENDALLS TAU ABSOLUTE VALUE
C                 KENDALLS TAU CDF
C                 KENDELLS TAU DISSIMILARITY
C                 KENDELLS TAU SIMILARITY
C                 KENDALLS TAU PVALUE
C                 KENDALLS TAU LOWER TAILED PVALUE
C                 KENDALLS TAU UPPER TAILED PVALUE
C                 MANHATTAN DISTANCE
C                 MINKOWSKI DISTANCE
C                 PERCENTAGE BEND CORRELATION
C                 PEARSON DISSIMILARITY (OR PEARSON DISTANCE)
C                 PEARSON SIMILARITY
C                 RANK CORRELATION
C                 RANK CORRELATION ABSOLUTE VALUE
C                 RANK CORRELATION CDF
C                 RANK CORRELATION PVALUE
C                 RANK CORRELATION LOWER TAILED PVALUE
C                 RANK CORRELATION UPPER TAILED PVALUE
C                 RANK COMOVEMENT
C                 RANK COVARIANCE
C                 SPEARMAN DISSIMILARITY
C                 SPEARMAN SIMILARITY
C                 WINSORIZED COVARIANCE
C                 WINSORIZED CORRELATION
C                 YOUDEN INDEX
C                 YULES Q (BINARY GAMMA COEFFICIENT)
C                 YULES Y
C
C              REGRESSION/FITTING: (11)
C                 CONSTANT INTERCEPT
C                 CONSTANT INTERCEPT SD
C                 LINEAR CORRELATION
C                 LINEAR DISTINCT X
C                 LINEAR INTERCEPT
C                 LINEAR INTERCEPT SD
C                 LINEAR RESSD
C                 LINEAR SLOPE
C                 LINEAR SLOPE SD
C                 REPEATABILITY SD
C                 REPRODUCABILITY SD
C
C              CATEGORICAL DATA: (16)
C                 CRAMER CONTINGENCY COEFFICIENT
C                 FALSE POSITIVE
C                 FALSE NEGATIVE
C                 LOG ODDS RATIO (BIAS CORRECTED LOG ODDS RATIO)
C                 NEGATIVE PREDICTIVE VALUE
C                 ODDS RATIO (BIAS CORRECTED ODDS RATIO)
C                 PEARSON CONTINGENCY COEFFICIENT
C                 PERCENTAGE AGREE
C                 PERCENTAGE DISAGREE
C                 POSITIVE PREDICTIVE VALUE
C                 RATIO (= SUM1/SUM2)
C                 RELATIVE RISK
C                 STANDARD ERROR LOG ODDS RATIO (STANDARD ERROR OF
C                     THE BIAS CORRECTED LOG ODDS RATIO)
C                 STANDARD ERROR ODDS RATIO (STANDARD ERROR OF THE
C                     BIAS CORRECTED ODDS RATIO)
C                 TRUE NEGATIVE
C                 TRUE POSITIVE
C                 TEST SENSITIVITY
C                 TEST SPECIFICITY
C
C              DIFFERENCE OF LOCATION: (15)
C                 DIFFERENCE OF BIWEIGHT LOCATION
C                 DIFFERENCE OF GEOMETRIC MEANS
C                 DIFFERENCE OF H10 LOCATION
C                 DIFFERENCE OF H12 LOCATION
C                 DIFFERENCE OF H15 LOCATION
C                 DIFFERENCE OF H17 LOCATION
C                 DIFFERENCE OF H20 LOCATION
C                 DIFFERENCE OF HARMONIC MEANS
C                 DIFFERENCE OF HODGES-LEHMAN
C                 DIFFERENCE OF LP LOCATION
C                 DIFFERENCE OF MEANS
C                 DIFFERENCE OF MEDIANS
C                 DIFFERENCE OF MIDHNGE
C                 DIFFERENCE OF MIDMEANS
C                 DIFFERENCE OF SHORTEST HALF MIDMEAN
C                 DIFFERENCE OF SHORTEST HALF MIDRANGE
C                 DIFFERENCE OF TRIMMED MEANS
C                 DIFFERENCE OF WINSORIZED MEANS
C                 HEDGES G
C                 BIAS CORRECTED HEDGES G
C                 GLASS G
C                 COHENS D
C
C              DIFFERENCE OF SCALE AND HIGHER MOMENTS: (38)
C                 DIFFERENCE OF AAD
C                 DIFFERENCE OF AVERAGE ABSOLUTE DEVIATIONS FROM MEDIAN
C                 DIFFERENCE OF BIWEIGHT MIDVARIANCE
C                 DIFFERENCE OF BIWEIGHT SCALE
C                 DIFFERENCE OF COEFFICIENT OF DISPERSION
C                 DIFFERENCE OF COEFFICIENT OF VARIATION
C                 DIFFERENCE OF EXTREMES
C                 DIFFERENCE OF GEOMETRIC SD
C                 DIFFERENCE OF H10 SCALE
C                 DIFFERENCE OF H12 SCALE
C                 DIFFERENCE OF H15 SCALE
C                 DIFFERENCE OF H17 SCALE
C                 DIFFERENCE OF H20 SCALE
C                 DIFFERENCE OF INDEX OF DISPERSION
C                 DIFFERENCE OF INTERQUARTILE RANGE
C                 DIFFERENCE OF KURTOSIS
C                 DIFFERENCE OF EXCESS KURTOSIS
C                 DIFFERENCE OF MAD
C                 DIFFERENCE OF MAD TO MEDIAN
C                 DIFFERENCE OF MAXIMUM
C                 DIFFERENCE OF MIDRANGE
C                 DIFFERENCE OF MINIMUM
C                 DIFFERENCE OF NORMALIZED INTERQUARTILE RANGE
C                 DIFFERENCE OF PERCENTAGE BEND
C                 DIFFERENCE OF PRECISION
C                 DIFFERENCE OF QN
C                 DIFFERENCE OF QUANTILE
C                 DIFFERENCE OF RANGE
C                 DIFFERENCE OF RELATIVE SD
C                 DIFFERENCE OF RELATIVE VARIANCE
C                 DIFFERENCE OF RESCALED SUM
C                 DIFFERENCE OF ROOT MEAN SQUARE ERROR (OR RMS)
C                 DIFFERENCE OF SCALED MAD
C                 DIFFERENCE OF SD OF LP LOCATION
C                 DIFFERENCE OF SD OF MEAN
C                 DIFFERENCE OF SKEWNESS
C                 DIFFERENCE OF GALTON SKEWNESS
C                 DIFFERENCE OF PEARSON TWO SKEWNESS
C                 DIFFERENCE OF SN
C                 DIFFERENCE OF SIGNAL TO NOISE RATIO
C                 DIFFERENCE OF SUM OF SQUARES
C                 DIFFERENCE OF SUM OF SQUARES FROM MEAN
C                 DIFFERENCE OF STANDARD DEVIATIONS
C                 DIFFERENCE OF VARIANCES
C                 DIFFERENCE OF VARIANCE OF LP LOCATION
C                 DIFFERENCE OF VARIANCE OF THE MEAN
C                 DIFFERENCE OF WINSORIZED SD
C                 DIFFERENCE OF WINSORIZED VARIANCE
C
C              PERCENTILES: (3)
C                 GROUPED DECILE RATIO
C                 GROUPED PERCENTILE
C                 GROUPED QUANTILE
C
C              STATISTICAL TESTS
C                 ANDERSON DARLING K SAMPLE TEST
C                 ANDERSON DARLING K SAMPLE TEST CRITICAL VALUE
C                 BINOMIAL RATIO
C                 BIVARIATE CRAMER VON MISES 95 CRITICAL VALUE
C                 BIVARIATE CRAMER VON MISES 05 CRITICAL VALUE
C                 BIVARIATE CRAMER VON MISES TEST
C                 COCHRAN VARIANCE OUTLIER TEST
C                 COCHRAN VARIANCE OUTLIER CV95
C                 COCHRAN VARIANCE OUTLIER CV99
C                 COCHRAN VARIANCE OUTLIER PVALUE
C                 COCHRAN VARIANCE OUTLIER CDF
C                 COCHRAN MINIMUM VARIANCE OUTLIER TEST
C                 COCHRAN MINIMUM VARIANCE OUTLIER CV05
C                 COCHRAN MINIMUM VARIANCE OUTLIER CV01
C                 COCHRAN MINIMUM VARIANCE OUTLIER PVALUE
C                 COCHRAN MINIMUM VARIANCE OUTLIER CDF
C                 DIFFERENCE OF BINOMIAL PROPORTIONS
C                 DIFFERENCE OF BINOMIAL PROPORTIONS LOWER CONF LIMIT
C                 DIFFERENCE OF BINOMIAL PROPORTIONS UPPER CONF LIMIT
C                 F TEST
C                 F TEST CDF
C                 F TEST PVALUE
C                 FISHER TWO SAMPLE RANDOMIZATION TEST
C                 FISHER TWO SAMPLE RANDOMIZATION TEST PVALUE
C                 FISHER TWO SAMPLE RANDOMIZATION LOWER TAIL PVALUE
C                 GROUPED POISSON DISPERSION TEST
C                 GROUPED POISSON DISPERSION TEST CDF
C                 GROUPED POISSON DISPERSION TEST CDF PVALUE
C                 KLOTZ TEST
C                 KLOTZ TEST CDF
C                 KLOTZ TEST PVALUE
C                 KLOTZ TEST LOWER TAILED PVALUE
C                 KLOTZ TEST UPPER TAILED PVALUE
C                 KRUSKALL WALLIS TEST
C                 KRUSKALL WALLIS TEST CDF
C                 KRUSKALL WALLIS TEST PVALUE
C                 MANN WHITNEY RANK SUM TEST
C                 MANN WHITNEY RANK SUM TEST CDF
C                 MANN WHITNEY RANK SUM TEST PVALUE
C                 MANN WHITNEY RANK SUM LOWER TAIL PVALUE
C                 MANN WHITNEY RANK SUM UPPER TAIL PVALUE
C                 MANN WHITNEY U STATISTIC
C                 MEAN NEAREST NEIGHBOR DISTANCE CDF
C                 MEAN NEAREST NEIGHBOR DISTANCE PVALUE
C                 MEAN NEAREST NEIGHBOR DISTANCE TEST
C                 MEDIAN TEST
C                 MEDIAN TEST CDF
C                 MEDIAN TEST PVALUE
C                 ONE SAMPLE COEFFICIENT OF VARIATION TEST
C                 ONE SAMPLE COEFFICIENT OF VARIATION TEST CDF
C                 ONE SAMPLE COEFFICIENT OF VARIATION TEST PVALUE
C                 ONE SAMPLE COEFFICIENT OF VARIATION LOWER PVALUE
C                 ONE SAMPLE COEFFICIENT OF VARIATION UPPER PVALUE
C                 POLLARD ONE CDF
C                 POLLARD ONE PVALUE
C                 POLLARD ONE TEST
C                 POLLARD TWO CDF
C                 POLLARD TWO PVALUE
C                 POLLARD TWO TEST
C                 POLLARD THREE CDF
C                 POLLARD THREE PVALUE
C                 POLLARD THREE TEST
C                 POLLARD FOUR CDF
C                 POLLARD FOUR PVALUE
C                 POLLARD FOUR TEST
C                 POLLARD FIVE CDF
C                 POLLARD FIVE PVALUE
C                 POLLARD FIVE TEST
C                 RATIO OF MEANS
C                 RATIO OF MEANS LOWER LIMIT
C                 RATIO OF MEANS UPPER LIMIT
C                 SQUARED RANK TEST
C                 SQUARED RANK TEST CDF
C                 SQUARED RANK TEST PVALUE
C                 SQUARED RANK TEST LOWER TAILED PVALUE
C                 SQUARED RANK TEST UPPER TAILED PVALUE
C                 SUMMARY COEFFICIENT OF VARIATION
C                 SUMMARY LOWER SD CONFIDENCE LIMITS
C                 SUMMARY LOWER SD PREDICTION LIMITS
C                 SUMMARY ONE SIDED LOWER SD CONFIDENCE LIMITS
C                 SUMMARY ONE SIDED LOWER SD PREDICTION LIMITS
C                 SUMMARY ONE SIDED UPPER SD CONFIDENCE LIMITS
C                 SUMMARY ONE SIDED UPPER SD PREDICTION LIMITS
C                 SUMMARY UPPER SD CONFIDENCE LIMITS
C                 SUMMARY UPPER SD PREDICTION LIMITS
C                 TWO SAMPLE CHI-SQUARE TEST
C                 TWO SAMPLE CHI-SQUARE TEST CDF
C                 TWO SAMPLE CHI-SQUARE TEST PVALUE
C                 TWO SAMPLE COEFFICIENT OF VARIATION TEST
C                 TWO SAMPLE COEFFICIENT OF VARIATION TEST CDF
C                 TWO SAMPLE COEFFICIENT OF VARIATION TEST PVALUE
C                 TWO SAMPLE COEFFICIENT OF VARIATION LOWER PVALUE
C                 TWO SAMPLE COEFFICIENT OF VARIATION UPPER PVALUE
C                 TWO SAMPLE KOLMOGOROV SMIRNOV TEST
C                 TWO SAMPLE KOLMOGOROV SMIRNOV CRITICAL VALUE
C                 TWO SAMPLE PAIRED T-TEST
C                 TWO SAMPLE PAIRED T-TEST CDF
C                 TWO SAMPLE PAIRED T-TEST PVALUE
C                 TWO SAMPLE PAIRED T-TEST LOWER TAIL PVALUE
C                 TWO SAMPLE PAIRED T-TEST UPPER TAIL PVALUE
C                 TWO SAMPLE SIGN TEST
C                 TWO SAMPLE SIGN TEST CDF
C                 TWO SAMPLE SIGN TEST PVALUE
C                 TWO SAMPLE SIGN TEST LOWER TAIL PVALUE
C                 TWO SAMPLE SIGN TEST UPPER TAIL PVALUE
C                 TWO SAMPLE T-TEST
C                 TWO SAMPLE T-TEST CDF
C                 TWO SAMPLE T-TEST PVALUE
C                 TWO SAMPLE T-TEST LOWER TAIL PVALUE
C                 TWO SAMPLE T-TEST UPPER TAIL PVALUE
C                 TWO SAMPLE WILCOXON SIGNED RANK TEST
C                 TWO SAMPLE WILCOXON SIGNED RANK TEST CDF
C                 TWO SAMPLE WILCOXON SIGNED RANK TEST PVALUE
C                 TWO SAMPLE WILCOXON SIGNED RANK TEST LOWER TAIL PVALUE
C                 TWO SAMPLE WILCOXON SIGNED RANK TEST UPPER TAIL PVALUE
C
C              DISTRIBUTION:
C                 COMMON WEIBULL SHAPE TEST
C                 COMMON WEIBULL SHAPE TEST CDF
C                 COMMON WEIBULL SHAPE TEST PVALUE
C                 COMMON WEIBULL SHAPE TEST CV90
C                 COMMON WEIBULL SHAPE TEST CV95
C                 COMMON WEIBULL SHAPE TEST CV99
C
C              CONSENSUS MEANS:
C                 DERSIMONIAN LAIRD
C                 DERSIMONIAN LAIRD STANDARD ERROR
C                 DERSIMONIAN LAIRD HHD
C                 DERSIMONIAN LAIRD MINMAX
C                 MANDEL PAULE
C                 MANDEL PAULE STANDARD ERROR
C                 MODIFIED MANDEL PAULE
C                 MODIFIED MANDEL PAULE STANDARD ERROR
C                 VANGEL RUKHIN
C                 VANGEL RUKHIN STANDARD ERROR
C                 GENERALIZED CONFIDENCE INTERVAL
C                 GENERALIZED CONFIDENCE INTERVAL STANDARD ERROR
C                 BOB
C                 BOB STANDARD ERROR
C                 BCP
C                 BCP STANDARD ERROR
C                 MEAN OF MEANS
C                 MEAN OF MEANS STANDARD ERROR
C                 FAIRWEATHER
C                 FAIRWEATHER STANDARD ERROR
C                 SCHILLER-EBERHARDT
C                 SCHILLER-EBERHARDT STANDARD ERROR
C                 GRAYBILL DEAL
C                 GRAYBILL DEAL SINHA STANDARD ERROR
C                 GRAYBILL DEAL NAIVE STANDARD ERROR
C                 GRAYBILL DEAL ZHANG ONE STANDARD ERROR
C                 GRAYBILL DEAL ZHANG TWO STANDARD ERROR
C
C              MISCELLANEOUS: (9)
C                 DIFFERENCE OF BINOMIAL PROBABILITIES
C                 DIFFERENCE OF COUNTS
C                 DIFFERENCE OF SUMS
C                 DIFFERENCE OF PRODUCTS
C                 DIFFERENCE OF INTEGRALS
C                 INDEX FIRST MATCH
C                 INDEX LAST  MATCH
C                 INDEX FIRST NOT MATCH
C                 INDEX LAST  NOT MATCH
C                 PERCENTAGE DIFFERENCE OF MEAN
C
C              CASE 3: THREE RESPONSE VARIABLES
C
C              WEIGHTED STATISTICS:
C                 GROUPED CORRELATION
C                 WEIGHTED CORRELATION
C                 WEIGHTED COSINE DISTANCE
C                 WEIGHTED COSINE SIMILARITY
C                 WEIGHTED COVARIANCE
C
C              FIT/CORRELATION
C                 EQUAL SLOPES
C                 EQUAL SLOPES CDF
C                 EQUAL SLOPES CRITICAL VALUE
C                 EQUAL SLOPES PVALUE
C                 PARTIAL CORRELATION
C                 PARTIAL CORRELATION ABSOLUTE VALUE
C                 PARTIAL CORRELATION CDF
C                 PARTIAL CORRELATION PVALUE
C                 PARTIAL KENDALL TAU CORRELATION
C                 PARTIAL KENDALL TAU CORRELATION ABSOLUTE VALUE
C                 PARTIAL RANK CORRELATION
C                 PARTIAL RANK CORRELATION ABSOLUTE VALUE
C
C              STATISTICAL TESTS
C                 FRIEDMAN TEST
C                 FRIEDMAN TEST CDF
C                 FRIEDMAN TEST PVALUE
C                 PAGE TEST
C                 PAGE MODIFIED TEST
C                 PAGE TEST CDF
C                 PAGE TEST PVALUE
C                 QUADE TEST
C                 QUADE TEST CDF
C                 QUADE TEST PVALUE
C                 SUMMARY LOWER COEFFICIENT OF VARIATION CONFIDENCE LIMITS
C                 SUMMARY LOWER CONFIDENCE LIMITS
C                 SUMMARY LOWER PREDICTION BOUNDS
C                 SUMMARY LOWER PREDICTION LIMITS
C                 SUMMARY NORMAL TOLERANCE K FACTOR
C                 SUMMARY NORMAL TOLERANCE LOWER LIMIT
C                 SUMMARY NORMAL TOLERANCE UPPER LIMIT
C                 SUMMARY NORMAL TOLERANCE ONE SIDED K FACTOR
C                 SUMMARY NORMAL TOLERANCE ONE SIDED LOWER LIMIT
C                 SUMMARY NORMAL TOLERANCE ONE SIDED UPPER LIMIT
C                 SUMMARY ONE SAMPLE COEFFICIENT OF VARIATION CDF
C                 SUMMARY ONE SAMPLE COEFFICIENT OF VARIATION PVALUE
C                 SUMMARY ONE SAMPLE COEFFICIENT OF VARIATION TEST
C                 SUMMARY ONE SIDED LOWER CONFIDENCE LIMITS
C                 SUMMARY ONE SIDED LOWER PREDICTION BOUNDS
C                 SUMMARY ONE SIDED LOWER PREDICTION LIMITS
C                 SUMMARY ONE SIDED UPPER CONFIDENCE LIMITS
C                 SUMMARY ONE SIDED UPPER PREDICTION BOUNDS
C                 SUMMARY ONE SIDED UPPER PREDICTION LIMITS
C                 SUMMARY UPPER COEFFICIENT OF VARIATION CONFIDENCE LIMITS
C                 SUMMARY UPPER CONFIDENCE LIMITS
C                 SUMMARY UPPER PREDICTION BOUNDS
C                 SUMMARY UPPER PREDICTION LIMITS
C
C              CONSENSUS MEANS
C                 ANDERSON DARLING K SAMPLE TEST
C                 SUMMARY DERSIMONIAN LAIRD
C                 SUMMARY DERSIMONIAN LAIRD STANDARD ERROR
C                 SUMMARY DERSIMONIAN LAIRD HHD
C                 SUMMARY DERSIMONIAN LAIRD MINMAX
C                 SUMMARY MANDEL PAULE
C                 SUMMARY MANDEL PAULE STANDARD ERROR
C                 SUMMARY MODIFIED MANDEL PAULE
C                 SUMMARY MODIFIED MANDEL PAULE STANDARD ERROR
C                 SUMMARY VANGEL RUKHIN
C                 SUMMARY VANGEL RUKHIN STANDARD ERROR
C                 SUMMARY GENERALIZED CONFIDENCE INTERVAL
C                 SUMMARY GENERALIZED CONFIDENCE INTERVAL STANDARD ERROR
C                 SUMMARY BOB
C                 SUMMARY BOB STANDARD ERROR
C                 SUMMARY BCP
C                 SUMMARY BCP STANDARD ERROR
C                 SUMMARY MEAN OF MEANS
C                 SUMMARY MEAN OF MEANS STANDARD ERROR
C                 SUMMARY FAIRWEATHER
C                 SUMMARY FAIRWEATHER STANDARD ERROR
C                 SUMMARY SCHILLER-EBERHARDT
C                 SUMMARY SCHILLER-EBERHARDT STANDARD ERROR
C                 SUMMARY GRAYBILL DEAL
C                 SUMMARY GRAYBILL DEAL SINHA STANDARD ERROR
C                 SUMMARY GRAYBILL DEAL NAIVE STANDARD ERROR
C                 SUMMARY GRAYBILL DEAL ZHANG ONE STANDARD ERROR
C                 SUMMARY GRAYBILL DEAL ZHANG TWO STANDARD ERROR
C
C     WRITTEN BY--ALAN HECKERT
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2002/8
C     ORIGINAL VERSION--AUGUST    2002.
C     UPDATED         --FEBRUARY  2003. ADD SUPPORT FOR DIFFERENCE
C                                       OF LOCATION AND SCALE
C                                       STATISTICS
C     UPDATED         --APRIL     2003. ADD SUPPORT FOR SN, QN ROBUST
C                                       SCALE ESTIMATES (AND THEIR
C                                       DIFFERENCE), REQUIRED ADDING
C                                       ADDITIONAL SCRATCH ARRAYS.
C     UPDATED         --MAY       2003. ADD SUPPORT FOR WEIGHTED TRIMMED
C                                       MEAN.
C     UPDATED         --FEBRUARY  2004. RESTORE COMOVEMENT, RANK
C                                       COMOVEMENT
C     UPDATED         --OCTOBER   2004. KENDELLS TAU
C     UPDATED         --FEBRUARY  2005. REPEATABILITY SD
C     UPDATED         --FEBRUARY  2005. REPRODUCABILITY SD
C     UPDATED         --SEPTEMBER 2005. RATIO (=SUM1/SUM2)
C     UPDATED         --JANUARY   2007. CALL LIST TO RANKCR, RANKCV,
C                                       RANKCM
C     UPDATED         --MARCH     2007. RELATIVE RISK
C     UPDATED         --MARCH     2007. CRAMER CONTINGENCY COEFFICIENT
C     UPDATED         --MARCH     2007. FALSE POSITIVE
C     UPDATED         --MARCH     2007. FALSE NEGATIVE
C     UPDATED         --MARCH     2007. TRUE POSITIVE
C     UPDATED         --MARCH     2007. TRUE NEGATIVE
C     UPDATED         --MARCH     2007. TEST SENSITIVITY
C     UPDATED         --MARCH     2007. TEST SPECIFICITY
C     UPDATED         --APRIL     2007. POSITIVE PREDICTIVE VALUE
C     UPDATED         --APRIL     2007. NEGATIVE PREDICTIVE VALUE
C     UPDATED         --APRIL     2007. ODDS RATIO
C     UPDATED         --APRIL     2007. STANDARD ERROR ODDS RATIO
C     UPDATED         --APRIL     2007. LOG ODDS RATIO
C     UPDATED         --APRIL     2007. STANDARD ERROR LOG ODDS RATIO
C     UPDATED         --MAY       2007. TRIMMED STANDARD DEVIATION
C     UPDATED         --NOVEMBER  2007. DOUBLE PRECISION ARRAYS
C     UPDATED         --NOVEMBER  2007. LP LOCATION
C     UPDATED         --NOVEMBER  2007. VARIANCE OF LP LOCATION
C     UPDATED         --NOVEMBER  2007. SD OF LP LOCATION
C     UPDATED         --NOVEMBER  2007. DIFFERENCE OF LP LOCATION
C     UPDATED         --NOVEMBER  2007. DIFFERENCE OF VARIANCE LP
C                                       LOCATION
C     UPDATED         --NOVEMBER  2007. DIFFERENCE OF SD LP
C                                       LOCATION
C     UPDATED         --APRIL     2008. BINOMIAL PROBABILITIES
C     UPDATED         --SEPTEMBER 2008. DIFFERENCE OF BINOMIAL
C                                       PROBABILITIES
C     UPDATED         --FEBRUARY  2009. INDEX MINIMUM
C     UPDATED         --FEBRUARY  2009. INDEX MAXIMUM
C     UPDATED         --FEBRUARY  2009. INDEX EXTREME
C     UPDATED         --FEBRUARY  2009. GRUBB
C     UPDATED         --FEBRUARY  2009. GRUBB CDF
C     UPDATED         --FEBRUARY  2009. GRUBB DIRECTION
C     UPDATED         --FEBRUARY  2009. GRUBB INDEX
C     UPDATED         --FEBRUARY  2009. ONE SAMPLE T-TEST
C     UPDATED         --FEBRUARY  2009. ONE SAMPLE T-TEST CDF
C     UPDATED         --FEBRUARY  2009. FREQUECNY TEST
C     UPDATED         --FEBRUARY  2009. FREQUENCY TEST CDF
C     UPDATED         --FEBRUARY  2009. FREQUECNY WITHIN A BLOCK TEST
C     UPDATED         --FEBRUARY  2009. FREQUENCY WITHIN A BLOCK TEST
C                                       CDF
C     UPDATED         --FEBRUARY  2009. UNIFORM PPCC
C     UPDATED         --MAY       2009. MEAN CONFIDENCE LIMIT
C                                       MEDIAN CONFIDENCE LIMIT
C                                       NOTE THAT THESE ARE JUST SYNONYMS
C                                       FOR MEAN AND MEDIAN IN THIS ROUTINE.
C                                       HOWEVER, THEY RECEIVE SPECIAL
C                                       HANDLING IN CROSS TABULATE COMMAND
C                                       (WHERE WE PRINT SAMPLE SIZE AND
C                                       LOWER AND UPPER CONFIDENCE
C                                       LIMITS)
C     UPDATED         --SEPTEMBER 2009. SUPPORT FOR
C                                       LET A = XQ QUANTILE Y
C                                       LET A = P100 PERCENTILE Y
C     UPDATED         --NOVEMBER  2009. TIETJEN-MOORE
C     UPDATED         --NOVEMBER  2009. EXTREME STUDENTIZED DEVIATE
C     UPDATED         --NOVEMBER  2009. DIXON
C     UPDATED         --JANUARY   2010. BINOMIAL RATIO
C     UPDATED         --JANUARY   2010. ROOT MEAN SQUARE ERROR
C     UPDATED         --FEBRUARY  2010. CHECK DATA FOR MISSING VALUES
C                                       (I.E., IF DATA VALUE = PSTAMV,
C                                       OMIT FROM ANALYSIS)
C     UPDATED         --MARCH     2010. <ONE-SIDED/TWO-SIDED> <LOWER/UPPER>
C                                       AGRESTI-COUL
C     UPDATED         --MARCH     2010. <ONE-SIDED/TWO-SIDED> <LOWER/UPPER>
C                                       EXACT BINOMIAL
C     UPDATED         --JUNE      2010. ADD TEMPZ3 AND NS3 TO ACCOMODATE
C                                       STATISTICS REQUIRING 3 RESPONSE
C                                       VARIABLES
C     UPDATED         --JUNE      2010. VARIOUS CONSENSUS MEAN STATISTICS
C     UPDATED         --DECEMBER  2010. ROBUST POOLED STAND DEVIATION
C     UPDATED         --MARCH     2011. ANDERSON DARLING K-SAMPLE TEST
C     UPDATED         --MARCH     2011. TWO SAMPLE KOLM SMIR TEST
C     UPDATED         --MARCH     2011. WILK SHAPIRO NORMALITY TEST
C     UPDATED         --MARCH     2011. CUMULATIVE SUM RANDOMNESS TEST
C     UPDATED         --MARCH     2011. NORMAL TOLERANCE LIMITS
C     UPDATED         --MARCH     2011. F TEST
C     UPDATED         --APRIL     2011. TWO SAMPLE T TEST
C     UPDATED         --APRIL     2011. ONE/TWO SAMPLE SIGN TEST
C     UPDATED         --MAY       2011. ABASIS/BBASIS
C     UPDATED         --MAY       2011. ONE/TWO SAMPLE WILCOXON SIGNED RANK TEST
C     UPDATED         --MAY       2011. MANN WHITNEY RANK SUM TEST
C     UPDATED         --MAY       2011. KLOTZ TEST
C     UPDATED         --MAY       2011. SQUARED RANKS TEST
C     UPDATED         --JUNE      2011. FISHER TWO SAMPLE RANDOMIZATION
C                                       TEST
C     UPDATED         --JULY      2011. TWO SAMPLE CHI-SQUARE TEST
C     UPDATED         --JULY      2011. CHANGE ICASPL FOR LP LOCATION
C                                       TO AVOID CONFLICT WITH LEVEL
C                                       PLOT IN PLOTGE/PLOTG2
C     UPDATED         --JULY      2011. ADD DPCOST.INC AND DPCOSU.INC
C                                       TO AVOID LOTS OF CODE CHANGES
C                                       WHEN FUTURE STATISITCS NEED
C                                       VALUES FROM THESE INCLUDE FILES
C                                       (COMMENT OUT THOSE THAT ARE
C                                       CURRENTLY PASSED IN)
C     UPDATED         --JULY      2011. KRUSKALL WALLIS TEST
C     UPDATED         --JULY      2011. FRIEDMAN TEST
C     UPDATED         --JULY      2011. QUADE TEST
C     UPDATED         --JULY      2011. UNIQUE (NUMBER OF DISTINCT
C                                       VALUES)
C     UPDATED         --JULY      2011. PERCENTAGE AGREEMENT
C     UPDATED         --AUGUST    2011. CORRELATION ABSOLUTE VALUE
C     UPDATED         --NOVEMBER  2011. INDEX FIRST MATCH
C     UPDATED         --NOVEMBER  2011. INDEX LAST  MATCH
C     UPDATED         --NOVEMBER  2011. INDEX FIRST NOT MATCH
C     UPDATED         --NOVEMBER  2011. INDEX LAST  NOT MATCH
C     UPDATED         --DECEMBER  2011. SHANNON DIVERSITY INDEX
C     UPDATED         --DECEMBER  2011. SHANNON EQUITABILITY INDEX
C     UPDATED         --DECEMBER  2011. SIMPSON DIVERSITY INDEX
C     UPDATED         --DECEMBER  2011. JARQUE BERA NORMALITY TEST
C     UPDATED         --DECEMBER  2011. EXCESS KURTOSIS
C     UPDATED         --FEBRUARY  2012. SUM OF SQUARES
C     UPDATED         --FEBRUARY  2012. RESCALED SUM
C     UPDATED         --FEBRUARY  2012. RLP
C     UPDATED         --JUNE      2012. CORRELATION PVALUE
C     UPDATED         --JUNE      2012. CORRELATION CDF
C     UPDATED         --JUNE      2012. RANK CORRELATION ABSOLUTE VALUE
C     UPDATED         --JUNE      2012. KENDALL TAU CORRELATION ABSOLUTE VALUE
C     UPDATED         --JUNE      2012. PARTIAL CORRELATION
C     UPDATED         --JUNE      2012. PARTIAL CORRELATION PVALUE
C     UPDATED         --JUNE      2012. PARTIAL CORRELATION CDF
C     UPDATED         --JUNE      2012. PARTIAL CORRELATION ABSOLUTE VALUE
C     UPDATED         --JUNE      2012. PARTIAL RANK CORRELATION
C     UPDATED         --JUNE      2012. PARTIAL RANK CORRELATION ABSO VALUE
C     UPDATED         --JUNE      2012. PARTIAL KENDALL TAU CORRELATION
C                                               ABSOLUTE VALUE
C     UPDATED         --JUNE      2012. WEIGHTED SUM
C     UPDATED         --JUNE      2012. WEIGHTED SUM OF SQUARES
C     UPDATED         --JUNE      2012. WEIGHTED SUM OF ABSOLUTE VALUES
C     UPDATED         --JUNE      2012. WEIGHTED AVERAGE OF ABSO VALUES
C     UPDATED         --JUNE      2012. WEIGHTED SUM OF DEVIATIONS FROM
C                                                THE MEAN
C     UPDATED         --JUNE      2012. WEIGHTED SUM OF SQUARED DEVIATIONS
C                                                FROM THE MEAN
C     UPDATED         --JUNE      2012. DIFFERENCE OF SUM OF SQUARES
C     UPDATED         --JUNE      2012. DIFFERENCE OF RESCALED SUM
C     UPDATED         --SEPTEMBER 2012. Q QUANTILE RANGE
C     UPDATED         --NOVEMBER  2012. WEIGHTED ORDER STATISTIC MEAN
C     UPDATED         --DECEMBER  2012. LOWER CONFIDENCE LIMIT
C     UPDATED         --DECEMBER  2012. ONE-SIDED LOWER CONFIDENCE
C                                       LIMIT
C     UPDATED         --DECEMBER  2012. UPPER CONFIDENCE LIMIT
C     UPDATED         --DECEMBER  2012. ONE-SIDED UPPER CONFIDENCE
C                                       LIMIT
C     UPDATED         --DECEMBER  2012. LOWER PREDICTION LIMIT
C     UPDATED         --DECEMBER  2012. ONE-SIDED LOWER PREDICTION
C                                       LIMIT
C     UPDATED         --DECEMBER  2012. UPPER PREDICTION LIMIT
C     UPDATED         --DECEMBER  2012. ONE-SIDED UPPER PREDICTION
C                                       LIMIT
C     UPDATED         --JANUARY   2013. MEAN SUCCESSIVE DIFFERENCE TEST
C     UPDATED         --JANUARY   2013. WEIBULL PPCC SHAPE/LOCA/SCALE
C     UPDATED         --JANUARY   2013. TUKEY LAMBDA PPCC
C                                             SHAPE/LOCA/SCALE
C     UPDATED         --JANUARY   2013. NORMAL LOCA/SCALE
C     UPDATED         --FEBRUARY  2013. LOGNORMAL PPCC SHAPE/LOCA/SCALE
C     UPDATED         --FEBRUARY  2013. GH PPCC SHAPE/LOCA/SCALE
C     UPDATED         --FEBRUARY  2013. PAGE TEST
C     UPDATED         --FEBRUARY  2013. MEAN SUCCESSIVE DIFFEFRENCES TEST
C     UPDATED         --FEBRUARY  2013. KENDELL TAU CDF
C     UPDATED         --FEBRUARY  2013. KENDELL TAU PVALUE
C     UPDATED         --MARCH     2013. PREDICTION LIMITS
C                                       PREDICTION BOUNDS
C     UPDATED         --APRIL     2013. SD CONFIDENCE LIMITS
C     UPDATED         --APRIL     2013. SD PREDICTION LIMITS
C     UPDATED         --AUGUST    2013. MCCOOL WEIBULL LOCATION TEST
C     UPDATED         --OCTOBER   2013. CONSTANT INTERCEPT
C     UPDATED         --OCTOBER   2013. CONSTANT INTERCEPT SD
C     UPDATED         --NOVEMBER  2013. POISSON DISPERSION TEST
C     UPDATED         --NOVEMBER  2013. GROUPED POISSON DISPERSION TEST
C     UPDATED         --JANUARY   2014. BIVARIATE CRAMER VON MISES TEST
C     UPDATED         --JANUARY   2014. MEAN NEAREST NEIGHBOR DISTANCE
C                                       TEST
C     UPDATED         --JANUARY   2014. POLLARD TEST
C     UPDATED         --FEBRUARY  2014. VALUE COUNT
C     UPDATED         --MARCH     2014. VARIATIONAL DISTANCE
C     UPDATED         --MARCH     2014. RELATIVE DISPERSION INDEX
C     UPDATED         --MARCH     2014. UNIFORM CHI-SQUARE
C     UPDATED         --MARCH     2014. INTERDECILE RATIO
C     UPDATED         --MARCH     2014. GROUPED INTERDECILE RATIO
C     UPDATED         --MARCH     2014. GROUPED PERCENTILE
C     UPDATED         --MARCH     2014. GROUPED QUANTILE
C     UPDATED         --APRIL     2014. COMMON WEIBULL SHAPE TEST
C     UPDATED         --APRIL     2014. WEIGHTED SKEWNESS
C     UPDATED         --MAY       2014. KAPPENMAN R
C     UPDATED         --JULY      2014. BOX COX NORMALITY PPCC
C     UPDATED         --JULY      2014. BOX COX NORMALITY LAMBDA
C     UPDATED         --JULY      2014. AVERAGE ABSOLUTE DEVIATION
C                                       FROM THE MEDIAN
C     UPDATED         --JULY      2014. DIFFERENCE OF AVERAGE ABSOLUTE
C                                       DEVIATION FROM MEDIAN
C     UPDATED         --FEBRUARY  2015. BURR TYPE 10 ANDERSON DARLING
C     UPDATED         --FEBRUARY  2015. BURR TYPE 10 ANDERSON DARLING SHAPE
C     UPDATED         --FEBRUARY  2015. BURR TYPE 10 SCALE
C     UPDATED         --FEBRUARY  2015. DOUBLE EXPONENTIAL ANDERSON
C                                       DARLING
C     UPDATED         --FEBRUARY  2015. DOUBLE EXPONENTIAL ANDERSON
C                                       DARLING LOCATION
C     UPDATED         --FEBRUARY  2015. DOUBLE EXPONENTIAL ANDERSON
C                                       DARLING SCALE
C     UPDATED         --FEBRUARY  2015. EXPONENTIAL ANDERSON DARLING
C     UPDATED         --FEBRUARY  2015. EXPONENTIAL ANDERSON DARLING LOCATION
C     UPDATED         --FEBRUARY  2015. EXPONENTIAL ANDERSON DARLING SCALE
C     UPDATED         --FEBRUARY  2015. GAMMA ANDERSON DARLING
C     UPDATED         --FEBRUARY  2015. GAMMA ANDERSON DARLING SHAPE
C     UPDATED         --FEBRUARY  2015. GAMMA SCALE
C     UPDATED         --FEBRUARY  2015. FATIGUE LIFE ANDERSON DARLING
C     UPDATED         --FEBRUARY  2015. FATIGE LIFE ANDERSON DARLING SHAPE
C     UPDATED         --FEBRUARY  2015. FATIGUE LIFE SCALE
C     UPDATED         --FEBRUARY  2015. FRECHET ANDERSON DARLING
C     UPDATED         --FEBRUARY  2015. FRECHET ANDERSON DARLING SHAPE
C     UPDATED         --FEBRUARY  2015. FRECHET SCALE
C     UPDATED         --FEBRUARY  2015. GEOMETRIC EXPONENTIAL ANDERSON DARLING
C     UPDATED         --FEBRUARY  2015. GEOMETRIC EXPONENTIAL ANDERSON DARLING SHAPE
C     UPDATED         --FEBRUARY  2015. GEOMETRIC EXPONENTIAL SCALE
C     UPDATED         --FEBRUARY  2015. GUMBEL ANDERSON DARLING
C     UPDATED         --FEBRUARY  2015. GUMBEL ANDERSON DARLING LOCATION
C     UPDATED         --FEBRUARY  2015. GUMBEL SCALE
C     UPDATED         --FEBRUARY  2015. INVERTED GAMMA ANDERSON DARLING
C     UPDATED         --FEBRUARY  2015. INVERTED GAMMA ANDERSON DARLING SHAPE
C     UPDATED         --FEBRUARY  2015. INVERTED GAMMA SCALE
C     UPDATED         --FEBRUARY  2015. LOGISTIC ANDERSON DARLING
C     UPDATED         --FEBRUARY  2015. LOGISTIC ANDERSON DARLING LOCATION
C     UPDATED         --FEBRUARY  2015. LOGISTIC SCALE
C     UPDATED         --FEBRUARY  2015. LOGISTIC EXPONENTIAL ANDERSON DARLING
C     UPDATED         --FEBRUARY  2015. LOGISTIC EXPONENTIAL ANDERSON DARLING SHAPE
C     UPDATED         --FEBRUARY  2015. LOGISTIC EXPONENTIAL SCALE
C     UPDATED         --FEBRUARY  2015. LOGNORMAL ANDERSON DARLING
C     UPDATED         --FEBRUARY  2015. LOGNORMAL ANDERSON DARLING SHAPE
C     UPDATED         --FEBRUARY  2015. LOGNORMAL ANDERSON DARLING SCALE
C     UPDATED         --FEBRUARY  2015. MAXWELL ANDERSON DARLING
C     UPDATED         --FEBRUARY  2015. MAXWELL ANDERSON DARLING LOCATION
C     UPDATED         --FEBRUARY  2015. MAXWELL SCALE
C     UPDATED         --FEBRUARY  2015. NORMAL ANDERSON DARLING
C     UPDATED         --FEBRUARY  2015. NORMAL ANDERSON DARLING LOCATION
C     UPDATED         --FEBRUARY  2015. NORMAL ANDERSON DARLING SCALE
C     UPDATED         --FEBRUARY  2015. RAYLEIGH ANDERSON DARLING
C     UPDATED         --FEBRUARY  2015. RAYLEIGH ANDERSON DARLING LOCATION
C     UPDATED         --FEBRUARY  2015. RAYLEIGH SCALE
C     UPDATED         --FEBRUARY  2015. UNIFORM ANDERSON DARLING
C     UPDATED         --FEBRUARY  2015. UNIFORM ANDERSON DARLING LOCATION
C     UPDATED         --FEBRUARY  2015. UNIFORM SCALE
C     UPDATED         --FEBRUARY  2015. WEIBULL ANDERSON DARLING
C     UPDATED         --FEBRUARY  2015. WEIBULL ANDERSON DARLING SHAPE
C     UPDATED         --FEBRUARY  2015. WEIBULL ANDERSON DARLING SCALE
C     UPDATED         --FEBRUARY  2015. JSCORE
C     UPDATED         --FEBRUARY  2015. ADJANCENCY RANDOMNESS TEST
C                                       (SYNONYM FOR MEAN SUCCESSIVE
C                                       DIFFERENCES TEST)
C     UPDATED         --MARCH     2015. COCHRAN VARIANCE OUTLIER TEST
C     UPDATED         --APRIL     2015. CPMK, CNP, CNPM, CNPMK
C     UPDATED         --OCTOBER   2015. EQUAL SLOPES TEST
C     UPDATED         --NOVEMBER  2015. DIFFERENCE OF EXCESS KURTOSIS
C     UPDATED         --NOVEMBER  2015. DIFFERENCE OF GALTON SKEWNESS
C     UPDATED         --NOVEMBER  2015. DIFFERENCE OF PEARSON TWO SKEWNESS
C     UPDATED         --MARCH     2016. SCALED MAD
C     UPDATED         --MARCH     2016. NORMALIZED IQR
C     UPDATED         --MARCH     2016. DIFFERENCE OF SCALED MAD
C     UPDATED         --MARCH     2016. DIFFERENCE OF NORMALIZED IQR
C     UPDATED         --JUNE      2016. 2-PARAMETER WEIBULL PPCC
C     UPDATED         --JUNE      2016. 2-PARAMETER WEIBULL PPCC SHAPE
C     UPDATED         --JUNE      2016. 2-PARAMETER WEIBULL PPCC SCALE
C     UPDATED         --DECEMBER  2016. COEFFICIENT OF VARIATION
C                                       CONFIDENCE LIMITS
C     UPDATED         --JANUARY   2017. UNBIASED COEFFICIENT OF VARIATION
C     UPDATED         --JANUARY   2017. SIGNAL TO NOISE RATIO
C     UPDATED         --JANUARY   2017. QUARTILE COEFFICIENT OF
C                                       DISPERSION
C     UPDATED         --JANUARY   2017. LOGNORMAL COEFFICIENT OF VARIATION
C     UPDATED         --JANUARY   2017. LOGNORMAL COEFFICIENT OF VARIATION
C                                       CONFIDENCE LIMITS
C     UPDATED         --JANUARY   2017. PRECISION
C     UPDATED         --JANUARY   2017. COMMON COEFFICIENT OF VARIATION
C     UPDATED         --JANUARY   2017. COMMON BIAS CORRECTED COEFFICIENT
C                                       OF VARIATION
C     UPDATED         --JANUARY   2017. LOWER COMMON COEFFICIENT OF
C                                       VARIATION CONFIDENCE LIMIT
C     UPDATED         --JANUARY   2017. UPPER COMMON COEFFICIENT OF
C                                       VARIATION CONFIDENCE LIMIT
C     UPDATED         --JANUARY   2017. COEFFICIENT OF DISPERSION
C     UPDATED         --JANUARY   2017. INDEX OF DISPERSION
C     UPDATED         --JANUARY   2017. AAD TO MEDIAN
C     UPDATED         --FEBRUARY  2017. SHORTEST HALF MIDMEAN
C     UPDATED         --FEBRUARY  2017. SHORTEST HALF MIDRANGE
C     UPDATED         --MARCH     2017. COSINE DISTANCE
C     UPDATED         --MARCH     2017. COSINE SIMILARITY
C     UPDATED         --MARCH     2017. ANGULAR COSINE DISTANCE
C     UPDATED         --MARCH     2017. ANGULAR COSINE SIMILARITY
C     UPDATED         --MARCH     2017. MANHATTAN DISTANCE
C     UPDATED         --MARCH     2017. EUCLIDEAN DISTANCE
C     UPDATED         --MARCH     2017. EUCLIDEAN LENGTH (SYNONYM FOR
C                                       SUM OF SQuARES)
C     UPDATED         --MARCH     2017. DOT PRODUCT
C     UPDATED         --MARCH     2017. DIFFERENCE OF PRECISION
C     UPDATED         --MARCH     2017. DIFFERENCE OF SNR
C     UPDATED         --APRIL     2017. ONE SAMPLE COEF OF VARI CDF
C     UPDATED         --APRIL     2017. ONE SAMPLE COEF OF VARI PVALUE
C     UPDATED         --JUNE      2017. PERCENTAGE DIFFERENCE OF MEAN
C     UPDATED         --JUNE      2017. ONE SAMPLE COEF OF VARI TEST
C     UPDATED         --JUNE      2017. ONE SAMPLE COEF OF VARI TEST CDF
C     UPDATED         --JUNE      2017. ONE SAMPLE COEF OF VARI TEST PVALUE
C     UPDATED         --JUNE      2017. ONE SAMPLE COEF OF VARI LOWER PVALUE
C     UPDATED         --JUNE      2017. ONE SAMPLE COEF OF VARI UPPER PVALUE
C     UPDATED         --JUNE      2017. SUMMARY ONE SAMPLE COEF OF VARI TEST
C     UPDATED         --JUNE      2017. SUMMARY ONE SAMPLE COEF OF VARI CDF
C     UPDATED         --JUNE      2017. SUMMARY ONE SAMPLE COEF OF VARI PVALUE
C     UPDATED         --JUNE      2017. TWO SAMPLE COEF OF VARI TEST
C     UPDATED         --JUNE      2017. TWO SAMPLE COEF OF VARI TEST CDF
C     UPDATED         --JUNE      2017. TWO SAMPLE COEF OF VARI TEST PVALUE
C     UPDATED         --JUNE      2017. TWO SAMPLE COEF OF VARI LOWER PVALUE
C     UPDATED         --JUNE      2017. TWO SAMPLE COEF OF VARI UPPER PVALUE
C     UPDATED         --JUNE      2017. DIFFERENCE OF AAD TO MEDIAN
C     UPDATED         --JUNE      2017. DIFFERENCE OF COEFFICIENT OF
C                                                  DISPERSION
C     UPDATED         --JUNE      2017. DIFFERENCE OF INDEX OF DISPERSION
C     UPDATED         --JUNE      2017. DIFFERENCE OF QUARTILE COEFFICIENT
C                                                  OF DISPERSION
C     UPDATED         --JUNE      2017. DIFFERENCE OF SHORTEST HALF
C                                                  MIDMEAN
C     UPDATED         --JUNE      2017. DIFFERENCE OF SHORTEST HALF
C                                                  MIDRANGE
C     UPDATED         --JULY      2017. HEDGES G
C     UPDATED         --JULY      2017. BIAS CORRECTED HEDGES G
C     UPDATED         --JULY      2017. GLASS G
C     UPDATED         --JULY      2017. COHENS D
C     UPDATED         --JULY      2017. MIDHINGE, TRIMEAN
C     UPDATED         --JULY      2017. DIFFERENCE OF MIDHINGE
C     UPDATED         --JULY      2017. DIFFERENCE OF TRIMEAN
C     UPDATED         --AUGUST    2017. PEARSON DISSIMILARITY
C     UPDATED         --AUGUST    2017. SPEARMAN DISSIMILARITY
C     UPDATED         --AUGUST    2017. KENDALL TAU DISSIMILARITY
C     UPDATED         --AUGUST    2017. BINARY MATCH DISSIMILARITY
C     UPDATED         --AUGUST    2017. BINARY MATCH SIMILARITY
C     UPDATED         --AUGUST    2017. BINARY ROGERS DISSIMILARITY
C     UPDATED         --AUGUST    2017. BINARY ROGERS SIMILARITY
C     UPDATED         --AUGUST    2017. BINARY SOKAL DISSIMILARITY
C     UPDATED         --AUGUST    2017. BINARY SOKAL SIMILARITY
C     UPDATED         --AUGUST    2017. BINARY JACCARD DISSIMILARITY
C     UPDATED         --AUGUST    2017. BINARY JACCARD SIMILARITY
C     UPDATED         --AUGUST    2017. BINARY ASYMMETRIC DICE DISSIMILARITY
C     UPDATED         --AUGUST    2017. BINARY ASYMMETRIC DICE SIMILARITY
C     UPDATED         --AUGUST    2017. BINARY ASYMMETRIC SOKAL DISSIMILARITY
C     UPDATED         --AUGUST    2017. BINARY ASYMMETRIC SOKAL SIMILARITY
C     UPDATED         --AUGUST    2017. YULES Q
C     UPDATED         --AUGUST    2017. CHEBYSHEV DISTANCE
C     UPDATED         --AUGUST    2017. MINKOWSKI DISTANCE
C     UPDATED         --AUGUST    2017. GENERALIZED JACCARD COEFFICIENT
C     UPDATED         --AUGUST    2017. GENERALIZED JACCARD DISTANCE
C     UPDATED         --NOVEMBER  2017. BINOMIAL PROP LOWER CONF LIMIT
C     UPDATED         --NOVEMBER  2017. BINOMIAL PROP UPPER CONF LIMIT
C     UPDATED         --NOVEMBER  2017. DIFF OF BINO PROP LOWER CONF LIMIT
C     UPDATED         --NOVEMBER  2017. DIFF OF BINO PROP UPPER CONF LIMIT
C     UPDATED         --NOVEMBER  2017. COEFFICIENT OF DISPERSION
C                                       CONFIDENCE LIMITS
C     UPDATED         --DECEMBER  2017. COEFFICIENT OF QUARTILE DISPERSION
C                                       CONFIDENCE LIMITS
C     UPDATED         --DECEMBER  2017. LOWER BONETT STANDARD DEVIATION
C                                       CONFIDENCE LIMIT
C     UPDATED         --DECEMBER  2017. UPPER BONETT STANDARD DEVIATION
C                                       CONFIDENCE LIMIT
C     UPDATED         --JULY      2018. WEIGHTED COVARIANCE
C     UPDATED         --JULY      2018. WEIGHTED CORRELATION
C     UPDATED         --AUGUST    2018. HEDGES G STANDARD ERROR
C     UPDATED         --AUGUST    2018. HEDGES G LOWER CONFIDENCE LIMIT
C     UPDATED         --AUGUST    2018. HEDGES G UPPER CONFIDENCE LIMIT
C     UPDATED         --AUGUST    2018. HAMMING DISTANCE
C     UPDATED         --AUGUST    2018. CANBERRA DISTANCE
C     UPDATED         --AUGUST    2018. INTERVAL COUNT
C     UPDATED         --OCTOBER   2018. PEARSON SIMILARITY
C     UPDATED         --OCTOBER   2018. SPEARMAN SIMILARITY
C     UPDATED         --OCTOBER   2018. KENDELLS TAU SIMILARITY
C     UPDATED         --OCTOBER   2018. WEIGHTED COSINE DISTANCE
C     UPDATED         --OCTOBER   2018. WEIGHTED COSINE SIMILARITY
C     UPDATED         --OCTOBER   2018. GROUPED CORRELATION
C     UPDATED         --JANUARY   2019. PYTHON MEAN
C     UPDATED         --JANUARY   2019. YOUDEN INDEX
C     UPDATED         --JULY      2019. LOWER SEMI-INTERQUARTILE RANGE
C     UPDATED         --JULY      2019. UPPER SEMI-INTERQUARTILE RANGE
C     UPDATED         --AUGUST    2019. BINARY GAMMA COEFFICIENT
C     UPDATED         --AUGUST    2019. YULES Y
C     UPDATED         --AUGUST    2019. KENDALL TAU A
C     UPDATED         --AUGUST    2019. KENDALL TAU B
C     UPDATED         --AUGUST    2019. KENDALL TAU C
C     UPDATED         --AUGUST    2019. CORRECTION TO RLP COMPUTATION
C     UPDATED         --AUGUST    2019. INTRACLASS CORRELATION
C     UPDATED         --AUGUST    2019. CORRELATION RATIO
C     UPDATED         --SEPTEMBER 2019. RATIO OF MEANS
C     UPDATED         --SEPTEMBER 2019. RATIO OF MEANS LOWER CONFIDENCE
C                                       LIMIT
C     UPDATED         --SEPTEMBER 2019. RATIO OF MEANS UPPER CONFIDENCE
C                                       LIMIT
C     UPDATED         --OCTOBER   2019. DAVID TEST, DAVID TEST CDF
C     UPDATED         --OCTOBER   2019. DAVID TEST PVALUE
C     UPDATED         --OCTOBER   2019. DAVID TEST CRITICAL VALUE
C     UPDATED         --OCTOBER   2019. DAVID TEST MINIMUM INDEX
C     UPDATED         --OCTOBER   2019. DAVID TEST MAXIMUM INDEX
C     UPDATED         --OCTOBER   2019. SKEW OUTLIER TEST
C     UPDATED         --OCTOBER   2019. SKEW OUTLIER CDF
C     UPDATED         --OCTOBER   2019. SKEW OUTLIER CRITICAL VALUE
C     UPDATED         --OCTOBER   2019. SKEW OUTLIER INDEX
C     UPDATED         --OCTOBER   2019. SKEW OUTLIER PVALUE
C     UPDATED         --OCTOBER   2019. KURTOSIS OUTLIER TEST
C     UPDATED         --OCTOBER   2019. KURTOSIS OUTLIER CDF
C     UPDATED         --OCTOBER   2019. KURTOSIS OUTLIER CRITICAL VALUE
C     UPDATED         --OCTOBER   2019. KURTOSIS OUTLIER INDEX
C     UPDATED         --OCTOBER   2019. KURTOSIS OUTLIER PVALUE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
C
      CHARACTER*4 ICASZZ
      CHARACTER*4 ITYP91
      CHARACTER*4 IWRITE
      CHARACTER*4 ICASE
      CHARACTER*4 ICASE2
      CHARACTER*12 ICASEE
      CHARACTER*4 IPRSAV
      CHARACTER*4 IDIR
      CHARACTER*4 IFLAG
CCCCC CHARACTER*4 IQUAME
CCCCC CHARACTER*4 IQUASE
      CHARACTER*4 ICASAN
      CHARACTER*4 ICASA2
      CHARACTER*4 ICASA3
      CHARACTER*4 ICASA4
      CHARACTER*4 ICASA5
      CHARACTER*4 ICASDI
      CHARACTER*4 ICAPSW
CCCCC CHARACTER*4 ICAPTY
      CHARACTER*4 IDATSW
      CHARACTER*20 IDIST
      CHARACTER*4 IDIST2
      CHARACTER*4 IDAVT2
      CHARACTER*4 ISKOT2
      CHARACTER*4 IKUOT2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*8 ISBNAM
      CHARACTER*4 IFTEXP
      CHARACTER*4 IFTORD
      CHARACTER*4 IFORSW
      CHARACTER*4 IFEESV
      CHARACTER*4 IOP
      CHARACTER*4 IFOUND
C
C---------------------------------------------------------------------
C
      DIMENSION TEMP(*)
      DIMENSION TEMPZ(*)
      DIMENSION TEMPZ3(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
      DIMENSION XTEMP3(*)
C
      INTEGER ITEMP1(*)
      INTEGER ITEMP2(*)
      INTEGER ITEMP3(*)
      INTEGER ITEMP4(*)
      INTEGER ITEMP5(*)
      INTEGER ITEMP6(*)
C
      DOUBLE PRECISION DTEMP1(*)
      DOUBLE PRECISION DTEMP2(*)
      DOUBLE PRECISION DTEMP3(*)
C
CCCCC DOUBLE PRECISION STXMU
CCCCC DOUBLE PRECISION ST2SB
C
      DIMENSION ALPHAT(1)
      DIMENSION ADC(1)
      DIMENSION ALOWLV(1)
      DIMENSION AUPPLV(1)
C
      DIMENSION ICOLR(20)
      DIMENSION NRIGHT(20)
      DIMENSION ILISR(20)
      DIMENSION AVALV(20)
C
C     2015/04: FOLLOWING 3 LINES NEEDED BY COCHRAN VARIANCE OUTLIER TEST
C
      PARAMETER(NUMALZ=15)
      DIMENSION ALPHAV(NUMALZ)
      DIMENSION CV(NUMALZ)
C
      CHARACTER*4 IPNAM1
      CHARACTER*4 IPNAM2
      COMMON/STATIS/APVAL,IPNAM1,IPNAM2
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCOS2.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCOSB.INC'
C
      DOUBLE PRECISION DSD
      DOUBLE PRECISION D2
C
      DOUBLE PRECISION DLOWMP
      DOUBLE PRECISION DHIGMP
      DOUBLE PRECISION DLOWMM
      DOUBLE PRECISION DHIGMM
      DOUBLE PRECISION DLOWM2
      DOUBLE PRECISION DHIGM2
      DOUBLE PRECISION DLOWML
      DOUBLE PRECISION DHIGML
      DOUBLE PRECISION DLOWBO
      DOUBLE PRECISION DHIGBO
      DOUBLE PRECISION DLOWGC
      DOUBLE PRECISION DHIGGC
      DOUBLE PRECISION DLOWBC
      DOUBLE PRECISION DHIGBC
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DLOWFW
      DOUBLE PRECISION DHIGFW
CCCCC DOUBLE PRECISION DLOWF1
CCCCC DOUBLE PRECISION DHIGF1
      DOUBLE PRECISION DLOWF2
      DOUBLE PRECISION DHIGF2
      DOUBLE PRECISION DLOWF3
      DOUBLE PRECISION DHIGF3
      DOUBLE PRECISION DLOWSE
      DOUBLE PRECISION DHIGSE
      DOUBLE PRECISION XGDS20
      DOUBLE PRECISION XGDSZ1
      DOUBLE PRECISION XGDSZ2
      DOUBLE PRECISION DLOWGD
      DOUBLE PRECISION DHIGGD
      DOUBLE PRECISION TPLUS
      DOUBLE PRECISION TMINUS
      DOUBLE PRECISION RSUM
      DOUBLE PRECISION RSUMSQ
C
      DOUBLE PRECISION T0
      DOUBLE PRECISION T1
      COMMON /MPCOM/ T0, T1
      LOGICAL IFLAG9
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      DATA ALPHAV/
     1 0.1, 0.5, 1.0, 2.5, 5.0, 10.0, 25.0,
     1 50.0,
     1 75.0, 90.0, 95.0, 97.5, 99.0, 99.5, 99.9/
C
      ISUBN1='CMPS'
      ISUBN2='TA  '
      IWRITE='OFF'
      IPRSAV=IPRINT
      IFEESV=IFEEDB
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
      NMAX=0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(NS2.LT.1)THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,31)
   31   FORMAT('***** ERROR IN CMPSTA--THE NUMBER OF OBSERVATIONS ',
     1         'MUST BE AT LEAST 1;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,34)NS2
   34   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PSTA')THEN
        WRITE(ICOUT,70)
   70   FORMAT('AT THE BEGINNING OF CMPSTA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,71)IBUGG3,ISUBRO
   71   FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,72)NS2,NSZ,NUMV2,ICASPL
   72   FORMAT('NS2,NSZ,NUMV2,ICASPL = ',3I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
        DO73I=1,MAX(NS2,NSZ)
          WRITE(ICOUT,74)I,TEMP(I),TEMPZ(I)
   74     FORMAT('I, TEMP(I),TEMPZ(I) = ',I8,2F15.7)
          CALL DPWRST('XXX','BUG ')
   73   CONTINUE
      ENDIF
C
C     FEBRUARY 2010: CHECK FOR MISSING VALUES IN DATA.  NOTE THAT
C                    THIS STEP SHOULD BE SKIPPED FOR THE "SIZE"
C                    STATISTIC.
C
      NS2SAV=NS2
      NSZSAV=NSZ
      IF(ICASPL.EQ.'NUMB')GOTO11310
      IF(ICASPL.EQ.'COUN')GOTO11310
      IF(ICASPL.EQ.'SIZE')GOTO11310
      IF(ICASPL.EQ.'INTC')GOTO11312
      IF(ICASPL.EQ.'INMN')GOTO31760
      IF(ICASPL.EQ.'INMX')GOTO31770
      IF(ICASPL.EQ.'INEX')GOTO31780
      IF(ICASPL.EQ.'UNIQ')GOTO11315
C
      IFLAGN=0
      IF(NUMV2.GT.1)THEN
        IF(NSZ.GT.0 .AND. NSZ.NE.NS2)THEN
          IFLAGN=2
        ELSE
          IFLAGN=1
        ENDIF
      ENDIF
C
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PSTA')THEN
        WRITE(ICOUT,78)IFLAGN
   78   FORMAT('IFLAGN = ',I4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      ICNT=0
      DO110I=1,NS2
        IF(IFLAGN.EQ.0 .OR. IFLAGN.EQ.2)THEN
          IF(TEMP(I).NE.PSTAMV)THEN
            ICNT=ICNT+1
            TEMP(ICNT)=TEMP(I)
          ENDIF
        ELSEIF(IFLAGN.EQ.1)THEN
          IF(TEMP(I).NE.PSTAMV .AND. TEMPZ(I).NE.PSTAMV)THEN
            ICNT=ICNT+1
            TEMP(ICNT)=TEMP(I)
            TEMPZ(ICNT)=TEMPZ(I)
          ENDIF
        ENDIF
  110 CONTINUE
C
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PSTA')THEN
        WRITE(ICOUT,79)ICNT
   79   FORMAT('AFTER CHECK FOR MISSING VALUES, ICNT = ',I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(ICNT.EQ.0)THEN
        RIGHT=PSTAMV
        GOTO79000
      ENDIF
      NS2=ICNT
C
      IF(IFLAGN.EQ.2)THEN
        ICNT=0
        DO120I=1,NSZ
          IF(TEMPZ(I).NE.PSTAMV)THEN
            ICNT=ICNT+1
            TEMPZ(ICNT)=TEMPZ(I)
          ENDIF
  120   CONTINUE
C
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PSTA')THEN
          WRITE(ICOUT,129)ICNT
  129     FORMAT('AFTER CHECK TEMPZ FOR MISSING VALUES, ICNT = ',I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        IF(ICNT.EQ.0)THEN
          RIGHT=PSTAMV
          GOTO79000
        ENDIF
        NSZ=ICNT
      ENDIF
C
      IF(ICASPL.EQ.'SUM')GOTO11320
      IF(ICASPL.EQ.'PROD')GOTO11330
      IF(ICASPL.EQ.'INTE')GOTO11340
      IF(ICASPL.EQ.'MIDR')GOTO11350
      IF(ICASPL.EQ.'MEAN'.OR.ICASPL.EQ.'AVER')GOTO11360
      IF(ICASPL.EQ.'MECL')GOTO11360
      IF(ICASPL.EQ.'MIDM')GOTO11370
      IF(ICASPL.EQ.'SHMM')GOTO11372
      IF(ICASPL.EQ.'DSHM')GOTO11373
      IF(ICASPL.EQ.'SHMR')GOTO11374
      IF(ICASPL.EQ.'DSHR')GOTO11375
      IF(ICASPL.EQ.'MEDI')GOTO11380
      IF(ICASPL.EQ.'MDCL')GOTO11380
      IF(ICASPL.EQ.'SD')GOTO11390
      IF(ICASPL.EQ.'RMS')GOTO11395
      IF(ICASPL.EQ.'SSQM')GOTO11399
      IF(ICASPL.EQ.'DSSQ')GOTO19399
C
      IF(ICASPL.EQ.'SSQ' .OR. ICASPL.EQ.'RSUM' .OR.
     1   ICASPL.EQ.'RLP' .OR. ICASPL.EQ.'DSSQ' .OR.
     1   ICASPL.EQ.'DRSC')THEN
C
        IHP='CAPV'
        IHP2='ALUE'
        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
          XCAP=CPUMIN
        ELSE
          XCAP=VALUE(ILOCP)
        ENDIF
C
        IF(ICASPL.EQ.'SSQ')GOTO11396
        IF(ICASPL.EQ.'RSUM')GOTO11397
        IF(ICASPL.EQ.'RLP ')GOTO11405
        IF(ICASPL.EQ.'DSSQ')GOTO11398
        IF(ICASPL.EQ.'DRSC')GOTO11401
      ENDIF
      IF(ICASPL.EQ.'JSCO')GOTO11403
C
      IF(ICASPL.EQ.'VARI')GOTO11400
      IF(ICASPL.EQ.'PREC')GOTO11400
      IF(ICASPL.EQ.'RESD')GOTO11410
      IF(ICASPL.EQ.'REVA')GOTO11415
      IF(ICASPL.EQ.'CVAR')GOTO11418
      IF(ICASPL.EQ.'UCVA')GOTO11418
      IF(ICASPL.EQ.'SNRA')GOTO11419
      IF(ICASPL.EQ.'RANG')GOTO11420
      IF(ICASPL.EQ.'CDIS')GOTO11421
      IF(ICASPL.EQ.'LCDL')GOTO11427
      IF(ICASPL.EQ.'UCDL')GOTO11427
      IF(ICASPL.EQ.'1LCD')GOTO11427
      IF(ICASPL.EQ.'1UCD')GOTO11427
      IF(ICASPL.EQ.'LCDQ')GOTO11428
      IF(ICASPL.EQ.'UCDQ')GOTO11428
      IF(ICASPL.EQ.'IDIS')GOTO11422
      IF(ICASPL.EQ.'MADR')GOTO11423
      IF(ICASPL.EQ.'DCDI')GOTO11424
      IF(ICASPL.EQ.'DIDI')GOTO11425
      IF(ICASPL.EQ.'DMMD')GOTO11426
      IF(ICASPL.EQ.'MINI')GOTO11430
      IF(ICASPL.EQ.'MAXI')GOTO11440
      IF(ICASPL.EQ.'SKEW')GOTO11450
      IF(ICASPL.EQ.'GSKE')GOTO11452
      IF(ICASPL.EQ.'PSK2')GOTO11454
      IF(ICASPL.EQ.'KURT')GOTO11460
      IF(ICASPL.EQ.'EKUR')GOTO11465
      IF(ICASPL.EQ.'AUCR')GOTO11470
      IF(ICASPL.EQ.'COVA')GOTO11480
      IF(ICASPL.EQ.'CORR')GOTO11490
      IF(ICASPL.EQ.'COAB')GOTO11490
      IF(ICASPL.EQ.'COPV')GOTO11490
      IF(ICASPL.EQ.'COCD')GOTO11490
      IF(ICASPL.EQ.'PDIS')GOTO11490
      IF(ICASPL.EQ.'PSIM')GOTO11490
      IF(ICASPL.EQ.'MDIS')GOTO11491
      IF(ICASPL.EQ.'CNDI')GOTO11492
      IF(ICASPL.EQ.'PCOR')GOTO11495
      IF(ICASPL.EQ.'PCAB')GOTO11495
      IF(ICASPL.EQ.'PCPV')GOTO11495
      IF(ICASPL.EQ.'PCCD')GOTO11495
      IF(ICASPL.EQ.'MAND')GOTO11496
      IF(ICASPL.EQ.'CHDI')GOTO11497
      IF(ICASPL.EQ.'COSD')GOTO11498
      IF(ICASPL.EQ.'COSS')GOTO11498
      IF(ICASPL.EQ.'ACOS')GOTO11498
      IF(ICASPL.EQ.'ACOD')GOTO11498
      IF(ICASPL.EQ.'EUCD')GOTO11499
      IF(ICASPL.EQ.'EUCL')GOTO11499
      IF(ICASPL.EQ.'DOTP')GOTO11499
      IF(ICASPL.EQ.'RACR')GOTO11500
      IF(ICASPL.EQ.'RACC')GOTO11500
      IF(ICASPL.EQ.'RACP')GOTO11500
      IF(ICASPL.EQ.'RALP')GOTO11500
      IF(ICASPL.EQ.'RAUP')GOTO11500
      IF(ICASPL.EQ.'RACA')GOTO11500
      IF(ICASPL.EQ.'RDIS')GOTO11500
      IF(ICASPL.EQ.'RSIM')GOTO11500
      IF(ICASPL.EQ.'HDIS')GOTO11502
      IF(ICASPL.EQ.'RPCR')GOTO11505
      IF(ICASPL.EQ.'RPCA')GOTO11505
      IF(ICASPL.EQ.'PDIF')GOTO11509
      IF(ICASPL.EQ.'SDME')GOTO11510
      IF(ICASPL.EQ.'AUCV')GOTO11520
      IF(ICASPL.EQ.'RACV')GOTO11530
      IF(ICASPL.EQ.'PEAG')GOTO11531
      IF(ICASPL.EQ.'PEDI')GOTO11531
      IF(ICASPL.EQ.'COMO')GOTO31480
      IF(ICASPL.EQ.'RACM')GOTO31530
      IF(ICASPL.EQ.'KTAU')GOTO31540
      IF(ICASPL.EQ.'KTAA')GOTO31540
      IF(ICASPL.EQ.'TAUA')GOTO31540
      IF(ICASPL.EQ.'KTAB')GOTO31540
      IF(ICASPL.EQ.'KTAC')GOTO31540
      IF(ICASPL.EQ.'KTCD')GOTO31540
      IF(ICASPL.EQ.'KTPV')GOTO31540
      IF(ICASPL.EQ.'KTPL')GOTO31540
      IF(ICASPL.EQ.'KTPU')GOTO31540
      IF(ICASPL.EQ.'KDIS')GOTO31540
      IF(ICASPL.EQ.'PKTA')GOTO31545
      IF(ICASPL.EQ.'PKAB')GOTO31545
      IF(ICASPL.EQ.'RATI')GOTO31550
      IF(ICASPL.EQ.'BRAT')GOTO31551
      IF(ICASPL.EQ.'RMEA')GOTO31565
      IF(ICASPL.EQ.'RMLL')GOTO31565
      IF(ICASPL.EQ.'RMUL')GOTO31565
      IF(ICASPL.EQ.'ODRA')GOTO31560
      IF(ICASPL.EQ.'ORSE')GOTO31570
      IF(ICASPL.EQ.'RELR')GOTO31580
      IF(ICASPL.EQ.'CRAM')GOTO31590
      IF(ICASPL.EQ.'PEAR')GOTO31600
      IF(ICASPL.EQ.'FALP')GOTO31610
      IF(ICASPL.EQ.'FALN')GOTO31620
      IF(ICASPL.EQ.'TRUP')GOTO31630
      IF(ICASPL.EQ.'TRUN')GOTO31640
      IF(ICASPL.EQ.'SENS')GOTO31650
      IF(ICASPL.EQ.'SPEC')GOTO31660
      IF(ICASPL.EQ.'PPV ')GOTO31670
      IF(ICASPL.EQ.'NPV ')GOTO31680
      IF(ICASPL.EQ.'BMDI')GOTO31685
      IF(ICASPL.EQ.'BMRD')GOTO31685
      IF(ICASPL.EQ.'BMSD')GOTO31685
      IF(ICASPL.EQ.'BJDI')GOTO31685
      IF(ICASPL.EQ.'BSDI')GOTO31685
      IF(ICASPL.EQ.'BDDI')GOTO31685
      IF(ICASPL.EQ.'BMSI')GOTO31685
      IF(ICASPL.EQ.'BMRS')GOTO31685
      IF(ICASPL.EQ.'BMSS')GOTO31685
      IF(ICASPL.EQ.'BJSI')GOTO31685
      IF(ICASPL.EQ.'BSSI')GOTO31685
      IF(ICASPL.EQ.'BDSI')GOTO31685
      IF(ICASPL.EQ.'YULQ')GOTO31685
      IF(ICASPL.EQ.'YOUD')GOTO31685
      IF(ICASPL.EQ.'GC22')GOTO31685
      IF(ICASPL.EQ.'YULY')GOTO31685
      IF(ICASPL.EQ.'GJCO')GOTO31688
      IF(ICASPL.EQ.'GJDI')GOTO31688
      IF(ICASPL.EQ.'LODR')GOTO31690
      IF(ICASPL.EQ.'LOSE')GOTO31700
      IF(ICASPL.EQ.'ICCR')GOTO31715
      IF(ICASPL.EQ.'CRAT')GOTO31715
C
      IF(ICASPL.EQ.'LOWH')GOTO11540
      IF(ICASPL.EQ.'UPPH')GOTO11550
      IF(ICASPL.EQ.'LOWQ')GOTO11560
      IF(ICASPL.EQ.'UPPQ')GOTO11570
      IF(ICASPL.EQ.'MHIN')GOTO11575
      IF(ICASPL.EQ.'DMHI')GOTO11576
      IF(ICASPL.EQ.'TMEA')GOTO11578
      IF(ICASPL.EQ.'DTRI')GOTO11579
C
      IF(ICASPL.EQ.'TRIM' .OR. ICASPL.EQ.'WINM' .OR.
     1   ICASPL.EQ.'WIVA' .OR. ICASPL.EQ.'WISD' .OR.
     1   ICASPL.EQ.'WICV' .OR. ICASPL.EQ.'WICR' .OR.
     1   ICASPL.EQ.'TRSD' .OR. ICASPL.EQ.'WETM' .OR.
     1   ICASPL.EQ.'TMSE' .OR. ICASPL.EQ.'DTRM' .OR.
     1   ICASPL.EQ.'DWNM' .OR. ICASPL.EQ.'DWSD' .OR.
     1   ICASPL.EQ.'DWVA' .OR. ICASPL.EQ.'DTSD')THEN
C
C        2012/10: FOR TRIMMED MEAN, CAN SPECIFY EITHER A SPECIFIC NUMBER
C                 TO TRIM OR A PERCENTAGE TO TRIM.  CHECK FOR SPECIFIC
C                 NUMBER FIRST AND IF NOT SPECIFIED, CHECK FOR A
C                 PERCENTAGE.
C
        NTRIM1=-1
        NTRIM2=-1
        P1=-99.0
        P2=-99.0
C
        IHP='NTRI'
        IHP2='M1  '
        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.'NO')THEN
          NTRIM1=INT(VALUE(ILOCP)+0.1)
          IF(NTRIM1.LT.0)NTRIM1=0
        ENDIF
C
        IHP='NTRI'
        IHP2='M2  '
        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.'NO')THEN
          NTRIM2=INT(VALUE(ILOCP)+0.1)
          IF(NTRIM2.LT.0)NTRIM2=0
        ENDIF
C
        IF(NTRIM1.LE.0)THEN
          IHP='P1  '
          IHP2='    '
          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
          IF(PROP1.LT.0.0 .OR. PROP1.GT.100.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11581)
11581       FORMAT('***** ERROR IN CMPSTA--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11582)
11582       FORMAT('      THE PROPORTION FOR TRIMMING/WINSORIZING ',
     1             'BELOW')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11583)
11583       FORMAT('      MUST BE BETWEEN 0 AND 100, BUT WAS NOT.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11584)PROP1
11584       FORMAT('      PARAMETER P1 = LOWER PROPORTION = ',G15.7)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11586)
11586       FORMAT('      USE THE LET COMMAND TO PRE-DEFINE P1 AS IN')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11587)
11587       FORMAT('      LET P1 = 25')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ELSE
            PROP1=VALUE(ILOCP)
          ENDIF
        ENDIF
C
        IF(NTRIM2.LE.0)THEN
          IHP='P2  '
          IHP2='    '
          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
          IF(PROP2.LT.0.0 .OR. PROP2.GT.100.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11581)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11592)
11592       FORMAT('      THE PROPORTION FOR TRIMMING/WINSORIZING ',
     1             'ABOVE')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11583)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11594)PROP2
11594       FORMAT('      PARAMETER P2 = LOWER PROPORTION = ',G15.7)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11596)
11596       FORMAT('      USE THE LET COMMAND TO PRE-DEFINE P2 AS IN')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11597)
11597       FORMAT('      LET P2 = 25')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ELSE
            PROP2=VALUE(ILOCP)
          ENDIF
        ENDIF
C
        IF(ICASPL.EQ.'TRIM')GOTO11580
        IF(ICASPL.EQ.'WINM')GOTO11590
        IF(ICASPL.EQ.'WIVA')GOTO12010
        IF(ICASPL.EQ.'WISD')GOTO12030
        IF(ICASPL.EQ.'WICV')GOTO12050
        IF(ICASPL.EQ.'WICR')GOTO12070
        IF(ICASPL.EQ.'WETM')GOTO11660
        IF(ICASPL.EQ.'TMSE')GOTO12150
        IF(ICASPL.EQ.'DTRM')GOTO12210
        IF(ICASPL.EQ.'DWNM')GOTO12220
        IF(ICASPL.EQ.'DWSD')GOTO12320
        IF(ICASPL.EQ.'DWVA')GOTO12330
        IF(ICASPL.EQ.'DTSD')GOTO12590
        IF(ICASPL.EQ.'TRSD')GOTO31710
      ENDIF
C
      IF(ICASPL.EQ.'MIDQ')GOTO11610
      IF(ICASPL.EQ.'1DEC')GOTO11610
      IF(ICASPL.EQ.'2DEC')GOTO11610
      IF(ICASPL.EQ.'3DEC')GOTO11610
      IF(ICASPL.EQ.'4DEC')GOTO11610
      IF(ICASPL.EQ.'5DEC')GOTO11610
      IF(ICASPL.EQ.'6DEC')GOTO11610
      IF(ICASPL.EQ.'7DEC')GOTO11610
      IF(ICASPL.EQ.'8DEC')GOTO11610
      IF(ICASPL.EQ.'9DEC')GOTO11610
C
      IF(ICASPL.EQ.'PERC')GOTO11615
C
      IF(ICASPL.EQ.'WEME')GOTO11620
      IF(ICASPL.EQ.'WOSM')GOTO11625
      IF(ICASPL.EQ.'WEMD')GOTO11630
      IF(ICASPL.EQ.'WESD')GOTO11640
      IF(ICASPL.EQ.'WEVA')GOTO11650
      IF(ICASPL.EQ.'WESK')GOTO11655
      IF(ICASPL.EQ.'WSUM')GOTO11670
      IF(ICASPL.EQ.'WSSQ')GOTO11670
      IF(ICASPL.EQ.'WSAB')GOTO11670
      IF(ICASPL.EQ.'WSDV')GOTO11670
      IF(ICASPL.EQ.'WAAB')GOTO11670
      IF(ICASPL.EQ.'WSSD')GOTO11670
      IF(ICASPL.EQ.'WCOV')GOTO11680
      IF(ICASPL.EQ.'WCOR')GOTO11680
      IF(ICASPL.EQ.'GCOR')GOTO11685
      IF(ICASPL.EQ.'WCDI')GOTO11690
      IF(ICASPL.EQ.'WCSI')GOTO11690
C
      IF(ICASPL.EQ.'VM')GOTO11700
      IF(ICASPL.EQ.'VAME')GOTO11700
C
      IF(ICASPL.EQ.'SIFR')GOTO11710
      IF(ICASPL.EQ.'SIAM')GOTO11720
      IF(ICASPL.EQ.'LIIN')GOTO11730
      IF(ICASPL.EQ.'LIIS')GOTO11735
      IF(ICASPL.EQ.'LISL')GOTO11740
      IF(ICASPL.EQ.'LISS')GOTO11745
      IF(ICASPL.EQ.'LIRE')GOTO11750
      IF(ICASPL.EQ.'LICO')GOTO11760
      IF(ICASPL.EQ.'REPE')GOTO11770
      IF(ICASPL.EQ.'REPR')GOTO11780
      IF(ICASPL.EQ.'CINT')GOTO11790
      IF(ICASPL.EQ.'CSD ')GOTO11795
C
      IF(ICASPL.EQ.'SN0')GOTO11810
      IF(ICASPL.EQ.'SN+')GOTO11810
      IF(ICASPL.EQ.'SN-')GOTO11810
      IF(ICASPL.EQ.'SN00')GOTO11810
C
      IF(ICASPL.EQ.'CP')GOTO11900
      IF(ICASPL.EQ.'CPK')GOTO11900
      IF(ICASPL.EQ.'CNPK')GOTO11900
      IF(ICASPL.EQ.'CPM')GOTO11900
      IF(ICASPL.EQ.'CC')GOTO11900
      IF(ICASPL.EQ.'CPL')GOTO11900
      IF(ICASPL.EQ.'CPU')GOTO11900
      IF(ICASPL.EQ.'NPMK')GOTO11900
      IF(ICASPL.EQ.'CNPM')GOTO11900
      IF(ICASPL.EQ.'CNP')GOTO11900
      IF(ICASPL.EQ.'CPMK')GOTO11900
      IF(ICASPL.EQ.'PEDE')GOTO11900
      IF(ICASPL.EQ.'EXLO')GOTO11900
C
      IF(ICASPL.EQ.'NOPP' .OR. ICASPL.EQ.'NOLO' .OR.
     1   ICASPL.EQ.'NOSC')THEN
        IDIST='NORMAL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'UNPP' .OR. ICASPL.EQ.'UNLO' .OR.
     1   ICASPL.EQ.'UNSC')THEN
        IDIST='UNIFORM'
        GOTO11910
      ELSEIF(ICASPL.EQ.'CAPP' .OR. ICASPL.EQ.'CALO' .OR.
     1   ICASPL.EQ.'CASC')THEN
        IDIST='CAUCHY'
        GOTO11910
      ELSEIF(ICASPL.EQ.'LOPP' .OR. ICASPL.EQ.'LOLO' .OR.
     1   ICASPL.EQ.'LOSC')THEN
        IDIST='LOGISTIC'
        GOTO11910
      ELSEIF(ICASPL.EQ.'DEPP' .OR. ICASPL.EQ.'DELO' .OR.
     1   ICASPL.EQ.'DESC')THEN
        IDIST='DOUBLE EXPONENTIAL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'COPP' .OR. ICASPL.EQ.'COLO' .OR.
     1   ICASPL.EQ.'COSC')THEN
        IDIST='COSINE'
        GOTO11910
      ELSEIF(ICASPL.EQ.'SIPP' .OR. ICASPL.EQ.'SILO' .OR.
     1   ICASPL.EQ.'SISC')THEN
        IDIST='SINE'
        GOTO11910
      ELSEIF(ICASPL.EQ.'ANPP' .OR. ICASPL.EQ.'ANLO' .OR.
     1   ICASPL.EQ.'ANSC')THEN
        IDIST='ANGLIT'
        GOTO11910
      ELSEIF(ICASPL.EQ.'ARPP' .OR. ICASPL.EQ.'ARLO' .OR.
     1   ICASPL.EQ.'ARSC')THEN
        IDIST='ARCSINE'
        GOTO11910
      ELSEIF(ICASPL.EQ.'EXPP' .OR. ICASPL.EQ.'EXLO' .OR.
     1   ICASPL.EQ.'EXSC')THEN
        IDIST='EXPONENTIAL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'HSPP' .OR. ICASPL.EQ.'HSLO' .OR.
     1   ICASPL.EQ.'HSSC')THEN
        IDIST='HYPERBOLIC SECANT'
        GOTO11910
      ELSEIF(ICASPL.EQ.'SLPP' .OR. ICASPL.EQ.'SLLO' .OR.
     1   ICASPL.EQ.'SLSC')THEN
        IDIST='SLASH'
        GOTO11910
      ELSEIF(ICASPL.EQ.'MXPP' .OR. ICASPL.EQ.'MXLO' .OR.
     1   ICASPL.EQ.'MXSC')THEN
        IDIST='MAXWELL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'RAPP' .OR. ICASPL.EQ.'RALO' .OR.
     1   ICASPL.EQ.'RASC')THEN
        IDIST='RAYLEIGH'
        GOTO11910
      ELSEIF(ICASPL.EQ.'HNPP' .OR. ICASPL.EQ.'HNLO' .OR.
     1   ICASPL.EQ.'HNSC')THEN
        IDIST='HALF-NORMAL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'HCPP' .OR. ICASPL.EQ.'HCLO' .OR.
     1   ICASPL.EQ.'HCSC')THEN
        IDIST='HALF-CAUCHY'
        GOTO11910
      ELSEIF(ICASPL.EQ.'SCPP' .OR. ICASPL.EQ.'SCLO' .OR.
     1   ICASPL.EQ.'SCSC')THEN
        IDIST='SEMI-CIRCULAR'
        GOTO11910
      ELSEIF(ICASPL.EQ.'G1PP' .OR. ICASPL.EQ.'G1LO' .OR.
     1   ICASPL.EQ.'G1SC')THEN
        IDIST='MINIMUM GUMBEL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'G2PP' .OR. ICASPL.EQ.'G2LO' .OR.
     1   ICASPL.EQ.'G2SC')THEN
        IDIST='MAXIMUM GUMBEL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'TLPP' .OR. ICASPL.EQ.'TLSH' .OR.
     1       ICASPL.EQ.'TLLO' .OR. ICASPL.EQ.'TLSC')THEN
        IDIST='TUKEY-LAMBDA'
        GOTO11910
      ELSEIF(ICASPL.EQ.'WEPP' .OR. ICASPL.EQ.'WESH' .OR.
     1       ICASPL.EQ.'WELO' .OR. ICASPL.EQ.'WESC')THEN
        IDIST='WEIBULL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'W2PP' .OR. ICASPL.EQ.'W2SH' .OR.
     1       ICASPL.EQ.'W2SC')THEN
        IDIST='2PAR WEIBULL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'LNPP' .OR. ICASPL.EQ.'LNSH' .OR.
     1       ICASPL.EQ.'LNLO' .OR. ICASPL.EQ.'LNSC')THEN
        IDIST='LOGNORMAL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'GPPP' .OR. ICASPL.EQ.'GPSH' .OR.
     1       ICASPL.EQ.'GPLO' .OR. ICASPL.EQ.'GPSC')THEN
        IDIST='GPARETO'
        GOTO11910
      ELSEIF(ICASPL.EQ.'GHPP' .OR. ICASPL.EQ.'GHSH' .OR.
     1       ICASPL.EQ.'GHS2' .OR.
     1       ICASPL.EQ.'GHLO' .OR. ICASPL.EQ.'GHSC')THEN
        IDIST='GH'
        GOTO11910
      ELSEIF(ICASPL.EQ.'GPPC' .OR. ICASPL.EQ.'GSHA' .OR.
     1       ICASPL.EQ.'GLOC' .OR. ICASPL.EQ.'GSCA')THEN
        IDIST='G'
        GOTO11910
      ELSEIF(ICASPL.EQ.'WAPP' .OR. ICASPL.EQ.'WASH' .OR.
     1       ICASPL.EQ.'WALO' .OR. ICASPL.EQ.'WASC')THEN
        IDIST='WALD'
        GOTO11910
      ELSEIF(ICASPL.EQ.'GAPP' .OR. ICASPL.EQ.'GASH' .OR.
     1       ICASPL.EQ.'GALO' .OR. ICASPL.EQ.'GASC')THEN
        IDIST='GAMMA'
        GOTO11910
      ELSEIF(ICASPL.EQ.'IWPP' .OR. ICASPL.EQ.'IWSH' .OR.
     1       ICASPL.EQ.'IWLO' .OR. ICASPL.EQ.'IWSC')THEN
        IDIST='INVERTED WEIBULL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'FLPP' .OR. ICASPL.EQ.'FLSH' .OR.
     1       ICASPL.EQ.'FLLO' .OR. ICASPL.EQ.'FLSC')THEN
        IDIST='FATIGUE LIFE'
        GOTO11910
      ENDIF
C
      IF(ICASPL.EQ.'NOAD' .OR. ICASPL.EQ.'NADL' .OR.
     1   ICASPL.EQ.'NADS')THEN
        IDIST='NORMAL'
        GOTO11915
      ELSEIF(ICASPL.EQ.'EXAD' .OR. ICASPL.EQ.'EADL' .OR.
     1   ICASPL.EQ.'EADS')THEN
        IDIST='EXPONENTIAL'
        GOTO11915
      ELSEIF(ICASPL.EQ.'DXAL' .OR. ICASPL.EQ.'DXAS' .OR.
     1   ICASPL.EQ.'DXAD')THEN
        IDIST='DOUBLE EXPONENTIAL'
        GOTO11915
      ELSEIF(ICASPL.EQ.'GUAL' .OR. ICASPL.EQ.'GUAS' .OR.
     1   ICASPL.EQ.'GUAD')THEN
        IDIST='GUMBEL'
        GOTO11915
      ELSEIF(ICASPL.EQ.'LOAL' .OR. ICASPL.EQ.'LOAS' .OR.
     1   ICASPL.EQ.'LOAD')THEN
        IDIST='LOGISTIC'
        GOTO11915
      ELSEIF(ICASPL.EQ.'UNAL' .OR. ICASPL.EQ.'UNAS' .OR.
     1   ICASPL.EQ.'UNAD')THEN
        IDIST='UNIFORM'
        GOTO11915
      ELSEIF(ICASPL.EQ.'MXAL' .OR. ICASPL.EQ.'MXAS' .OR.
     1   ICASPL.EQ.'MXAD')THEN
        IDIST='MAXWELL'
        GOTO11915
      ELSEIF(ICASPL.EQ.'RAAL' .OR. ICASPL.EQ.'RAAS' .OR.
     1   ICASPL.EQ.'RAAD')THEN
        IDIST='RAYLEIGH'
        GOTO11915
      ELSEIF(ICASPL.EQ.'GAAZ' .OR. ICASPL.EQ.'GAAS' .OR.
     1   ICASPL.EQ.'GAAD')THEN
        IDIST='GAMMA'
        GOTO11915
      ELSEIF(ICASPL.EQ.'WEAZ' .OR. ICASPL.EQ.'WEAS' .OR.
     1   ICASPL.EQ.'WEAD')THEN
        IDIST='WEIBULL'
        GOTO11915
      ELSEIF(ICASPL.EQ.'LNAZ' .OR. ICASPL.EQ.'LNAS' .OR.
     1   ICASPL.EQ.'LNAD')THEN
        IDIST='LOGNORMAL'
        GOTO11915
      ELSEIF(ICASPL.EQ.'FLAZ' .OR. ICASPL.EQ.'FLAS' .OR.
     1   ICASPL.EQ.'FLAD')THEN
        IDIST='FATIGUE LIFE'
        GOTO11915
      ELSEIF(ICASPL.EQ.'FRAZ' .OR. ICASPL.EQ.'FRAS' .OR.
     1   ICASPL.EQ.'FRAD')THEN
        IDIST='FRECHET'
        GOTO11915
      ELSEIF(ICASPL.EQ.'LXAZ' .OR. ICASPL.EQ.'LXAS' .OR.
     1   ICASPL.EQ.'LXAD')THEN
        IDIST='LOGISTIC EXPONENTIAL'
        GOTO11915
      ELSEIF(ICASPL.EQ.'IGAZ' .OR. ICASPL.EQ.'IGAS' .OR.
     1   ICASPL.EQ.'IGAD')THEN
        IDIST='INVERTED GAMMA'
        GOTO11915
      ELSEIF(ICASPL.EQ.'B1AZ' .OR. ICASPL.EQ.'B1AS' .OR.
     1   ICASPL.EQ.'B1AD')THEN
        IDIST='BURR TYPE 10'
        GOTO11915
      ELSEIF(ICASPL.EQ.'GEAZ' .OR. ICASPL.EQ.'GEAS' .OR.
     1   ICASPL.EQ.'GEAD')THEN
        IDIST='GEOMETRIC EXTR EXPO'
        GOTO11915
      ENDIF
C
      IF(ICASPL.EQ.'BCPP')GOTO11920
      IF(ICASPL.EQ.'BCLA')GOTO11920
C
      IF(ICASPL.EQ.'EXTR')GOTO11933
      IF(ICASPL.EQ.'AAD ')GOTO11935
      IF(ICASPL.EQ.'AADM')GOTO11938
      IF(ICASPL.EQ.'MAD ')GOTO11940
      IF(ICASPL.EQ.'MADN')GOTO11940
      IF(ICASPL.EQ.'GEME')GOTO11950
      IF(ICASPL.EQ.'GESD')GOTO11960
      IF(ICASPL.EQ.'HAME')GOTO11970
      IF(ICASPL.EQ.'IQRA')GOTO11980
      IF(ICASPL.EQ.'NIQR')GOTO11980
      IF(ICASPL.EQ.'SIQL')GOTO11980
      IF(ICASPL.EQ.'SIQU')GOTO11980
      IF(ICASPL.EQ.'QCDI')GOTO11981
      IF(ICASPL.EQ.'QQRA')GOTO11982
      IF(ICASPL.EQ.'DQDI')GOTO11983
      IF(ICASPL.EQ.'BILO')GOTO11990
      IF(ICASPL.EQ.'BISC')GOTO12000
      IF(ICASPL.EQ.'BIMV')GOTO12090
      IF(ICASPL.EQ.'BIMC')GOTO12100
C
      IF(ICASPL.EQ.'PBMV' .OR. ICASPL.EQ.'PBCR' .OR.
     1   ICASPL.EQ.'DPBN')THEN
C
        IHP='BETA'
        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)
        IF(IERROR.EQ.'YES')THEN
          BETA=0.1
        ELSE
          BETA=VALUE(ILOCP)
        ENDIF
C
        IF(ICASPL.EQ.'PBMV')GOTO12110
        IF(ICASPL.EQ.'PBCR')GOTO12115
        IF(ICASPL.EQ.'DPBN')GOTO12360
      ENDIF
C
      IF(ICASPL.EQ.'HLEH')GOTO12120
      IF(ICASPL.EQ.'QUAN')GOTO12130
      IF(ICASPL.EQ.'DRAT')GOTO12135
      IF(ICASPL.EQ.'QUSE')GOTO12140
      IF(ICASPL.EQ.'BICR')GOTO12160
      IF(ICASPL.EQ.'CDIG')GOTO12172
      IF(ICASPL.EQ.'NCDI')GOTO12174
      IF(ICASPL.EQ.'SNSC')GOTO12176
      IF(ICASPL.EQ.'QNSC')GOTO12178
C
      IF(ICASPL.EQ.'LPME' .OR. ICASPL.EQ.'LPVA' .OR.
     1   ICASPL.EQ.'LPSD' .OR. ICASPL.EQ.'DLPL' .OR.
     1   ICASPL.EQ.'DLPV' .OR. ICASPL.EQ.'DLPS')THEN
C
        IHP='P   '
        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)
        IF(IERROR.EQ.'YES')THEN
          P=1.5
        ELSE
          P=VALUE(ILOCP)
        ENDIF
C
        IF(ICASPL.EQ.'LPME')GOTO31720
        IF(ICASPL.EQ.'LPVA')GOTO31730
        IF(ICASPL.EQ.'LPSD')GOTO31740
        IF(ICASPL.EQ.'DLPL')GOTO12540
        IF(ICASPL.EQ.'DLPV')GOTO12550
        IF(ICASPL.EQ.'DLPS')GOTO12560
      ENDIF
C
      IF(ICASPL.EQ.'BPRO')GOTO31750
      IF(ICASPL.EQ.'BPLC')GOTO31750
      IF(ICASPL.EQ.'BPUC')GOTO31750
      IF(ICASPL.EQ.'BPRC')GOTO31750
      IF(ICASPL.EQ.'GRUB')GOTO31790
      IF(ICASPL.EQ.'GCDF')GOTO31795
      IF(ICASPL.EQ.'GDIR')GOTO31810
      IF(ICASPL.EQ.'GIND')GOTO31820
      IF(ICASPL.EQ.'DCDF')GOTO31825
      IF(ICASPL.EQ.'DPVA')GOTO31825
      IF(ICASPL.EQ.'DMNI')GOTO31825
      IF(ICASPL.EQ.'DMXI')GOTO31825
      IF(ICASPL.EQ.'DACV')GOTO31825
      IF(ICASPL.EQ.'DAVI')GOTO31825
      IF(ICASPL.EQ.'SOCD')GOTO31828
      IF(ICASPL.EQ.'SOCV')GOTO31828
      IF(ICASPL.EQ.'SOPV')GOTO31828
      IF(ICASPL.EQ.'SOIN')GOTO31828
      IF(ICASPL.EQ.'SOUT')GOTO31828
      IF(ICASPL.EQ.'KOCD')GOTO31829
      IF(ICASPL.EQ.'KOCV')GOTO31829
      IF(ICASPL.EQ.'KOPV')GOTO31829
      IF(ICASPL.EQ.'KOIN')GOTO31829
      IF(ICASPL.EQ.'KOUT')GOTO31829
      IF(ICASPL.EQ.'1TTE')GOTO31830
      IF(ICASPL.EQ.'1TCD')GOTO31830
      IF(ICASPL.EQ.'1T2P')GOTO31830
      IF(ICASPL.EQ.'1TLP')GOTO31830
      IF(ICASPL.EQ.'1TUP')GOTO31830
      IF(ICASPL.EQ.'2TTE')GOTO31840
      IF(ICASPL.EQ.'2TCD')GOTO31840
      IF(ICASPL.EQ.'2T2P')GOTO31840
      IF(ICASPL.EQ.'2TLP')GOTO31840
      IF(ICASPL.EQ.'2TUP')GOTO31840
      IF(ICASPL.EQ.'PTTE')GOTO31845
      IF(ICASPL.EQ.'PTCD')GOTO31845
      IF(ICASPL.EQ.'PT2P')GOTO31845
      IF(ICASPL.EQ.'PTLP')GOTO31845
      IF(ICASPL.EQ.'PTUP')GOTO31845
      IF(ICASPL.EQ.'CSSD')GOTO31850
      IF(ICASPL.EQ.'CCDF')GOTO31850
      IF(ICASPL.EQ.'CS2P')GOTO31850
      IF(ICASPL.EQ.'CSLP')GOTO31850
      IF(ICASPL.EQ.'CSUP')GOTO31850
      IF(ICASPL.EQ.'FRET')GOTO31870
      IF(ICASPL.EQ.'FRCD')GOTO31880
      IF(ICASPL.EQ.'FBLO')GOTO31890
      IF(ICASPL.EQ.'FBCD')GOTO31900
      IF(ICASPL.EQ.'H10L')GOTO31910
      IF(ICASPL.EQ.'H12L')GOTO31920
      IF(ICASPL.EQ.'H15L')GOTO31930
      IF(ICASPL.EQ.'H17L')GOTO31940
      IF(ICASPL.EQ.'H20L')GOTO31950
      IF(ICASPL.EQ.'H10S')GOTO31960
      IF(ICASPL.EQ.'H12S')GOTO31970
      IF(ICASPL.EQ.'H15S')GOTO31980
      IF(ICASPL.EQ.'H17S')GOTO31990
      IF(ICASPL.EQ.'H20S')GOTO32000
      IF(ICASPL.EQ.'TM2S')GOTO32010
      IF(ICASPL.EQ.'TMMN')GOTO32010
      IF(ICASPL.EQ.'TMMX')GOTO32010
      IF(ICASPL.EQ.'ESD ')GOTO32020
      IF(ICASPL.EQ.'DI2S')GOTO32030
      IF(ICASPL.EQ.'DIMN')GOTO32030
      IF(ICASPL.EQ.'DIMX')GOTO32030
      IF(ICASPL.EQ.'1LAC')GOTO32040
      IF(ICASPL.EQ.'1UAC')GOTO32040
      IF(ICASPL.EQ.'2LAC')GOTO32040
      IF(ICASPL.EQ.'2UAC')GOTO32040
      IF(ICASPL.EQ.'1LEB')GOTO32050
      IF(ICASPL.EQ.'1UEB')GOTO32050
      IF(ICASPL.EQ.'2LEB')GOTO32050
      IF(ICASPL.EQ.'2UEB')GOTO32050
      IF(ICASPL.EQ.'ADKS')GOTO32060
      IF(ICASPL.EQ.'ADKC')GOTO32060
      IF(ICASPL.EQ.'KS2S')GOTO33100
      IF(ICASPL.EQ.'KSCV')GOTO33100
      IF(ICASPL.EQ.'CS2S')GOTO33105
      IF(ICASPL.EQ.'CC2S')GOTO33105
      IF(ICASPL.EQ.'CP2S')GOTO33105
      IF(ICASPL.EQ.'WSHA')GOTO33110
      IF(ICASPL.EQ.'WSPV')GOTO33110
      IF(ICASPL.EQ.'CSFT')GOTO33120
      IF(ICASPL.EQ.'CSFP')GOTO33120
      IF(ICASPL.EQ.'CSBT')GOTO33120
      IF(ICASPL.EQ.'CSBP')GOTO33120
      IF(ICASPL.EQ.'1LNT')GOTO33130
      IF(ICASPL.EQ.'1UNT')GOTO33130
      IF(ICASPL.EQ.'1KNT')GOTO33130
      IF(ICASPL.EQ.'2LNT')GOTO33130
      IF(ICASPL.EQ.'2UNT')GOTO33130
      IF(ICASPL.EQ.'2KNT')GOTO33130
      IF(ICASPL.EQ.'FTCD')GOTO33140
      IF(ICASPL.EQ.'FTPV')GOTO33140
      IF(ICASPL.EQ.'FTES')GOTO33140
      IF(ICASPL.EQ.'1STE')GOTO33150
      IF(ICASPL.EQ.'1SCD')GOTO33150
      IF(ICASPL.EQ.'1S2P')GOTO33150
      IF(ICASPL.EQ.'1SLP')GOTO33150
      IF(ICASPL.EQ.'1SUP')GOTO33150
      IF(ICASPL.EQ.'2STE')GOTO33160
      IF(ICASPL.EQ.'2SCD')GOTO33160
      IF(ICASPL.EQ.'2S2P')GOTO33160
      IF(ICASPL.EQ.'2SLP')GOTO33160
      IF(ICASPL.EQ.'2SUP')GOTO33160
      IF(ICASPL.EQ.'2SFR')GOTO33165
      IF(ICASPL.EQ.'2F2P')GOTO33165
      IF(ICASPL.EQ.'2F1P')GOTO33165
      IF(ICASPL.EQ.'WABA')GOTO33170
      IF(ICASPL.EQ.'WBBA')GOTO33170
      IF(ICASPL.EQ.'LABA')GOTO33170
      IF(ICASPL.EQ.'LBBA')GOTO33170
      IF(ICASPL.EQ.'NABA')GOTO33170
      IF(ICASPL.EQ.'NBBA')GOTO33170
      IF(ICASPL.EQ.'ZABA')GOTO33170
      IF(ICASPL.EQ.'ZBBA')GOTO33170
      IF(ICASPL.EQ.'1WTE')GOTO34000
      IF(ICASPL.EQ.'1WCD')GOTO34000
      IF(ICASPL.EQ.'1W2P')GOTO34000
      IF(ICASPL.EQ.'1WLP')GOTO34000
      IF(ICASPL.EQ.'1WUP')GOTO34000
      IF(ICASPL.EQ.'2WTE')GOTO34010
      IF(ICASPL.EQ.'2WCD')GOTO34010
      IF(ICASPL.EQ.'2W2P')GOTO34010
      IF(ICASPL.EQ.'2WLP')GOTO34010
      IF(ICASPL.EQ.'2WUP')GOTO34010
      IF(ICASPL.EQ.'MWTE')GOTO34020
      IF(ICASPL.EQ.'MWCD')GOTO34020
      IF(ICASPL.EQ.'MW2P')GOTO34020
      IF(ICASPL.EQ.'MWLP')GOTO34020
      IF(ICASPL.EQ.'MWUP')GOTO34020
      IF(ICASPL.EQ.'MWUS')GOTO34020
      IF(ICASPL.EQ.'KLTE')GOTO34030
      IF(ICASPL.EQ.'KLCD')GOTO34030
      IF(ICASPL.EQ.'KL2P')GOTO34030
      IF(ICASPL.EQ.'KLLP')GOTO34030
      IF(ICASPL.EQ.'KLUP')GOTO34030
      IF(ICASPL.EQ.'KWTE')GOTO34035
      IF(ICASPL.EQ.'KWCD')GOTO34035
      IF(ICASPL.EQ.'KW2P')GOTO34035
      IF(ICASPL.EQ.'SRTE')GOTO34040
      IF(ICASPL.EQ.'SRCD')GOTO34040
      IF(ICASPL.EQ.'SR2P')GOTO34040
      IF(ICASPL.EQ.'SRLP')GOTO34040
      IF(ICASPL.EQ.'SRUP')GOTO34040
      IF(ICASPL.EQ.'METE')GOTO34050
      IF(ICASPL.EQ.'MECD')GOTO34050
      IF(ICASPL.EQ.'ME2P')GOTO34050
      IF(ICASPL.EQ.'FZTE')GOTO34060
      IF(ICASPL.EQ.'FZCD')GOTO34060
      IF(ICASPL.EQ.'FZ2P')GOTO34060
      IF(ICASPL.EQ.'QUTE')GOTO34070
      IF(ICASPL.EQ.'QUCD')GOTO34070
      IF(ICASPL.EQ.'QU2P')GOTO34070
      IF(ICASPL.EQ.'FMAT')GOTO34080
      IF(ICASPL.EQ.'LMAT')GOTO34080
      IF(ICASPL.EQ.'FNOM')GOTO34080
      IF(ICASPL.EQ.'LNOM')GOTO34080
      IF(ICASPL.EQ.'SHDI')GOTO34090
      IF(ICASPL.EQ.'SHEI')GOTO34090
      IF(ICASPL.EQ.'SINR')GOTO34095
      IF(ICASPL.EQ.'SEIR')GOTO34095
      IF(ICASPL.EQ.'SIDI')GOTO34100
      IF(ICASPL.EQ.'SDIR')GOTO34105
      IF(ICASPL.EQ.'JABE')GOTO34110
      IF(ICASPL.EQ.'JAPV')GOTO34110
      IF(ICASPL.EQ.'JACD')GOTO34110
      IF(ICASPL.EQ.'LCL ')GOTO34120
      IF(ICASPL.EQ.'UCL ')GOTO34120
      IF(ICASPL.EQ.'1LCL')GOTO34120
      IF(ICASPL.EQ.'1UCL')GOTO34120
      IF(ICASPL.EQ.'SLCL')GOTO34120
      IF(ICASPL.EQ.'SUCL')GOTO34120
      IF(ICASPL.EQ.'SLC1')GOTO34120
      IF(ICASPL.EQ.'SUC1')GOTO34120
      IF(ICASPL.EQ.'LPL ')GOTO34130
      IF(ICASPL.EQ.'UPL ')GOTO34130
      IF(ICASPL.EQ.'1LPL')GOTO34130
      IF(ICASPL.EQ.'1UPL')GOTO34130
      IF(ICASPL.EQ.'LPB ')GOTO34130
      IF(ICASPL.EQ.'UPB ')GOTO34130
      IF(ICASPL.EQ.'1LPB')GOTO34130
      IF(ICASPL.EQ.'1UPB')GOTO34130
      IF(ICASPL.EQ.'SLPL')GOTO34130
      IF(ICASPL.EQ.'SUPL')GOTO34130
      IF(ICASPL.EQ.'SLP1')GOTO34130
      IF(ICASPL.EQ.'SUP1')GOTO34130
      IF(ICASPL.EQ.'SLPB')GOTO34130
      IF(ICASPL.EQ.'SUPB')GOTO34130
      IF(ICASPL.EQ.'SLB1')GOTO34130
      IF(ICASPL.EQ.'SUB1')GOTO34130
      IF(ICASPL.EQ.'SUS1')GOTO34130
      IF(ICASPL.EQ.'SLS1')GOTO34130
      IF(ICASPL.EQ.'SUS2')GOTO34130
      IF(ICASPL.EQ.'SLS2')GOTO34130
      IF(ICASPL.EQ.'UPS1')GOTO34130
      IF(ICASPL.EQ.'LPS1')GOTO34130
      IF(ICASPL.EQ.'UPS2')GOTO34130
      IF(ICASPL.EQ.'LPS2')GOTO34130
      IF(ICASPL.EQ.'UCS1')GOTO34140
      IF(ICASPL.EQ.'LCS1')GOTO34140
      IF(ICASPL.EQ.'UCS2')GOTO34140
      IF(ICASPL.EQ.'LCS2')GOTO34140
      IF(ICASPL.EQ.'SLZ1')GOTO34140
      IF(ICASPL.EQ.'SUZ1')GOTO34140
      IF(ICASPL.EQ.'SLZ2')GOTO34140
      IF(ICASPL.EQ.'SUZ2')GOTO34140
      IF(ICASPL.EQ.'BLSD')GOTO34145
      IF(ICASPL.EQ.'BUSD')GOTO34145
      IF(ICASPL.EQ.'MWLT')GOTO34150
      IF(ICASPL.EQ.'MWLC')GOTO34150
      IF(ICASPL.EQ.'MWPV')GOTO34150
      IF(ICASPL.EQ.'MW50')GOTO34150
      IF(ICASPL.EQ.'MW90')GOTO34150
      IF(ICASPL.EQ.'MW95')GOTO34150
      IF(ICASPL.EQ.'PDTE')GOTO34160
      IF(ICASPL.EQ.'PDCD')GOTO34160
      IF(ICASPL.EQ.'PDPV')GOTO34160
      IF(ICASPL.EQ.'GPDT')GOTO34170
      IF(ICASPL.EQ.'GPDC')GOTO34170
      IF(ICASPL.EQ.'GPDP')GOTO34170
      IF(ICASPL.EQ.'BCVM')GOTO34180
      IF(ICASPL.EQ.'BC95')GOTO34180
      IF(ICASPL.EQ.'BC05')GOTO34180
      IF(ICASPL.EQ.'MNNC')GOTO34190
      IF(ICASPL.EQ.'MNND')GOTO34190
      IF(ICASPL.EQ.'MNNP')GOTO34190
      IF(ICASPL.EQ.'PO1P')GOTO34200
      IF(ICASPL.EQ.'PO1C')GOTO34200
      IF(ICASPL.EQ.'POL1')GOTO34200
      IF(ICASPL.EQ.'PO2P')GOTO34200
      IF(ICASPL.EQ.'PO2C')GOTO34200
      IF(ICASPL.EQ.'POL2')GOTO34200
      IF(ICASPL.EQ.'PO3P')GOTO34200
      IF(ICASPL.EQ.'PO3C')GOTO34200
      IF(ICASPL.EQ.'POL3')GOTO34200
      IF(ICASPL.EQ.'PO4P')GOTO34200
      IF(ICASPL.EQ.'PO4C')GOTO34200
      IF(ICASPL.EQ.'POL4')GOTO34200
      IF(ICASPL.EQ.'PO5P')GOTO34200
      IF(ICASPL.EQ.'PO5C')GOTO34200
      IF(ICASPL.EQ.'POL5')GOTO34200
      IF(ICASPL.EQ.'VALC')GOTO34210
      IF(ICASPL.EQ.'VDIS')GOTO34220
      IF(ICASPL.EQ.'RDI ')GOTO34220
      IF(ICASPL.EQ.'UCHS')GOTO34220
      IF(ICASPL.EQ.'WSCD')GOTO34230
      IF(ICASPL.EQ.'WSHP')GOTO34230
      IF(ICASPL.EQ.'WSHT')GOTO34230
      IF(ICASPL.EQ.'WS90')GOTO34230
      IF(ICASPL.EQ.'WS95')GOTO34230
      IF(ICASPL.EQ.'WS99')GOTO34230
      IF(ICASPL.EQ.'KAPR')GOTO34240
      IF(ICASPL.EQ.'KARC')GOTO34240
      IF(ICASPL.EQ.'CVOT')GOTO34260
      IF(ICASPL.EQ.'CV95')GOTO34260
      IF(ICASPL.EQ.'CV99')GOTO34260
      IF(ICASPL.EQ.'CVCD')GOTO34260
      IF(ICASPL.EQ.'CVPV')GOTO34260
      IF(ICASPL.EQ.'CV05')GOTO34260
      IF(ICASPL.EQ.'CV01')GOTO34260
      IF(ICASPL.EQ.'CMVC')GOTO34260
      IF(ICASPL.EQ.'CMVP')GOTO34260
      IF(ICASPL.EQ.'CVMO')GOTO34260
      IF(ICASPL.EQ.'ESCD')GOTO34270
      IF(ICASPL.EQ.'ESCV')GOTO34270
      IF(ICASPL.EQ.'ESPV')GOTO34270
      IF(ICASPL.EQ.'ESP1')GOTO34270
      IF(ICASPL.EQ.'ESLO')GOTO34270
      IF(ICASPL.EQ.'DSLA' .AND. NUMV2.EQ.3)GOTO32100
      IF(ICASPL.EQ.'DHHD' .AND. NUMV2.EQ.3)GOTO32100
      IF(ICASPL.EQ.'DSMM' .AND. NUMV2.EQ.3)GOTO32100
      IF(ICASPL.EQ.'DSSE' .AND. NUMV2.EQ.3)GOTO32100
      IF(ICASPL.EQ.'MPAU' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'MPSE' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'MMPA' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'MMPS' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'VARU' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'VRSE' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'BOB ' .AND. NUMV2.EQ.3)GOTO32300
      IF(ICASPL.EQ.'BOBS' .AND. NUMV2.EQ.3)GOTO32300
      IF(ICASPL.EQ.'GCIN' .AND. NUMV2.EQ.3)GOTO32400
      IF(ICASPL.EQ.'GCIS' .AND. NUMV2.EQ.3)GOTO32400
      IF(ICASPL.EQ.'BCP ' .AND. NUMV2.EQ.3)GOTO32500
      IF(ICASPL.EQ.'BCPS' .AND. NUMV2.EQ.3)GOTO32500
      IF(ICASPL.EQ.'MMEA' .AND. NUMV2.EQ.3)GOTO32600
      IF(ICASPL.EQ.'MMES' .AND. NUMV2.EQ.3)GOTO32600
      IF(ICASPL.EQ.'FAIR' .AND. NUMV2.EQ.3)GOTO32700
      IF(ICASPL.EQ.'FWSE' .AND. NUMV2.EQ.3)GOTO32700
      IF(ICASPL.EQ.'GDEA' .AND. NUMV2.EQ.3)GOTO32800
      IF(ICASPL.EQ.'GDSE' .AND. NUMV2.EQ.3)GOTO32800
      IF(ICASPL.EQ.'GDSN' .AND. NUMV2.EQ.3)GOTO32800
      IF(ICASPL.EQ.'GDZ1' .AND. NUMV2.EQ.3)GOTO32800
      IF(ICASPL.EQ.'GDZ2' .AND. NUMV2.EQ.3)GOTO32800
      IF(ICASPL.EQ.'SCEB' .AND. NUMV2.EQ.3)GOTO32900
      IF(ICASPL.EQ.'SESE' .AND. NUMV2.EQ.3)GOTO32900
      IF(ICASPL.EQ.'DSLA' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'DHHD' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'DSMM' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'DSSE' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MPAU' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MPSE' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MMPA' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MMPS' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'VARU' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'VRSE' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'BOB ' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'BOBS' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GCIN' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GCIS' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'BCP ' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'BCPS' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MMEA' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MMES' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'FAIR' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'FWSE' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GDEA' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GDSE' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GDSN' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GDZ1' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GDZ2' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'SCEB' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'SESE' .AND. NUMV2.EQ.2)GOTO32070
C
      IF(ICASPL.EQ.'DMEA')GOTO12180
      IF(ICASPL.EQ.'HEDG')GOTO12182
      IF(ICASPL.EQ.'BCHG')GOTO12182
      IF(ICASPL.EQ.'HESE')GOTO12182
      IF(ICASPL.EQ.'HELC')GOTO12182
      IF(ICASPL.EQ.'HEUC')GOTO12182
      IF(ICASPL.EQ.'COHD')GOTO12182
      IF(ICASPL.EQ.'GLAS')GOTO12182
      IF(ICASPL.EQ.'DMDM')GOTO12190
      IF(ICASPL.EQ.'DMED')GOTO12200
      IF(ICASPL.EQ.'DGEO')GOTO12230
      IF(ICASPL.EQ.'DHAR')GOTO12240
      IF(ICASPL.EQ.'DHDL')GOTO12250
      IF(ICASPL.EQ.'DBIW')GOTO12260
      IF(ICASPL.EQ.'DSD ')GOTO12270
      IF(ICASPL.EQ.'DRMS ')GOTO12275
      IF(ICASPL.EQ.'DVAR')GOTO12280
      IF(ICASPL.EQ.'DPRE')GOTO12282
      IF(ICASPL.EQ.'DSNR')GOTO12284
      IF(ICASPL.EQ.'DAAD')GOTO12290
      IF(ICASPL.EQ.'DAAM')GOTO12295
      IF(ICASPL.EQ.'DMAD')GOTO12300
      IF(ICASPL.EQ.'DMAN')GOTO12300
      IF(ICASPL.EQ.'DIQR')GOTO12310
      IF(ICASPL.EQ.'DNIQ')GOTO12310
      IF(ICASPL.EQ.'DBIM')GOTO12340
      IF(ICASPL.EQ.'DBIS')GOTO12350
      IF(ICASPL.EQ.'DGSD')GOTO12370
      IF(ICASPL.EQ.'DRAN')GOTO12380
C
      IF(ICASPL.EQ.'EXTR')GOTO11933
      IF(ICASPL.EQ.'AAD ')GOTO11935
      IF(ICASPL.EQ.'MAD ')GOTO11940
      IF(ICASPL.EQ.'MADN')GOTO11940
      IF(ICASPL.EQ.'GEME')GOTO11950
      IF(ICASPL.EQ.'GESD')GOTO11960
      IF(ICASPL.EQ.'HAME')GOTO11970
      IF(ICASPL.EQ.'IQRA')GOTO11980
      IF(ICASPL.EQ.'NIQR')GOTO11980
      IF(ICASPL.EQ.'SIQL')GOTO11980
      IF(ICASPL.EQ.'SIQU')GOTO11980
      IF(ICASPL.EQ.'QQRA')GOTO11982
      IF(ICASPL.EQ.'BILO')GOTO11990
      IF(ICASPL.EQ.'BISC')GOTO12000
      IF(ICASPL.EQ.'BIMV')GOTO12090
      IF(ICASPL.EQ.'BIMC')GOTO12100
C
      IF(ICASPL.EQ.'PBMV' .OR. ICASPL.EQ.'PBCR' .OR.
     1   ICASPL.EQ.'DPBN')THEN
C
        IHP='BETA'
        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)
        IF(IERROR.EQ.'YES')THEN
          BETA=0.1
        ELSE
          BETA=VALUE(ILOCP)
        ENDIF
C
        IF(ICASPL.EQ.'PBMV')GOTO12110
        IF(ICASPL.EQ.'PBCR')GOTO12115
        IF(ICASPL.EQ.'DPBN')GOTO12360
      ENDIF
C
      IF(ICASPL.EQ.'HLEH')GOTO12120
      IF(ICASPL.EQ.'QUAN')GOTO12130
      IF(ICASPL.EQ.'QUSE')GOTO12140
      IF(ICASPL.EQ.'BICR')GOTO12160
      IF(ICASPL.EQ.'CDIG')GOTO12172
      IF(ICASPL.EQ.'NCDI')GOTO12174
      IF(ICASPL.EQ.'SNSC')GOTO12176
      IF(ICASPL.EQ.'QNSC')GOTO12178
C
      IF(ICASPL.EQ.'LPME' .OR. ICASPL.EQ.'LPVA' .OR.
     1   ICASPL.EQ.'LPSD' .OR. ICASPL.EQ.'DLPL' .OR.
     1   ICASPL.EQ.'DLPV' .OR. ICASPL.EQ.'DLPS')THEN
C
        IHP='P   '
        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)
        IF(IERROR.EQ.'YES')THEN
          P=1.5
        ELSE
          P=VALUE(ILOCP)
        ENDIF
C
        IF(ICASPL.EQ.'LPME')GOTO31720
        IF(ICASPL.EQ.'LPVA')GOTO31730
        IF(ICASPL.EQ.'LPSD')GOTO31740
        IF(ICASPL.EQ.'DLPL')GOTO12540
        IF(ICASPL.EQ.'DLPV')GOTO12550
        IF(ICASPL.EQ.'DLPS')GOTO12560
      ENDIF
C
      IF(ICASPL.EQ.'BPRO')GOTO31750
      IF(ICASPL.EQ.'BPRC')GOTO31750
      IF(ICASPL.EQ.'GRUB')GOTO31790
      IF(ICASPL.EQ.'GCDF')GOTO31795
      IF(ICASPL.EQ.'GDIR')GOTO31810
      IF(ICASPL.EQ.'GIND')GOTO31820
      IF(ICASPL.EQ.'1TTE')GOTO31830
      IF(ICASPL.EQ.'1TCD')GOTO31830
      IF(ICASPL.EQ.'1T2P')GOTO31830
      IF(ICASPL.EQ.'1TLP')GOTO31830
      IF(ICASPL.EQ.'1TUP')GOTO31830
      IF(ICASPL.EQ.'2TTE')GOTO31840
      IF(ICASPL.EQ.'2TCD')GOTO31840
      IF(ICASPL.EQ.'2T2P')GOTO31840
      IF(ICASPL.EQ.'2TLP')GOTO31840
      IF(ICASPL.EQ.'2TUP')GOTO31840
      IF(ICASPL.EQ.'PTTE')GOTO31845
      IF(ICASPL.EQ.'PTCD')GOTO31845
      IF(ICASPL.EQ.'PT2P')GOTO31845
      IF(ICASPL.EQ.'PTLP')GOTO31845
      IF(ICASPL.EQ.'PTUP')GOTO31845
      IF(ICASPL.EQ.'CSSD')GOTO31850
      IF(ICASPL.EQ.'CCDF')GOTO31850
      IF(ICASPL.EQ.'CS2P')GOTO31850
      IF(ICASPL.EQ.'CSLP')GOTO31850
      IF(ICASPL.EQ.'CSUP')GOTO31850
      IF(ICASPL.EQ.'FRET')GOTO31870
      IF(ICASPL.EQ.'FRCD')GOTO31880
      IF(ICASPL.EQ.'FBLO')GOTO31890
      IF(ICASPL.EQ.'FBCD')GOTO31900
      IF(ICASPL.EQ.'MSDT')GOTO31905
      IF(ICASPL.EQ.'MSDN')GOTO31905
      IF(ICASPL.EQ.'MSDC')GOTO31905
      IF(ICASPL.EQ.'MSDP')GOTO31905
      IF(ICASPL.EQ.'ADRA')GOTO31905
      IF(ICASPL.EQ.'ADCD')GOTO31905
      IF(ICASPL.EQ.'ADPV')GOTO31905
      IF(ICASPL.EQ.'AD01')GOTO31905
      IF(ICASPL.EQ.'AD05')GOTO31905
      IF(ICASPL.EQ.'AD95')GOTO31905
      IF(ICASPL.EQ.'AD99')GOTO31905
      IF(ICASPL.EQ.'H10L')GOTO31910
      IF(ICASPL.EQ.'H12L')GOTO31920
      IF(ICASPL.EQ.'H15L')GOTO31930
      IF(ICASPL.EQ.'H17L')GOTO31940
      IF(ICASPL.EQ.'H20L')GOTO31950
      IF(ICASPL.EQ.'H10S')GOTO31960
      IF(ICASPL.EQ.'H12S')GOTO31970
      IF(ICASPL.EQ.'H15S')GOTO31980
      IF(ICASPL.EQ.'H17S')GOTO31990
      IF(ICASPL.EQ.'H20S')GOTO32000
      IF(ICASPL.EQ.'TM2S')GOTO32010
      IF(ICASPL.EQ.'TMMN')GOTO32010
      IF(ICASPL.EQ.'TMMX')GOTO32010
      IF(ICASPL.EQ.'ESD ')GOTO32020
      IF(ICASPL.EQ.'DI2S')GOTO32030
      IF(ICASPL.EQ.'DIMN')GOTO32030
      IF(ICASPL.EQ.'DIMX')GOTO32030
      IF(ICASPL.EQ.'1LAC')GOTO32040
      IF(ICASPL.EQ.'1UAC')GOTO32040
      IF(ICASPL.EQ.'2LAC')GOTO32040
      IF(ICASPL.EQ.'2UAC')GOTO32040
      IF(ICASPL.EQ.'1LEB')GOTO32050
      IF(ICASPL.EQ.'1UEB')GOTO32050
      IF(ICASPL.EQ.'2LEB')GOTO32050
      IF(ICASPL.EQ.'2UEB')GOTO32050
      IF(ICASPL.EQ.'ADKS')GOTO32060
      IF(ICASPL.EQ.'ADKC')GOTO32060
      IF(ICASPL.EQ.'KS2S')GOTO33100
      IF(ICASPL.EQ.'KSCV')GOTO33100
      IF(ICASPL.EQ.'CS2S')GOTO33105
      IF(ICASPL.EQ.'CC2S')GOTO33105
      IF(ICASPL.EQ.'CP2S')GOTO33105
      IF(ICASPL.EQ.'WSHA')GOTO33110
      IF(ICASPL.EQ.'WSPV')GOTO33110
      IF(ICASPL.EQ.'CSFT')GOTO33120
      IF(ICASPL.EQ.'CSFP')GOTO33120
      IF(ICASPL.EQ.'CSBT')GOTO33120
      IF(ICASPL.EQ.'CSBP')GOTO33120
      IF(ICASPL.EQ.'1LNT')GOTO33130
      IF(ICASPL.EQ.'1UNT')GOTO33130
      IF(ICASPL.EQ.'1KNT')GOTO33130
      IF(ICASPL.EQ.'2LNT')GOTO33130
      IF(ICASPL.EQ.'2UNT')GOTO33130
      IF(ICASPL.EQ.'2KNT')GOTO33130
      IF(ICASPL.EQ.'FTCD')GOTO33140
      IF(ICASPL.EQ.'FTPV')GOTO33140
      IF(ICASPL.EQ.'FTES')GOTO33140
      IF(ICASPL.EQ.'1STE')GOTO33150
      IF(ICASPL.EQ.'1SCD')GOTO33150
      IF(ICASPL.EQ.'1S2P')GOTO33150
      IF(ICASPL.EQ.'1SLP')GOTO33150
      IF(ICASPL.EQ.'1SUP')GOTO33150
      IF(ICASPL.EQ.'2STE')GOTO33160
      IF(ICASPL.EQ.'2SCD')GOTO33160
      IF(ICASPL.EQ.'2S2P')GOTO33160
      IF(ICASPL.EQ.'2SLP')GOTO33160
      IF(ICASPL.EQ.'2SUP')GOTO33160
      IF(ICASPL.EQ.'2SFR')GOTO33165
      IF(ICASPL.EQ.'2F2P')GOTO33165
      IF(ICASPL.EQ.'2F1P')GOTO33165
      IF(ICASPL.EQ.'WABA')GOTO33170
      IF(ICASPL.EQ.'WBBA')GOTO33170
      IF(ICASPL.EQ.'LABA')GOTO33170
      IF(ICASPL.EQ.'LBBA')GOTO33170
      IF(ICASPL.EQ.'NABA')GOTO33170
      IF(ICASPL.EQ.'NBBA')GOTO33170
      IF(ICASPL.EQ.'ZABA')GOTO33170
      IF(ICASPL.EQ.'ZBBA')GOTO33170
      IF(ICASPL.EQ.'1WTE')GOTO34000
      IF(ICASPL.EQ.'1WCD')GOTO34000
      IF(ICASPL.EQ.'1W2P')GOTO34000
      IF(ICASPL.EQ.'1WLP')GOTO34000
      IF(ICASPL.EQ.'1WUP')GOTO34000
      IF(ICASPL.EQ.'2WTE')GOTO34010
      IF(ICASPL.EQ.'2WCD')GOTO34010
      IF(ICASPL.EQ.'2W2P')GOTO34010
      IF(ICASPL.EQ.'2WLP')GOTO34010
      IF(ICASPL.EQ.'2WUP')GOTO34010
      IF(ICASPL.EQ.'MWTE')GOTO34020
      IF(ICASPL.EQ.'MWCD')GOTO34020
      IF(ICASPL.EQ.'MW2P')GOTO34020
      IF(ICASPL.EQ.'MWLP')GOTO34020
      IF(ICASPL.EQ.'MWUP')GOTO34020
      IF(ICASPL.EQ.'MWUS')GOTO34020
      IF(ICASPL.EQ.'KLTE')GOTO34030
      IF(ICASPL.EQ.'KLCD')GOTO34030
      IF(ICASPL.EQ.'KL2P')GOTO34030
      IF(ICASPL.EQ.'KLLP')GOTO34030
      IF(ICASPL.EQ.'KLUP')GOTO34030
      IF(ICASPL.EQ.'KWTE')GOTO34035
      IF(ICASPL.EQ.'KWCD')GOTO34035
      IF(ICASPL.EQ.'KW2P')GOTO34035
      IF(ICASPL.EQ.'SRTE')GOTO34040
      IF(ICASPL.EQ.'SRCD')GOTO34040
      IF(ICASPL.EQ.'SR2P')GOTO34040
      IF(ICASPL.EQ.'SRLP')GOTO34040
      IF(ICASPL.EQ.'SRUP')GOTO34040
      IF(ICASPL.EQ.'METE')GOTO34050
      IF(ICASPL.EQ.'MECD')GOTO34050
      IF(ICASPL.EQ.'ME2P')GOTO34050
      IF(ICASPL.EQ.'FZTE')GOTO34060
      IF(ICASPL.EQ.'FZCD')GOTO34060
      IF(ICASPL.EQ.'FZ2P')GOTO34060
      IF(ICASPL.EQ.'QUTE')GOTO34070
      IF(ICASPL.EQ.'QUCD')GOTO34070
      IF(ICASPL.EQ.'QU2P')GOTO34070
      IF(ICASPL.EQ.'PATE')GOTO34075
      IF(ICASPL.EQ.'PAT2')GOTO34075
      IF(ICASPL.EQ.'PACD')GOTO34075
      IF(ICASPL.EQ.'PAPV')GOTO34075
      IF(ICASPL.EQ.'FMAT')GOTO34080
      IF(ICASPL.EQ.'LMAT')GOTO34080
      IF(ICASPL.EQ.'FNOM')GOTO34080
      IF(ICASPL.EQ.'LNOM')GOTO34080
      IF(ICASPL.EQ.'SHDI')GOTO34090
      IF(ICASPL.EQ.'SHEI')GOTO34090
      IF(ICASPL.EQ.'SINR')GOTO34095
      IF(ICASPL.EQ.'SEIR')GOTO34095
      IF(ICASPL.EQ.'SIDI')GOTO34100
      IF(ICASPL.EQ.'SDIR')GOTO34105
      IF(ICASPL.EQ.'JABE')GOTO34110
      IF(ICASPL.EQ.'JAPV')GOTO34110
      IF(ICASPL.EQ.'JACD')GOTO34110
      IF(ICASPL.EQ.'LCL ')GOTO34120
      IF(ICASPL.EQ.'UCL ')GOTO34120
      IF(ICASPL.EQ.'1LCL')GOTO34120
      IF(ICASPL.EQ.'1UCL')GOTO34120
      IF(ICASPL.EQ.'LPL ')GOTO34130
      IF(ICASPL.EQ.'UPL ')GOTO34130
      IF(ICASPL.EQ.'1LPL')GOTO34130
      IF(ICASPL.EQ.'1UPL')GOTO34130
      IF(ICASPL.EQ.'LPB ')GOTO34130
      IF(ICASPL.EQ.'UPB ')GOTO34130
      IF(ICASPL.EQ.'1LPB')GOTO34130
      IF(ICASPL.EQ.'1UPB')GOTO34130
      IF(ICASPL.EQ.'DSLA' .AND. NUMV2.EQ.3)GOTO32100
      IF(ICASPL.EQ.'DHHD' .AND. NUMV2.EQ.3)GOTO32100
      IF(ICASPL.EQ.'DSMM' .AND. NUMV2.EQ.3)GOTO32100
      IF(ICASPL.EQ.'DSSE' .AND. NUMV2.EQ.3)GOTO32100
      IF(ICASPL.EQ.'MPAU' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'MPSE' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'MMPA' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'MMPS' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'VARU' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'VRSE' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'BOB ' .AND. NUMV2.EQ.3)GOTO32300
      IF(ICASPL.EQ.'BOBS' .AND. NUMV2.EQ.3)GOTO32300
      IF(ICASPL.EQ.'GCIN' .AND. NUMV2.EQ.3)GOTO32400
      IF(ICASPL.EQ.'GCIS' .AND. NUMV2.EQ.3)GOTO32400
      IF(ICASPL.EQ.'BCP ' .AND. NUMV2.EQ.3)GOTO32500
      IF(ICASPL.EQ.'BCPS' .AND. NUMV2.EQ.3)GOTO32500
      IF(ICASPL.EQ.'MMEA' .AND. NUMV2.EQ.3)GOTO32600
      IF(ICASPL.EQ.'MMES' .AND. NUMV2.EQ.3)GOTO32600
      IF(ICASPL.EQ.'FAIR' .AND. NUMV2.EQ.3)GOTO32700
      IF(ICASPL.EQ.'FWSE' .AND. NUMV2.EQ.3)GOTO32700
      IF(ICASPL.EQ.'GDEA' .AND. NUMV2.EQ.3)GOTO32800
      IF(ICASPL.EQ.'GDSE' .AND. NUMV2.EQ.3)GOTO32800
      IF(ICASPL.EQ.'GDSN' .AND. NUMV2.EQ.3)GOTO32800
      IF(ICASPL.EQ.'GDZ1' .AND. NUMV2.EQ.3)GOTO32800
      IF(ICASPL.EQ.'GDZ2' .AND. NUMV2.EQ.3)GOTO32800
      IF(ICASPL.EQ.'SCEB' .AND. NUMV2.EQ.3)GOTO32900
      IF(ICASPL.EQ.'SESE' .AND. NUMV2.EQ.3)GOTO32900
      IF(ICASPL.EQ.'DSLA' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'DHHD' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'DSMM' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'DSSE' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MPAU' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MPSE' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MMPA' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MMPS' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'VARU' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'VRSE' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'BOB ' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'BOBS' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GCIN' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GCIS' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'BCP ' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'BCPS' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MMEA' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MMES' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'FAIR' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'FWSE' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GDEA' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GDSE' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GDSN' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GDZ1' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GDZ2' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'SCEB' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'SESE' .AND. NUMV2.EQ.2)GOTO32070
C
      IF(ICASPL.EQ.'DMEA')GOTO12180
      IF(ICASPL.EQ.'DMDM')GOTO12190
      IF(ICASPL.EQ.'DMED')GOTO12200
      IF(ICASPL.EQ.'DGEO')GOTO12230
      IF(ICASPL.EQ.'DHAR')GOTO12240
      IF(ICASPL.EQ.'DHDL')GOTO12250
      IF(ICASPL.EQ.'DBIW')GOTO12260
      IF(ICASPL.EQ.'DSD ')GOTO12270
      IF(ICASPL.EQ.'DRMS')GOTO12275
      IF(ICASPL.EQ.'DVAR')GOTO12280
      IF(ICASPL.EQ.'DAAD')GOTO12290
      IF(ICASPL.EQ.'DMAD')GOTO12300
      IF(ICASPL.EQ.'DMAN')GOTO12300
      IF(ICASPL.EQ.'DIQR')GOTO12310
      IF(ICASPL.EQ.'DBIM')GOTO12340
      IF(ICASPL.EQ.'DBIS')GOTO12350
      IF(ICASPL.EQ.'DGSD')GOTO12370
      IF(ICASPL.EQ.'DRAN')GOTO12380
      IF(ICASPL.EQ.'DMDR')GOTO12390
      IF(ICASPL.EQ.'DQSE')GOTO12400
      IF(ICASPL.EQ.'DQUA')GOTO12405
      IF(ICASPL.EQ.'DSKE')GOTO12410
      IF(ICASPL.EQ.'DGSK')GOTO12412
      IF(ICASPL.EQ.'DPSK')GOTO12414
      IF(ICASPL.EQ.'DKUR')GOTO12420
      IF(ICASPL.EQ.'DEKU')GOTO12425
      IF(ICASPL.EQ.'DRSD')GOTO12430
      IF(ICASPL.EQ.'DSDM')GOTO12440
      IF(ICASPL.EQ.'DRVA')GOTO12450
      IF(ICASPL.EQ.'DVAM')GOTO12460
      IF(ICASPL.EQ.'DMIN')GOTO12470
      IF(ICASPL.EQ.'DMAX')GOTO12480
      IF(ICASPL.EQ.'DEXT')GOTO12490
      IF(ICASPL.EQ.'DCVA')GOTO12495
      IF(ICASPL.EQ.'DCOU')GOTO12500
      IF(ICASPL.EQ.'DSUM')GOTO12510
      IF(ICASPL.EQ.'DPRO')GOTO12512
      IF(ICASPL.EQ.'DSN')GOTO12520
      IF(ICASPL.EQ.'DQN')GOTO12530
      IF(ICASPL.EQ.'DBPR')GOTO12570
      IF(ICASPL.EQ.'DBUC')GOTO12570
      IF(ICASPL.EQ.'DBLC')GOTO12570
      IF(ICASPL.EQ.'DPER')GOTO12600
      IF(ICASPL.EQ.'D1DE')GOTO12600
      IF(ICASPL.EQ.'D2DE')GOTO12600
      IF(ICASPL.EQ.'D3DE')GOTO12600
      IF(ICASPL.EQ.'D4DE')GOTO12600
      IF(ICASPL.EQ.'D5DE')GOTO12600
      IF(ICASPL.EQ.'D6DE')GOTO12600
      IF(ICASPL.EQ.'D7DE')GOTO12600
      IF(ICASPL.EQ.'D8DE')GOTO12600
      IF(ICASPL.EQ.'D9DE')GOTO12600
      IF(ICASPL.EQ.'DLHI')GOTO12610
      IF(ICASPL.EQ.'DUHI')GOTO12620
      IF(ICASPL.EQ.'DLQU')GOTO12630
      IF(ICASPL.EQ.'DUQU')GOTO12640
      IF(ICASPL.EQ.'10LD')GOTO12650
      IF(ICASPL.EQ.'12LD')GOTO12660
      IF(ICASPL.EQ.'15LD')GOTO12670
      IF(ICASPL.EQ.'17LD')GOTO12680
      IF(ICASPL.EQ.'20LD')GOTO12690
      IF(ICASPL.EQ.'10SD')GOTO12700
      IF(ICASPL.EQ.'12SD')GOTO12710
      IF(ICASPL.EQ.'15SD')GOTO12720
      IF(ICASPL.EQ.'17SD')GOTO12730
      IF(ICASPL.EQ.'20SD')GOTO12740
      IF(ICASPL.EQ.'RPSD')GOTO12750
      IF(ICASPL.EQ.'RPRA')GOTO12760
C
      IF(ICASPL.EQ.'CVLC')GOTO3185
      IF(ICASPL.EQ.'CVUC')GOTO3185
      IF(ICASPL.EQ.'CVLO')GOTO3185
      IF(ICASPL.EQ.'CVUO')GOTO3185
      IF(ICASPL.EQ.'SCVL')GOTO3185
      IF(ICASPL.EQ.'SCVU')GOTO3185
      IF(ICASPL.EQ.'SCVA')GOTO3185
      IF(ICASPL.EQ.'LCVA')GOTO3185
      IF(ICASPL.EQ.'LLCV')GOTO3185
      IF(ICASPL.EQ.'ULCV')GOTO3185
C
      IF(ICASPL.EQ.'CCVA')GOTO3195
      IF(ICASPL.EQ.'UCCV')GOTO3195
      IF(ICASPL.EQ.'LCCV')GOTO3195
      IF(ICASPL.EQ.'UCC2')GOTO3195
C
      IF(ICASPL.EQ.'1CTE')GOTO34280
      IF(ICASPL.EQ.'1CCD')GOTO34280
      IF(ICASPL.EQ.'1C2P')GOTO34280
      IF(ICASPL.EQ.'1CLP')GOTO34280
      IF(ICASPL.EQ.'1CUP')GOTO34280
      IF(ICASPL.EQ.'S1CT')GOTO34290
      IF(ICASPL.EQ.'S1CC')GOTO34290
      IF(ICASPL.EQ.'S1CP')GOTO34290
      IF(ICASPL.EQ.'2CTE')GOTO34300
      IF(ICASPL.EQ.'2CCD')GOTO34300
      IF(ICASPL.EQ.'2C2P')GOTO34300
      IF(ICASPL.EQ.'2CLP')GOTO34300
      IF(ICASPL.EQ.'2CUP')GOTO34300
      IF(ICASPL.EQ.'PMEA')THEN
        ICASE='MEAN'
        CALL DPEXPY(ICASE,TEMP,TEMPZ,TEMPZ3,NS2,NSZ,NSZ3,
     1              XTEMP1,XTEMP2,XTEMP3,AVAL1,AVAL2,AVAL3,
     1              IBUGG3,ISUBRO,IFOUND,IERROR)
        RIGHT=AVAL1
        GOTO79000
      ENDIF
C
C     STATISTIC BLOCK
C
      IFORSW='E'
      IFTEXP='+'
      IFTORD='DATA'
C
      IF(ICASPL.EQ.'SBL1')THEN
C
C       STEP 1: SAVE FULL SAMPLE RESPONSE VALUES
C
        IF(ISBCP1.GE.1)THEN
          ICNT=0
          NMAX=0
          DO8111JJ=1,ISBCP1
            IHP=ISBPL1(JJ)(1:4)
            IHP2=ISBPL1(JJ)(5:8)
            DO8113II=1,NUMNAM
              IF(IHP.EQ.IHNAME(II) .AND. IHP2.EQ.IHNAM2(II) .AND.
     1           IUSE(II).EQ.'V')THEN
                ICNT=ICNT+1
                ILISRT=II
                ILISR(ICNT)=ILISRT
                ICOLR(ICNT)=IVALUE(ILISRT)
                NRIGHT(ICNT)=IN(ILISRT)
                IF(NRIGHT(ICNT).GT.NMAX)NMAX=NRIGHT(ICNT)
                GOTO8111
              ELSEIF(IHP.EQ.IHNAME(II) .AND. IHP2.EQ.IHNAM2(II) .AND.
     1           IUSE(II).NE.'V')THEN
                WRITE(ICOUT,11581)
                CALL DPWRST('XXX','BUG ')
                WRITE(ICOUT,8116)IHP,IHP2
 8116           FORMAT('      ',A4,A4,' FOUND IN NAME TABLE, BUT NOT ',
     1                 'AS A VARIABLE.')
                CALL DPWRST('XXX','BUG ')
                IERROR='YES'
                GOTO9000
              ENDIF
 8113       CONTINUE
            WRITE(ICOUT,11581)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,8118)IHP,IHP2
 8118       FORMAT('      ',A4,A4,' NOT FOUND IN NAME TABLE.')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
 8111     CONTINUE
C
          IOP='OPEN'
          IFLAG1=0
          IFLAG2=0
          IFLAG3=0
          IFLAG4=0
          IFLAG5=1
          CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
     1                IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
     1                IBUGG3,ISUBRO,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          J=0
          DO8120II=1,NMAX
            DO8121JJ=1,ICNT
              ICOL=ICOLR(JJ)
              NROW=NRIGHT(JJ)
C
              J=J+1
              IJ=MAXN*(ICOL-1)+II
              IF(ICOL.LE.MAXCOL)AVALV(JJ)=V(IJ)
              IF(ICOL.EQ.MAXCP1)AVALV(JJ)=PRED(II)
              IF(ICOL.EQ.MAXCP2)AVALV(JJ)=RES(II)
              IF(ICOL.EQ.MAXCP3)AVALV(JJ)=YPLOT(II)
              IF(ICOL.EQ.MAXCP4)AVALV(JJ)=XPLOT(II)
              IF(ICOL.EQ.MAXCP5)AVALV(JJ)=X2PLOT(II)
              IF(ICOL.EQ.MAXCP6)AVALV(JJ)=TAGPLO(II)
C
 8121       CONTINUE
            WRITE(IOUNI5,'(20E17.9)')(AVALV(KK),KK=1,ICNT)
 8120     CONTINUE
          REWIND(IOUNI5)
C
C         STEP 2: NOW PUT IN TEMPORARY VALUES OF RESPONSE
C                 VARIABLES INTO NAME TABLE
C
          DO8131JJ=1,ICNT
            ICOL=ICOLR(JJ)
            NROW=NS2
            IF(JJ.EQ.2)NROW=NSZ
            IF(JJ.EQ.3)NROW=NSZ3
            J=0
            DO8130II=1,NROW
C
              J=J+1
              IF(JJ.EQ.1)THEN
                IJ=MAXN*(ICOL-1)+II
                IF(ICOL.LE.MAXCOL)V(IJ)=TEMP(II)
                IF(ICOL.EQ.MAXCP1)PRED(II)=TEMP(II)
                IF(ICOL.EQ.MAXCP2)RES(II)=TEMP(II)
                IF(ICOL.EQ.MAXCP3)YPLOT(II)=TEMP(II)
                IF(ICOL.EQ.MAXCP4)XPLOT(II)=TEMP(II)
                IF(ICOL.EQ.MAXCP5)X2PLOT(II)=TEMP(II)
                IF(ICOL.EQ.MAXCP6)TAGPLO(II)=TEMP(II)
              ELSEIF(JJ.EQ.2)THEN
                IJ=MAXN*(ICOL-1)+II
                IF(ICOL.LE.MAXCOL)V(IJ)=TEMPZ(II)
                IF(ICOL.EQ.MAXCP1)PRED(II)=TEMPZ(II)
                IF(ICOL.EQ.MAXCP2)RES(II)=TEMPZ(II)
                IF(ICOL.EQ.MAXCP3)YPLOT(II)=TEMPZ(II)
                IF(ICOL.EQ.MAXCP4)XPLOT(II)=TEMPZ(II)
                IF(ICOL.EQ.MAXCP5)X2PLOT(II)=TEMPZ(II)
                IF(ICOL.EQ.MAXCP6)TAGPLO(II)=TEMPZ(II)
              ELSEIF(JJ.EQ.3)THEN
                IJ=MAXN*(ICOL-1)+II
                IF(ICOL.LE.MAXCOL)V(IJ)=TEMPZ3(II)
                IF(ICOL.EQ.MAXCP1)PRED(II)=TEMPZ3(II)
                IF(ICOL.EQ.MAXCP2)RES(II)=TEMPZ3(II)
                IF(ICOL.EQ.MAXCP3)YPLOT(II)=TEMPZ3(II)
                IF(ICOL.EQ.MAXCP4)XPLOT(II)=TEMPZ3(II)
                IF(ICOL.EQ.MAXCP5)X2PLOT(II)=TEMPZ3(II)
                IF(ICOL.EQ.MAXCP6)TAGPLO(II)=TEMPZ3(II)
              ENDIF
C
 8130       CONTINUE
            ILISRT=ILISR(JJ)
            IN(ILISRT)=NROW
 8131     CONTINUE
C
        ENDIF
C
C       STEP 3: CALL DPSBEX TO EXECUTE THE FUNTION BLOCK
C
        ISBNAM=ISBNA1
        IFEEDB='OFF'
        CALL DPSBEX(ISBNAM,IANGLU,ISEED,IFTEXP,IFTORD,IFORSW,
     1              IBUGG3,IBUGG3,IBUGG3,IBUGG3,IBUGG3,
     1              ISUBRO,IFOUND,IERROR)
        IFEEDB=IFEESV
        IF(IERROR.EQ.'YES')GOTO9000
C
C       STEP 4: RETRIEVE RESPONSE PARAMETER
C
        DO8140II=1,NUMNAM
          IF(ISBAN1(1:4).EQ.IHNAME(II) .AND.
     1       ISBAN1(5:8).EQ.IHNAM2(II))THEN
            IF(IUSE(II).EQ.'P')THEN
              RIGHT=VALUE(II)
              GOTO8149
            ELSE
              IERROR='YES'
              GOTO9000
            ENDIF
          ENDIF
 8140   CONTINUE
C
        WRITE(ICOUT,11581)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8141)
 8141   FORMAT('      EXPECTED PARAMETER NOT FOUND IN NAME TABLE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8143)ISBAN1
 8143   FORMAT('      EXPECTED NAME = ',A8)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
C
 8149   CONTINUE
C
C       STEP 5: RESTORE THE NAME TABLE AND CLOSE dpst5f.data
C
        J=0
        DO8150II=1,NMAX
C
          READ(IOUNI5,'(20E17.9)')(AVALV(KK),KK=1,ICNT)
          J=J+1
C
          DO8151JJ=1,ICNT
            ICOL=ICOLR(JJ)
            IJ=MAXN*(ICOL-1)+II
            IF(ICOL.LE.MAXCOL)V(IJ)=AVALV(JJ)
            IF(ICOL.EQ.MAXCP1)PRED(II)=AVALV(JJ)
            IF(ICOL.EQ.MAXCP2)RES(II)=AVALV(JJ)
            IF(ICOL.EQ.MAXCP3)YPLOT(II)=AVALV(JJ)
            IF(ICOL.EQ.MAXCP4)XPLOT(II)=AVALV(JJ)
            IF(ICOL.EQ.MAXCP5)X2PLOT(II)=AVALV(JJ)
            IF(ICOL.EQ.MAXCP6)TAGPLO(II)=AVALV(JJ)
C
 8151     CONTINUE
 8150   CONTINUE
C
        DO8153JJ=1,ICNT
          IN(ICOLR(JJ))=NRIGHT(JJ)
 8153   CONTINUE
C
        IOP='CLOS'
        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
     1              IBUGG3,ISUBRO,IERROR)
C
        GOTO79000
C
      ELSEIF(ICASPL.EQ.'SBL2')THEN
C
C       STEP 1: SAVE FULL SAMPLE RESPONSE VALUES
C
        IF(ISBCP2.GE.1)THEN
          ICNT=0
          NMAX=0
          DO8211JJ=1,ISBCP2
            IHP=ISBPL2(JJ)(1:4)
            IHP2=ISBPL2(JJ)(5:8)
            DO8213II=1,NUMNAM
              IF(IHP.EQ.IHNAME(II) .AND. IHP2.EQ.IHNAM2(II) .AND.
     1           IUSE(II).EQ.'V')THEN
                ICNT=ICNT+1
                ILISRT=II
                ILISR(ICNT)=ILISRT
                ICOLR(ICNT)=IVALUE(ILISRT)
                NRIGHT(ICNT)=IN(ILISRT)
                IF(NRIGHT(ICNT).GT.NMAX)NMAX=NRIGHT(ICNT)
                GOTO8211
              ELSEIF(IHP.EQ.IHNAME(II) .AND. IHP2.EQ.IHNAM2(II) .AND.
     1           IUSE(II).NE.'V')THEN
                WRITE(ICOUT,11582)
                CALL DPWRST('XXX','BUG ')
                WRITE(ICOUT,8216)IHP,IHP2
 8216           FORMAT('      ',A4,A4,' FOUND IN NAME TABLE, BUT NOT ',
     1                 'AS A VARIABLE.')
                CALL DPWRST('XXX','BUG ')
                IERROR='YES'
                GOTO9000
              ENDIF
 8213       CONTINUE
            WRITE(ICOUT,11582)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,8218)IHP,IHP2
 8218       FORMAT('      ',A4,A4,' NOT FOUND IN NAME TABLE.')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
 8211     CONTINUE
C
          IOP='OPEN'
          IFLAG1=0
          IFLAG2=0
          IFLAG3=0
          IFLAG4=0
          IFLAG5=1
          CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
     1                IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
     1                IBUGG3,ISUBRO,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          J=0
          DO8220II=1,NMAX
            DO8221JJ=1,ICNT
              ICOL=ICOLR(JJ)
              NROW=NRIGHT(JJ)
C
              J=J+1
              IJ=MAXN*(ICOL-1)+II
              IF(ICOL.LE.MAXCOL)AVALV(JJ)=V(IJ)
              IF(ICOL.EQ.MAXCP1)AVALV(JJ)=PRED(II)
              IF(ICOL.EQ.MAXCP2)AVALV(JJ)=RES(II)
              IF(ICOL.EQ.MAXCP3)AVALV(JJ)=YPLOT(II)
              IF(ICOL.EQ.MAXCP4)AVALV(JJ)=XPLOT(II)
              IF(ICOL.EQ.MAXCP5)AVALV(JJ)=X2PLOT(II)
              IF(ICOL.EQ.MAXCP6)AVALV(JJ)=TAGPLO(II)
C
 8221       CONTINUE
            WRITE(IOUNI5,'(20E17.9)')(AVALV(KK),KK=1,ICNT)
 8220     CONTINUE
          REWIND(IOUNI5)
C
C         STEP 2: NOW PUT IN TEMPORARY VALUES OF RESPONSE
C                 VARIABLES INTO NAME TABLE
C
          DO8231JJ=1,ICNT
            ICOL=ICOLR(JJ)
            NROW=NS2
            IF(JJ.EQ.2)NROW=NSZ
            IF(JJ.EQ.3)NROW=NSZ3
            J=0
            DO8230II=1,NROW
C
              J=J+1
              IF(JJ.EQ.1)THEN
                IJ=MAXN*(ICOL-1)+II
                IF(ICOL.LE.MAXCOL)V(IJ)=TEMP(II)
                IF(ICOL.EQ.MAXCP1)PRED(II)=TEMP(II)
                IF(ICOL.EQ.MAXCP2)RES(II)=TEMP(II)
                IF(ICOL.EQ.MAXCP3)YPLOT(II)=TEMP(II)
                IF(ICOL.EQ.MAXCP4)XPLOT(II)=TEMP(II)
                IF(ICOL.EQ.MAXCP5)X2PLOT(II)=TEMP(II)
                IF(ICOL.EQ.MAXCP6)TAGPLO(II)=TEMP(II)
              ELSEIF(JJ.EQ.2)THEN
                IJ=MAXN*(ICOL-1)+II
                IF(ICOL.LE.MAXCOL)V(IJ)=TEMPZ(II)
                IF(ICOL.EQ.MAXCP1)PRED(II)=TEMPZ(II)
                IF(ICOL.EQ.MAXCP2)RES(II)=TEMPZ(II)
                IF(ICOL.EQ.MAXCP3)YPLOT(II)=TEMPZ(II)
                IF(ICOL.EQ.MAXCP4)XPLOT(II)=TEMPZ(II)
                IF(ICOL.EQ.MAXCP5)X2PLOT(II)=TEMPZ(II)
                IF(ICOL.EQ.MAXCP6)TAGPLO(II)=TEMPZ(II)
              ELSEIF(JJ.EQ.3)THEN
                IJ=MAXN*(ICOL-1)+II
                IF(ICOL.LE.MAXCOL)V(IJ)=TEMPZ3(II)
                IF(ICOL.EQ.MAXCP1)PRED(II)=TEMPZ3(II)
                IF(ICOL.EQ.MAXCP2)RES(II)=TEMPZ3(II)
                IF(ICOL.EQ.MAXCP3)YPLOT(II)=TEMPZ3(II)
                IF(ICOL.EQ.MAXCP4)XPLOT(II)=TEMPZ3(II)
                IF(ICOL.EQ.MAXCP5)X2PLOT(II)=TEMPZ3(II)
                IF(ICOL.EQ.MAXCP6)TAGPLO(II)=TEMPZ3(II)
              ENDIF
C
 8230       CONTINUE
            ILISRT=ILISR(JJ)
            IN(ILISRT)=NROW
 8231     CONTINUE
C
        ENDIF
C
C       STEP 3: CALL DPSBEX TO EXECUTE THE FUNTION BLOCK
C
        ISBNAM=ISBNA2
        IFEEDB='OFF'
        CALL DPSBEX(ISBNAM,IANGLU,ISEED,IFTEXP,IFTORD,IFORSW,
     1              IBUGG3,IBUGG3,IBUGG3,IBUGG3,IBUGG3,
     1              ISUBRO,IFOUND,IERROR)
        IFEEDB=IFEESV
        IF(IERROR.EQ.'YES')GOTO9000
C
C       STEP 4: RETRIEVE RESPONSE PARAMETER
C
        DO8240II=1,NUMNAM
          IF(ISBAN2(1:4).EQ.IHNAME(II) .AND.
     1       ISBAN2(5:8).EQ.IHNAM2(II))THEN
            IF(IUSE(II).EQ.'P')THEN
              RIGHT=VALUE(II)
              GOTO8249
            ELSE
              IERROR='YES'
              GOTO9000
            ENDIF
          ENDIF
 8240   CONTINUE
C
        WRITE(ICOUT,11582)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8241)
 8241   FORMAT('      EXPECTED PARAMETER NOT FOUND IN NAME TABLE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8243)ISBAN2
 8243   FORMAT('      EXPECTED NAME = ',A8)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
C
 8249   CONTINUE
C
C       STEP 5: RESTORE THE NAME TABLE AND CLOSE dpst5f.data
C
        J=0
        DO8250II=1,NMAX
C
          READ(IOUNI5,'(20E17.9)')(AVALV(KK),KK=1,ICNT)
          J=J+1
C
          DO8251JJ=1,ICNT
            ICOL=ICOLR(JJ)
            IJ=MAXN*(ICOL-1)+II
            IF(ICOL.LE.MAXCOL)V(IJ)=AVALV(JJ)
            IF(ICOL.EQ.MAXCP1)PRED(II)=AVALV(JJ)
            IF(ICOL.EQ.MAXCP2)RES(II)=AVALV(JJ)
            IF(ICOL.EQ.MAXCP3)YPLOT(II)=AVALV(JJ)
            IF(ICOL.EQ.MAXCP4)XPLOT(II)=AVALV(JJ)
            IF(ICOL.EQ.MAXCP5)X2PLOT(II)=AVALV(JJ)
            IF(ICOL.EQ.MAXCP6)TAGPLO(II)=AVALV(JJ)
C
 8251     CONTINUE
 8250   CONTINUE
C
        DO8253JJ=1,ICNT
          IN(ICOLR(JJ))=NRIGHT(JJ)
 8253   CONTINUE
C
        IOP='CLOS'
        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
     1              IBUGG3,ISUBRO,IERROR)
C
        GOTO79000
C
      ELSEIF(ICASPL.EQ.'SBL3')THEN
C
C       STEP 1: SAVE FULL SAMPLE RESPONSE VALUES
C
        IF(ISBCP3.GE.1)THEN
          ICNT=0
          NMAX=0
          DO8311JJ=1,ISBCP3
            IHP=ISBPL3(JJ)(1:4)
            IHP2=ISBPL3(JJ)(5:8)
            DO8313II=1,NUMNAM
              IF(IHP.EQ.IHNAME(II) .AND. IHP2.EQ.IHNAM2(II) .AND.
     1           IUSE(II).EQ.'V')THEN
                ICNT=ICNT+1
                ILISRT=II
                ILISR(ICNT)=ILISRT
                ICOLR(ICNT)=IVALUE(ILISRT)
                NRIGHT(ICNT)=IN(ILISRT)
                IF(NRIGHT(ICNT).GT.NMAX)NMAX=NRIGHT(ICNT)
                GOTO8311
              ELSEIF(IHP.EQ.IHNAME(II) .AND. IHP2.EQ.IHNAM2(II) .AND.
     1           IUSE(II).NE.'V')THEN
                WRITE(ICOUT,11583)
                CALL DPWRST('XXX','BUG ')
                WRITE(ICOUT,8316)IHP,IHP2
 8316           FORMAT('      ',A4,A4,' FOUND IN NAME TABLE, BUT NOT ',
     1                 'AS A VARIABLE.')
                CALL DPWRST('XXX','BUG ')
                IERROR='YES'
                GOTO9000
              ENDIF
 8313       CONTINUE
            WRITE(ICOUT,11583)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,8318)IHP,IHP2
 8318       FORMAT('      ',A4,A4,' NOT FOUND IN NAME TABLE.')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
 8311     CONTINUE
C
          IOP='OPEN'
          IFLAG1=0
          IFLAG2=0
          IFLAG3=0
          IFLAG4=0
          IFLAG5=1
          CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
     1                IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
     1                IBUGG3,ISUBRO,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          J=0
          DO8320II=1,NMAX
            DO8321JJ=1,ICNT
              ICOL=ICOLR(JJ)
              NROW=NRIGHT(JJ)
C
              J=J+1
              IJ=MAXN*(ICOL-1)+II
              IF(ICOL.LE.MAXCOL)AVALV(JJ)=V(IJ)
              IF(ICOL.EQ.MAXCP1)AVALV(JJ)=PRED(II)
              IF(ICOL.EQ.MAXCP2)AVALV(JJ)=RES(II)
              IF(ICOL.EQ.MAXCP3)AVALV(JJ)=YPLOT(II)
              IF(ICOL.EQ.MAXCP4)AVALV(JJ)=XPLOT(II)
              IF(ICOL.EQ.MAXCP5)AVALV(JJ)=X2PLOT(II)
              IF(ICOL.EQ.MAXCP6)AVALV(JJ)=TAGPLO(II)
C
 8321       CONTINUE
            WRITE(IOUNI5,'(20E17.9)')(AVALV(KK),KK=1,ICNT)
 8320     CONTINUE
          REWIND(IOUNI5)
C
C         STEP 2: NOW PUT IN TEMPORARY VALUES OF RESPONSE
C                 VARIABLES INTO NAME TABLE
C
          DO8331JJ=1,ICNT
            ICOL=ICOLR(JJ)
            NROW=NS2
            IF(JJ.EQ.2)NROW=NSZ
            IF(JJ.EQ.3)NROW=NSZ3
            J=0
            DO8330II=1,NROW
C
              J=J+1
              IF(JJ.EQ.1)THEN
                IJ=MAXN*(ICOL-1)+II
                IF(ICOL.LE.MAXCOL)V(IJ)=TEMP(II)
                IF(ICOL.EQ.MAXCP1)PRED(II)=TEMP(II)
                IF(ICOL.EQ.MAXCP2)RES(II)=TEMP(II)
                IF(ICOL.EQ.MAXCP3)YPLOT(II)=TEMP(II)
                IF(ICOL.EQ.MAXCP4)XPLOT(II)=TEMP(II)
                IF(ICOL.EQ.MAXCP5)X2PLOT(II)=TEMP(II)
                IF(ICOL.EQ.MAXCP6)TAGPLO(II)=TEMP(II)
              ELSEIF(JJ.EQ.2)THEN
                IJ=MAXN*(ICOL-1)+II
                IF(ICOL.LE.MAXCOL)V(IJ)=TEMPZ(II)
                IF(ICOL.EQ.MAXCP1)PRED(II)=TEMPZ(II)
                IF(ICOL.EQ.MAXCP2)RES(II)=TEMPZ(II)
                IF(ICOL.EQ.MAXCP3)YPLOT(II)=TEMPZ(II)
                IF(ICOL.EQ.MAXCP4)XPLOT(II)=TEMPZ(II)
                IF(ICOL.EQ.MAXCP5)X2PLOT(II)=TEMPZ(II)
                IF(ICOL.EQ.MAXCP6)TAGPLO(II)=TEMPZ(II)
              ELSEIF(JJ.EQ.3)THEN
                IJ=MAXN*(ICOL-1)+II
                IF(ICOL.LE.MAXCOL)V(IJ)=TEMPZ3(II)
                IF(ICOL.EQ.MAXCP1)PRED(II)=TEMPZ3(II)
                IF(ICOL.EQ.MAXCP2)RES(II)=TEMPZ3(II)
                IF(ICOL.EQ.MAXCP3)YPLOT(II)=TEMPZ3(II)
                IF(ICOL.EQ.MAXCP4)XPLOT(II)=TEMPZ3(II)
                IF(ICOL.EQ.MAXCP5)X2PLOT(II)=TEMPZ3(II)
                IF(ICOL.EQ.MAXCP6)TAGPLO(II)=TEMPZ3(II)
              ENDIF
C
 8330       CONTINUE
            ILISRT=ILISR(JJ)
            IN(ILISRT)=NROW
 8331     CONTINUE
C
        ENDIF
C
C       STEP 3: CALL DPSBEX TO EXECUTE THE FUNTION BLOCK
C
        ISBNAM=ISBNA3
        IFEEDB='OFF'
        CALL DPSBEX(ISBNAM,IANGLU,ISEED,IFTEXP,IFTORD,IFORSW,
     1              IBUGG3,IBUGG3,IBUGG3,IBUGG3,IBUGG3,
     1              ISUBRO,IFOUND,IERROR)
        IFEEDB=IFEESV
        IF(IERROR.EQ.'YES')GOTO9000
C
C       STEP 4: RETRIEVE RESPONSE PARAMETER
C
        DO8340II=1,NUMNAM
          IF(ISBAN3(1:4).EQ.IHNAME(II) .AND.
     1       ISBAN3(5:8).EQ.IHNAM2(II))THEN
            IF(IUSE(II).EQ.'P')THEN
              RIGHT=VALUE(II)
              GOTO8349
            ELSE
              IERROR='YES'
              GOTO9000
            ENDIF
          ENDIF
 8340   CONTINUE
C
        WRITE(ICOUT,11583)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8341)
 8341   FORMAT('      EXPECTED PARAMETER NOT FOUND IN NAME TABLE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8343)ISBAN3
 8343   FORMAT('      EXPECTED NAME = ',A8)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
C
 8349   CONTINUE
C
C       STEP 5: RESTORE THE NAME TABLE AND CLOSE dpst5f.data
C
        J=0
        DO8350II=1,NMAX
C
          READ(IOUNI5,'(20E17.9)')(AVALV(KK),KK=1,ICNT)
          J=J+1
C
          DO8351JJ=1,ICNT
            ICOL=ICOLR(JJ)
            IJ=MAXN*(ICOL-1)+II
            IF(ICOL.LE.MAXCOL)V(IJ)=AVALV(JJ)
            IF(ICOL.EQ.MAXCP1)PRED(II)=AVALV(JJ)
            IF(ICOL.EQ.MAXCP2)RES(II)=AVALV(JJ)
            IF(ICOL.EQ.MAXCP3)YPLOT(II)=AVALV(JJ)
            IF(ICOL.EQ.MAXCP4)XPLOT(II)=AVALV(JJ)
            IF(ICOL.EQ.MAXCP5)X2PLOT(II)=AVALV(JJ)
            IF(ICOL.EQ.MAXCP6)TAGPLO(II)=AVALV(JJ)
C
 8351     CONTINUE
 8350   CONTINUE
C
        DO8353JJ=1,ICNT
          IN(ICOLR(JJ))=NRIGHT(JJ)
 8353   CONTINUE
C
        IOP='CLOS'
        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
     1              IBUGG3,ISUBRO,IERROR)
C
        GOTO79000
      ENDIF
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80001)
80001 FORMAT('***** INTERNAL ERROR IN CMPSTA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80002)
80002 FORMAT('      AT BRANCH POINT 11800--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80003)
80003 FORMAT('      ICASPL NOT EQUAL ONE OF THE ALLOWABLE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80004)
80004 FORMAT('      MEAN, MEDI, SD, RANG, ETC.,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80006)ICASPL
80006 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C     ---------------------------
C
11310 CONTINUE
      CALL SIZE(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
C
11312 CONTINUE
      IHP='LOWL'
      IHP2='IMIT'
      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
        ALOWLM=CPUMIN
      ELSE
        ALOWLM=VALUE(ILOCP)
      ENDIF
      IHP='UPPL'
      IHP2='IMIT'
      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
        AUPPLM=CPUMAX
      ELSE
        AUPPLM=VALUE(ILOCP)
      ENDIF
      CALL INTCNT(TEMP,NS2,ALOWLM,AUPPLM,IWRITE,RIGHT,
     1            ISUBRO,IBUGG3,IERROR)
      GOTO79000
C
11315 CONTINUE
      CALL DISTIN(TEMP,NS2,IWRITE,XTEMP1,NOUT,IBUGG3,IERROR)
      RIGHT=REAL(NOUT)
      GOTO79000
11320 CONTINUE
      CALL SUMDP(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11330 CONTINUE
      CALL PROD(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11340 CONTINUE
CCCCC CALL INTVEC(TEMP,TEMPZ,NS2,NUMVIN,IWRITE,RIGHT,IBUGG3,IERROR)
      CALL INTVEC(TEMP,TEMPZ,NS2,NUMV2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11350 CONTINUE
      CALL MIDRAN(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11360 CONTINUE
      CALL MEAN(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11370 CONTINUE
      CALL MIDMEA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR)
      GOTO79000
11372 CONTINUE
      CALL SHMIDM(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,
     1            ISUBRO,IBUGG3,IERROR)
      GOTO79000
11373 CONTINUE
      CALL SHMIDM(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,
     1            ISUBRO,IBUGG3,IERROR)
      CALL SHMIDM(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=RIGH1 - RIGH2
      GOTO79000
11374 CONTINUE
      CALL SHMIDR(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,
     1            ISUBRO,IBUGG3,IERROR)
      GOTO79000
11375 CONTINUE
      CALL SHMIDR(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,
     1            ISUBRO,IBUGG3,IERROR)
      CALL SHMIDR(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=RIGH1 - RIGH2
      GOTO79000
11380 CONTINUE
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR)
      GOTO79000
11390 CONTINUE
      CALL SD(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11395 CONTINUE
      CALL RMS(TEMP,NS2,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11396 CONTINUE
      CALL SSQ(TEMP,NS2,XCAP,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11397 CONTINUE
      CALL RSCSUM(TEMP,NS2,XCAP,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11398 CONTINUE
      CALL SSQ(TEMP,NS2,XCAP,IWRITE,RIGH1,IBUGG3,ISUBRO,IERROR)
      CALL SSQ(TEMPZ,NSZ,XCAP,IWRITE,RIGH2,IBUGG3,ISUBRO,IERROR)
      RIGHT=RIGH1 - RIGH2
      GOTO79000
11399 CONTINUE
      CALL SSQMEA(TEMP,NS2,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
19399 CONTINUE
      CALL SSQMEA(TEMP,NS2,IWRITE,RIGH1,IBUGG3,ISUBRO,IERROR)
      CALL SSQMEA(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,ISUBRO,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
11400 CONTINUE
      CALL VAR(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      IF(ICASPL.EQ.'PREC')THEN
         IF(RIGHT.GT.0.0)THEN
           RIGHT=1.0/RIGHT
         ELSE
           RIGHT=0.0
         ENDIF
      ENDIF
      GOTO79000
11401 CONTINUE
      CALL RSCSUM(TEMP,NS2,XCAP,IWRITE,RIGH1,IBUGG3,ISUBRO,IERROR)
      CALL RSCSUM(TEMPZ,NSZ,XCAP,IWRITE,RIGH2,IBUGG3,ISUBRO,IERROR)
      RIGHT=RIGH1 - RIGH2
      GOTO79000
11403 CONTINUE
      DO11404II=1,NS2
        TEMPZ(II)=1.0
11404 CONTINUE
      CALL JSCORE(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,XTEMP3,NTEMP,
     1            IBUGG3,ISUBRO,IERROR)
      RIGHT=XTEMP3(1)
      GOTO79000
11405 CONTINUE
      CALL DISTIN(TEMPZ,NS2,IWRITE,XTEMP1,NOUT,IBUGG3,IERROR)
      ANMAT=REAL(NOUT)
      XCAP=CPUMIN
      CALL SSQ(TEMP,NS2,XCAP,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      RIGHT=SQRT(RIGHT/ANMAT)
      GOTO79000
11410 CONTINUE
      CALL RELSD(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11415 CONTINUE
      CALL MEAN(TEMP,NS2,IWRITE,RIGHTM,IBUGG3,IERROR)
      CALL VAR(TEMP,NS2,IWRITE,RIGHTV,IBUGG3,IERROR)
      RIGHT=0.0
CCCCC NOVEMBER 1994.  TO BE CONSISTENT WITH RELATIVE SD PLOT, USE
CCCCC ABS(MEAN) RATHER THAN MEAN.
CCCCC IF(RIGHTM.NE.0.0)RIGHT=100.0*RIGHTV/RIGHTM
      IF(RIGHTM.NE.0.0)RIGHT=100.0*RIGHTV/ABS(RIGHTM)
      GOTO79000
11418 CONTINUE
      CALL SD(TEMP,NS2,IWRITE,RIGHTV,IBUGG3,IERROR)
      CALL MEAN(TEMP,NS2,IWRITE,RIGHTM,IBUGG3,IERROR)
      RIGHT=0.0
      IF(RIGHTM.NE.0.0)RIGHT=RIGHTV/RIGHTM
      IF(ICASPL.EQ.'UCVA')THEN
        AVAL=1.0 + 1.0/(4.0*REAL(NS2))
        RIGHT=AVAL*RIGHT
      ENDIF
      GOTO79000
11419 CONTINUE
      CALL SD(TEMP,NS2,IWRITE,RIGHTV,IBUGG3,IERROR)
      CALL MEAN(TEMP,NS2,IWRITE,RIGHTM,IBUGG3,IERROR)
      RIGHT=0.0
      IF(RIGHTV.NE.0.0)RIGHT=RIGHTM/RIGHTV
      GOTO79000
11420 CONTINUE
      CALL RANGDP(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11421 CONTINUE
C
C     2017/11: USE AAD RATHER THAN MAD TO BE CONSISTENT WITH
C              DEFINITION IN BONETT AND SEIER PAPER.
C
CCCCC CALL MAD(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHTV,
CCCCC1         IBUGG3,IERROR)
      CALL AAD(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHTV,'MEDI',
     1         IBUGG3,IERROR)
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHTM,IBUGG3,IERROR)
      RIGHT=0.0
      IF(RIGHTM.NE.0.0)RIGHT=RIGHTV/RIGHTM
      GOTO79000
11427 CONTINUE
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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
      ELSE
        ALPHA=0.95
      ENDIF
C
      IF(ICASPL.EQ.'LCDL')ICASA3='LOWE'
      IF(ICASPL.EQ.'1LCD')ICASA3='LOWE'
      IF(ICASPL.EQ.'UCDL')ICASA3='UPPE'
      IF(ICASPL.EQ.'1UCD')ICASA3='UPPE'
      ICASA5='TWOS'
      IF(ICASPL.EQ.'1LCD')ICASA5='ONES'
      IF(ICASPL.EQ.'1UCD')ICASA5='ONES'
C
      ALPHAT(1)=ALPHA
      NALPHA=1
C
      CALL DPCDC3(TEMP,NS2,ICASA3,ICASA5,ISEED,MAXNXT,
     1            XTEMP1,ALPHAT,NALPHA,ALOWLV,AUPPLV,
     1            CD,YMED,YAAD,
     1            ISUBRO,IBUGG3,IERROR)
C
      IF(ICASPL.EQ.'LCDL')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'1LCD')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'UCDL')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'1UCD')RIGHT=AUPPLV(1)
      GOTO79000
C
11428 CONTINUE
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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
      ELSE
        ALPHA=0.95
      ENDIF
C
      IF(ICASPL.EQ.'LCDQ')ICASA3='LOWE'
      IF(ICASPL.EQ.'UCDQ')ICASA3='UPPE'
      ICASA5='TWOS'
C
      ALPHAT(1)=ALPHA
      NALPHA=1
C
      CALL DPCQD3(TEMP,NS2,ICASA3,ICASA5,ISEED,MAXNXT,IQUAME,
     1            XTEMP1,ALPHAT,NALPHA,ALOWLV,AUPPLV,
     1            CQV,Q1,Q3,
     1            ISUBRO,IBUGG3,IERROR)
C
      IF(ICASPL.EQ.'LCDQ')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'UCDQ')RIGHT=AUPPLV(1)
      GOTO79000
11422 CONTINUE
      CALL VAR(TEMP,NS2,IWRITE,RIGHTV,IBUGG3,IERROR)
      CALL MEAN(TEMP,NS2,IWRITE,RIGHTM,IBUGG3,IERROR)
      RIGHT=0.0
      IF(RIGHTM.NE.0.0)RIGHT=RIGHTV/RIGHTM
      GOTO79000
11423 CONTINUE
      CALL MAD(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHTV,
     1         IBUGG3,IERROR)
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHTM,IBUGG3,IERROR)
      RIGHT=0.0
      IF(RIGHTM.NE.0.0)RIGHT=RIGHTV/RIGHTM
      GOTO79000
11424 CONTINUE
      CALL MAD(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHTV,
     1         IBUGG3,IERROR)
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHTM,IBUGG3,IERROR)
      RIGH1=0.0
      IF(RIGHTM.NE.0.0)RIGH1=RIGHTV/RIGHTM
      CALL MAD(TEMPZ,NSZ,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHTV,
     1         IBUGG3,IERROR)
      CALL MEDIAN(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGHTM,IBUGG3,IERROR)
      RIGH2=0.0
      IF(RIGHTM.NE.0.0)RIGH2=RIGHTV/RIGHTM
      RIGHT=RIGH1 - RIGH2
      GOTO79000
11425 CONTINUE
      CALL VAR(TEMP,NS2,IWRITE,RIGHTV,IBUGG3,IERROR)
      CALL MEAN(TEMP,NS2,IWRITE,RIGHTM,IBUGG3,IERROR)
      RIGH1=0.0
      IF(RIGHTM.NE.0.0)RIGH1=RIGHTV/RIGHTM
      CALL VAR(TEMPZ,NSZ,IWRITE,RIGHTV,IBUGG3,IERROR)
      CALL MEAN(TEMPZ,NSZ,IWRITE,RIGHTM,IBUGG3,IERROR)
      RIGH2=0.0
      IF(RIGHTM.NE.0.0)RIGH2=RIGHTV/RIGHTM
      RIGHT=RIGH1 - RIGH2
      GOTO79000
11426 CONTINUE
      CALL MAD(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHTV,
     1         IBUGG3,IERROR)
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHTM,IBUGG3,IERROR)
      RIGH1=0.0
      IF(RIGHTM.NE.0.0)RIGH1=RIGHTV/RIGHTM
      CALL MAD(TEMPZ,NSZ,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHTV,
     1         IBUGG3,IERROR)
      CALL MEDIAN(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGHTM,IBUGG3,IERROR)
      RIGH2=0.0
      IF(RIGHTM.NE.0.0)RIGH2=RIGHTV/RIGHTM
      RIGHT=RIGH1 - RIGH2
      GOTO79000
11430 CONTINUE
      CALL MINIM(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11440 CONTINUE
      CALL MAXIM(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11450 CONTINUE
      CALL STMOM3(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11452 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,Q1,IBUGG3,IERROR)
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,Q3,IBUGG3,IERROR)
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,Q2,IBUGG3,IERROR)
      IF(Q1.NE.Q3)THEN
        RIGHT=(Q3 + Q1 - 2.0*Q2)/(Q3 - Q1)
      ELSE
        RIGHT=CPUMIN
      ENDIF
      GOTO79000
11454 CONTINUE
      CALL MEAN(TEMP,NS2,IWRITE,YMEAN,IBUGG3,IERROR)
      CALL SD(TEMP,NS2,IWRITE,YSD,IBUGG3,IERROR)
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,YMED,IBUGG3,IERROR)
      IF(YSD.GT.0.0)THEN
        RIGHT=3.0*(YMEAN-YMED)/YSD
      ELSE
        RIGHT=CPUMIN
      ENDIF
      GOTO79000
11460 CONTINUE
      CALL STMOM4(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11465 CONTINUE
      CALL STMOM4(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      RIGHT=RIGHT-3.0
      GOTO79000
11470 CONTINUE
      CALL AUTOCR(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11480 CONTINUE
      CALL COV(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
31480 CONTINUE
      CALL COMOVE(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11490 CONTINUE
      CALL CORR(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      IF(ICASPL.EQ.'COAB')THEN
        RIGHT=ABS(RIGHT)
      ELSEIF(ICASPL.EQ.'COPV')THEN
        IDF1=1
        IDF2=NS2 - 2
        ANUM=REAL(NS2-2)*RIGHT**2
        DENOM=1.0 - RIGHT**2
        CDF=0.0
        IF(DENOM.NE.0.0D0)THEN
          AVAL=ABS(ANUM/DENOM)
          CALL FCDF(AVAL,IDF1,IDF2,CDF)
        ENDIF
        RIGHT=1.0 - CDF
      ELSEIF(ICASPL.EQ.'COCD')THEN
        IDF1=1
        IDF2=NS2 - 2
        ANUM=REAL(NS2-2)*RIGHT**2
        DENOM=1.0 - RIGHT**2
        CDF=0.0
        IF(DENOM.NE.0.0D0)THEN
          AVAL=ABS(ANUM/DENOM)
          CALL FCDF(AVAL,IDF1,IDF2,CDF)
        ENDIF
        RIGHT=CDF
      ELSEIF(ICASPL.EQ.'PDIS')THEN
        RIGHT=(1.0 - RIGHT)/2.0
      ELSEIF(ICASPL.EQ.'PSIM')THEN
        RIGHT=1.0 - (1.0 - RIGHT)/2.0
      ENDIF
      GOTO79000
11491 CONTINUE
      IHP='P   '
      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)
      IF(IERROR.EQ.'YES')THEN
        P=1.0
      ELSE
        P=VALUE(ILOCP)
      ENDIF
      CALL MNKDIS(TEMP,TEMPZ,NS2,P,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11492 CONTINUE
      CALL CANDIS(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11495 CONTINUE
      CALL CORR(TEMP,TEMPZ,NS2,IWRITE,R12,IBUGG3,IERROR)
      CALL CORR(TEMP,TEMPZ3,NS2,IWRITE,R13,IBUGG3,IERROR)
      CALL CORR(TEMPZ,TEMPZ3,NS2,IWRITE,R23,IBUGG3,IERROR)
      ANUM=R12 - (R13*R23)
      DENOM=SQRT((1.0 - R13**2)*(1.0 - R23**2))
      IF(DENOM.GT.0.0)THEN
        RIGHT=ANUM/DENOM
      ELSE
        RIGHT=PSTAMV
      ENDIF
      IF(RIGHT.EQ.PSTAMV)GOTO79000
      IF(ICASPL.EQ.'PCAB')THEN
        RIGHT=ABS(RIGHT)
      ELSEIF(ICASPL.EQ.'PCPV')THEN
        IDF1=1
        IDF2=NS2 - 3
        ANUM=REAL(NS2-3)*RIGHT**2
        DENOM=1.0 - RIGHT**2
        CDF=0.0
        IF(DENOM.NE.0.0D0)THEN
          AVAL=ABS(ANUM/DENOM)
          CALL FCDF(AVAL,IDF1,IDF2,CDF)
        ENDIF
        RIGHT=1.0 - CDF
      ELSEIF(ICASPL.EQ.'PCCD')THEN
        IDF1=1
        IDF2=NS2
        ANUM=REAL(NS2-3)*RIGHT**2
        DENOM=1.0 - RIGHT**2
        CDF=0.0
        IF(DENOM.NE.0.0D0)THEN
          AVAL=ABS(ANUM/DENOM)
          CALL FCDF(AVAL,IDF1,IDF2,CDF)
        ENDIF
        RIGHT=CDF
      ENDIF
      GOTO79000
11496 CONTINUE
      CALL MANDIS(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11497 CONTINUE
      CALL CHEDI2(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11498 CONTINUE
      CALL COSDIS(TEMP,TEMPZ,NS2,IWRITE,ICASPL,RIGHT,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
11499 CONTINUE
      IF(ICASPL.EQ.'EUCD')ICASE2='VEDI'
      IF(ICASPL.EQ.'EUCL')ICASE2='VELE'
      IF(ICASPL.EQ.'DOTP')ICASE2='VEDP'
      CALL VECARI(TEMP,TEMPZ,NS2,ICASE2,IWRITE,
     1            TEMPZ3,NOUT,RIGHT,ITYP91,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11500 CONTINUE
      CALL RANKCR(TEMP,TEMPZ,NS2,IRCRTA,IWRITE,
     1            XTEMP1,XTEMP2,XTEMP3,MAXNXT,
     1            RIGHT,STATCD,PVAL,PVALLT,PVALUT,
     1            CUTU90,CUTU95,CTU975,CUTU99,CTU995,CTU999,
     1            CUTL90,CUTL95,CTL975,CUTL99,CTL995,CTL999,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'RACA')RIGHT=ABS(RIGHT)
      IF(ICASPL.EQ.'RACC')RIGHT=STATCD
      IF(ICASPL.EQ.'RACP')RIGHT=PVAL
      IF(ICASPL.EQ.'RALP')RIGHT=PVALLT
      IF(ICASPL.EQ.'RAUP')RIGHT=PVALUT
      IF(ICASPL.EQ.'RDIS')RIGHT=(1.0 - RIGHT)/2.0
      IF(ICASPL.EQ.'RSIM')RIGHT=1.0 - (1.0 - RIGHT)/2.0
      GOTO79000
11502 CONTINUE
      CALL HAMDIS(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11505 CONTINUE
      CALL RANKCR(TEMP,TEMPZ,NS2,IRCRTA,IWRITE,
     1            XTEMP1,XTEMP2,XTEMP3,MAXNXT,
     1            R12,STATCD,PVAL,PVALLT,PVALUT,
     1            CUTU90,CUTU95,CTU975,CUTU99,CTU995,CTU999,
     1            CUTL90,CUTL95,CTL975,CUTL99,CTL995,CTL999,
     1            IBUGG3,ISUBRO,IERROR)
      CALL RANKCR(TEMP,TEMPZ3,NS2,IRCRTA,IWRITE,
     1            XTEMP1,XTEMP2,XTEMP3,MAXNXT,
     1            R13,STATCD,PVAL,PVALLT,PVALUT,
     1            CUTU90,CUTU95,CTU975,CUTU99,CTU995,CTU999,
     1            CUTL90,CUTL95,CTL975,CUTL99,CTL995,CTL999,
     1            IBUGG3,ISUBRO,IERROR)
      CALL RANKCR(TEMPZ,TEMPZ3,NS2,IRCRTA,IWRITE,
     1            XTEMP1,XTEMP2,XTEMP3,MAXNXT,
     1            R23,STATCD,PVAL,PVALLT,PVALUT,
     1            CUTU90,CUTU95,CTU975,CUTU99,CTU995,CTU999,
     1            CUTL90,CUTL95,CTL975,CUTL99,CTL995,CTL999,
     1            IBUGG3,ISUBRO,IERROR)
      ANUM=R12 - (R13*R23)
      DENOM=SQRT((1.0 - R13**2)*(1.0 - R23**2))
      IF(DENOM.GT.0.0)THEN
        RIGHT=ANUM/DENOM
      ELSE
        RIGHT=PSTAMV
      ENDIF
      IF(ICASPL.EQ.'RPCA' .AND. RIGHT.NE.PSTAMV)RIGHT=ABS(RIGHT)
      GOTO79000
11509 CONTINUE
      CALL PERDME(TEMP,NS2,TEMPZ,NSZ,IWRITE,RIGHT,
     1            ISUBRO,IBUGG3,IERROR)
      GOTO79000
11510 CONTINUE
      CALL SDMEAN(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11520 CONTINUE
      CALL AUTOCV(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11530 CONTINUE
      CALL RANKCV(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,XTEMP3,
     1MAXNXT,RIGHT,
     1IBUGG3,IERROR)
      GOTO79000
11531 CONTINUE
      CALL PERAGR(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'PEDI' .AND. RIGHT.GE.0.0)RIGHT=100.0 - RIGHT
      GOTO79000
31530 CONTINUE
      CALL RANKCM(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,XTEMP3,
     1MAXNXT,RIGHT,
     1IBUGG3,IERROR)
      GOTO79000
31540 CONTINUE
      ICASZZ='TWOS'
      CALL KENTAU(TEMP,TEMPZ,NS2,ICASZZ,IKTATA,IWRITE,
     1            XTEMP1,XTEMP2,MAXNXT,
     1            RIGHT,AKTAUA,AKTAUB,AKTAUC,
     1            STATCD,PVAL,PVALLT,PVALUT,
     1            CUTU90,CUTU95,CTU975,CUTU99,CTU995,
     1            CUTL90,CUTL95,CTL975,CUTL99,CTL995,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'KTAA')RIGHT=ABS(RIGHT)
      IF(ICASPL.EQ.'TAUA')RIGHT=AKTAUA
      IF(ICASPL.EQ.'KTAB')RIGHT=AKTAUB
      IF(ICASPL.EQ.'KTAC')RIGHT=AKTAUC
      IF(ICASPL.EQ.'KTCD')RIGHT=STATCD
      IF(ICASPL.EQ.'KTPV')RIGHT=PVAL
      IF(ICASPL.EQ.'KTPL')RIGHT=PVALLT
      IF(ICASPL.EQ.'KTPU')RIGHT=PVALUT
      IF(ICASPL.EQ.'KDIS')RIGHT=(1.0 - RIGHT)/2.0
      IF(ICASPL.EQ.'KSIM')RIGHT=1.0 - (1.0 - RIGHT)/2.0
      GOTO79000
31545 CONTINUE
      ICASZZ='TWOS'
      CALL KENTAU(TEMP,TEMPZ,NS2,ICASZZ,IKTATA,IWRITE,
     1            XTEMP1,XTEMP2,MAXNXT,
     1            R12,AKTAUA,AKTAUB,AKTAUC,
     1            STATCD,PVAL,PVALLT,PVALUT,
     1            CUTU90,CUTU95,CTU975,CUTU99,CTU995,
     1            CUTL90,CUTL95,CTL975,CUTL99,CTL995,
     1            IBUGG3,ISUBRO,IERROR)
      CALL KENTAU(TEMP,TEMPZ3,NS2,ICASZZ,IKTATA,IWRITE,
     1            XTEMP1,XTEMP2,MAXNXT,
     1            R13,AKTAUA,AKTAUB,AKTAUC,
     1            STATCD,PVAL,PVALLT,PVALUT,
     1            CUTU90,CUTU95,CTU975,CUTU99,CTU995,
     1            CUTL90,CUTL95,CTL975,CUTL99,CTL995,
     1            IBUGG3,ISUBRO,IERROR)
      CALL KENTAU(TEMPZ,TEMPZ3,NS2,ICASZZ,IKTATA,IWRITE,
     1            XTEMP1,XTEMP2,MAXNXT,
     1            R23,AKTAUA,AKTAUB,AKTAUC,
     1            STATCD,PVAL,PVALLT,PVALUT,
     1            CUTU90,CUTU95,CTU975,CUTU99,CTU995,
     1            CUTL90,CUTL95,CTL975,CUTL99,CTL995,
     1            IBUGG3,ISUBRO,IERROR)
      ANUM=R12 - (R13*R23)
      DENOM=SQRT((1.0 - R13**2)*(1.0 - R23**2))
      IF(DENOM.GT.0.0)THEN
        RIGHT=ANUM/DENOM
      ELSE
        RIGHT=PSTAMV
      ENDIF
      IF(ICASPL.EQ.'PKAB' .AND. RIGHT.NE.PSTAMV)RIGHT=ABS(RIGHT)
      GOTO79000
31550 CONTINUE
      CALL SUMDP(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL SUMDP(TEMPZ,NS2,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=0.0
      IF(RIGH2.NE.0.0)RIGHT=RIGH1/RIGH2
      GOTO79000
C
C     BINOMIAL RATIO - FOR CASE WHERE BINOMIAL PROBABILITIES GIVEN
C                      AS NUMBER OF SUCCESSES AND NUMBER OF TRIALS
C                      RATHER THAN A SERIES OF 0/1 VALUES (I.E., DATA
C                      PREVIOUSLY AGGREGATED).  SLIGHTLY DIFFERENT
C                      FROM "RATIO" IN THAT WE NEED TO CHECK THAT
C                      VALUE FOR SECOND VARIABLE ALWAYS > VALUE
C                      FOR FIRST VARIABLE.  ALSO, OMIT ROW IF EITHER
C                      VALUE IS EQUAL TO THE MISSING VALUE.
C
31551 CONTINUE
      RIGHT=PSTAMV
      NTEMP=0
      DO31552I=1,NS2
        IVAL1=INT(TEMP(I)+0.1)
        IVAL2=INT(TEMPZ(I)+0.1)
        IF(TEMP(I).EQ.PSTAMV .OR. TEMPZ(I).EQ.PSTAMV)THEN
          GOTO31552
        ELSEIF(IVAL1.GT.IVAL2)THEN
          IERROR='YES'
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,31553)
31553     FORMAT('***** ERROR IN CMPSTA')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,31554)
31554     FORMAT('      FOR BINOMIAL RATIO, NUMBER OF SUCCESSES IS ')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,31555)
31555     FORMAT('      GREATER THAN THE NUMBER OF TRIALS.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,31556)IVAL1
31556     FORMAT('      THE NUMBER OF SUCCESSES = ',I8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,31557)IVAL2
31557     FORMAT('      THE NUMBER OF TRIALS    = ',I8)
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ELSE
          NTEMP=NTEMP+1
          IF(IVAL1.LT.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,31553)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,31558)IVAL1
31558       FORMAT('      THE NUMBER OF SUCCESSES, ',I8,
     1             ' IS NEGATIVE.')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
          IF(IVAL2.LT.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,31553)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,31559)IVAL2
31559       FORMAT('      THE NUMBER OF TRIALS, ',I8,
     1             ' IS NEGATIVE.')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
          TEMP(NTEMP)=IVAL1
          TEMPZ(NTEMP)=IVAL2
        ENDIF
31552 CONTINUE
      IF(NTEMP.LE.0)GOTO79000
      CALL SUMDP(TEMP,NTEMP,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL SUMDP(TEMPZ,NTEMP,IWRITE,RIGH2,IBUGG3,IERROR)
      IF(RIGH2.NE.0.0)RIGHT=RIGH1/RIGH2
      ITEMP1(1)=INT(RIGH2+0.1)
      GOTO79000
C
31565 CONTINUE
      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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
      ELSE
        ALPHA=0.95
      ENDIF
C
      ALPHAT(1)=ALPHA
      NALPHA=1
      IF(IRATME.EQ.'FIEL')THEN
        CALL DPMRC3(TEMP,TEMPZ,NS2,ALPHAT,NALPHA,
     1              RATIO,ALOWLV,AUPPLV,
     1              YBAR,XBAR,YVAR,XVAR,
     1              ISUBRO,IBUGG3,IERROR)
      ELSEIF(IRATME.EQ.'LSAM')THEN
        CALL DPMRC4(TEMP,TEMPZ,NS2,ALPHAT,NALPHA,
     1              RATIO,ALOWLV,AUPPLV,
     1              YBAR,XBAR,YVAR,XVAR,XYCOV,
     1              ISUBRO,IBUGG3,IERROR)
      ELSEIF(IRATME.EQ.'LRAT')THEN
        CALL DPMRC5(TEMP,TEMPZ,NS2,ALPHAT,NALPHA,
     1              RATIO,ALOWLV,AUPPLV,
     1              YBAR,XBAR,YVAR,XVAR,XYCOV,
     1              ISUBRO,IBUGG3,IERROR)
      ENDIF
      IF(ICASPL.EQ.'RMEA')THEN
        RIGHT=RATIO
      ELSEIF(ICASPL.EQ.'RMLL')THEN
        RIGHT=ALOWLV(1)
      ELSEIF(ICASPL.EQ.'RMUL')THEN
        RIGHT=AUPPLV(1)
      ENDIF
      GOTO79000
31560 CONTINUE
      CALL ODDRAT(TEMP,NS2,TEMPZ,NSZ,PSTAMV,IWRITE,XTEMP1,RIGHT,
     1            IBUGG3,IERROR)
      GOTO79000
31570 CONTINUE
      CALL ODDRSE(TEMP,NS2,TEMPZ,NS2,PSTAMV,IWRITE,XTEMP1,RIGHT,
     1            IBUGG3,IERROR)
      GOTO79000
31580 CONTINUE
      CALL RELRSK(TEMP,NS2,TEMPZ,NSZ,PSTAMV,IWRITE,XTEMP1,RIGHT,
     1            IBUGG3,IERROR)
      GOTO79000
31590 CONTINUE
      CALL CRAMER(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,XTEMP3,
     1            RIGHT,IBUGG3,IERROR)
      GOTO79000
31600 CONTINUE
      CALL PEARCC(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,XTEMP3,
     1            RIGHT,IBUGG3,IERROR)
      GOTO79000
31610 CONTINUE
      CALL FALPOS(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,RIGHT,IBUGG3,IERROR)
      GOTO79000
31620 CONTINUE
      CALL FALNEG(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,RIGHT,IBUGG3,IERROR)
      GOTO79000
31630 CONTINUE
      CALL TRUPOS(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,RIGHT,IBUGG3,IERROR)
      GOTO79000
31640 CONTINUE
      CALL TRUNEG(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,RIGHT,IBUGG3,IERROR)
      GOTO79000
31650 CONTINUE
      CALL SENSIT(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,RIGHT,IBUGG3,IERROR)
      GOTO79000
31660 CONTINUE
      CALL SPECIF(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,RIGHT,IBUGG3,IERROR)
      GOTO79000
31670 CONTINUE
      CALL PPV(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,RIGHT,IBUGG3,IERROR)
      GOTO79000
31680 CONTINUE
      CALL NPV(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,RIGHT,IBUGG3,IERROR)
      GOTO79000
31685 CONTINUE
      CALL BINMAT(TEMP,TEMPZ,NS2,ICASPL,IWRITE,XTEMP1,RIGHT,
     1            ISUBRO,IBUGG3,IERROR)
      GOTO79000
31688 CONTINUE
      CALL GJACC(TEMP,TEMPZ,NS2,ICASPL,IWRITE,RIGHT,DIST,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'GJDI')RIGHT=DIST
      GOTO79000
31690 CONTINUE
      CALL LOGIT(TEMP,NS2,TEMPZ,NSZ,PSTAMV,IWRITE,XTEMP1,RIGHT,
     1           IBUGG3,IERROR)
      GOTO79000
31700 CONTINUE
      CALL LOGISE(TEMP,NS2,TEMPZ,NSZ,PSTAMV,IWRITE,XTEMP1,RIGHT,
     1            IBUGG3,IERROR)
      GOTO79000
C
31710 CONTINUE
      CALL TRIMSD(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,MAXNXT,
     1            XTEMP1,RIGHT,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
31715 CONTINUE
      CALL CORRAT(TEMP,TEMPZ,NS2,ICASPL,IWRITE,XTEMP1,ETA,
     1            IBUGG3,ISUBRO,IERROR)
      RIGHT=ETA
      IF(ICASPL.EQ.'ICCR')RIGHT=ETA**2
      GOTO79000
C
11540 CONTINUE
      CALL LOWHIN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR)
      GOTO79000
11550 CONTINUE
      CALL UPPHIN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR)
      GOTO79000
11560 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR)
      GOTO79000
11570 CONTINUE
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR)
      GOTO79000
11575 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      RIGHT=(RIGH2 + RIGH1)/2.0
      GOTO79000
11576 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      RIGH3=(RIGH2 + RIGH1)/2.0
      CALL LOWQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH4,IBUGG3,IERROR)
      CALL UPPQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH5,IBUGG3,IERROR)
      RIGH6=(RIGH4 + RIGH5)/2.0
      RIGHT=RIGH3 - RIGH6
      GOTO79000
11578 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH3,IBUGG3,IERROR)
      RIGH4=(RIGH2 + RIGH1)/2.0
      RIGHT=(RIGH4 + RIGH3)/2.0
      GOTO79000
11579 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH3,IBUGG3,IERROR)
      RIGH4=(RIGH2 + RIGH1)/2.0
      RIGH5=(RIGH4 + RIGH3)/2.0
      CALL LOWQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH6,IBUGG3,IERROR)
      CALL UPPQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH7,IBUGG3,IERROR)
      CALL MEDIAN(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH8,IBUGG3,IERROR)
      RIGH9=(RIGH7 + RIGH6)/2.0
      RIGH10=(RIGH9 + RIGH8)/2.0
      RIGHT=RIGH5-RIGH10
      GOTO79000
C
11580 CONTINUE
      CALL TRIMME(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,XTEMP1,
     1            MAXNXT,RIGHT,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
11590 CONTINUE
      CALL WINDME(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,XTEMP1,
     1            MAXNXT,RIGHT,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
11610 CONTINUE
      IF(ICASPL.EQ.'MIDQ')P100=50.0
      IF(ICASPL.EQ.'1DEC')P100=10.0
      IF(ICASPL.EQ.'2DEC')P100=20.0
      IF(ICASPL.EQ.'3DEC')P100=30.0
      IF(ICASPL.EQ.'4DEC')P100=40.0
      IF(ICASPL.EQ.'5DEC')P100=50.0
      IF(ICASPL.EQ.'6DEC')P100=60.0
      IF(ICASPL.EQ.'7DEC')P100=70.0
      IF(ICASPL.EQ.'8DEC')P100=80.0
      IF(ICASPL.EQ.'9DEC')P100=90.0
      CALL PERCEN(P100,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,
     1RIGHT,IBUGG3,IERROR)
      GOTO79000
C
11615 CONTINUE
      IF(APVAL.GE.0.0 .AND. APVAL.LE.100.0)THEN
        P100=APVAL
      ELSEIF(IPNAM1.NE.'    ')THEN
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IPNAM1,IPNAM2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        P100=VALUE(ILOCP)
      ELSE
        IHP='P100'
        IHP2='    '
        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
        P100=VALUE(ILOCP)
      ENDIF
C
      CALL PERCEN(P100,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,
     1RIGHT,IBUGG3,IERROR)
      GOTO79000
C
11620 CONTINUE
      CALL WEMEAN(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11625 CONTINUE
      CALL WEOSME(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11630 CONTINUE
      CALL WEMEDI(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11640 CONTINUE
      CALL WESD(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11650 CONTINUE
      CALL WEVARI(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11655 CONTINUE
      CALL WESKEW(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11660 CONTINUE
C
      CALL WETRME(TEMP,TEMPZ,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,XTEMP2,
     1            MAXNXT,RIGHT,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
11670 CONTINUE
      IF(ICASPL.EQ.'WSUM')THEN
        IFLAGW=1
      ELSEIF(ICASPL.EQ.'WSSQ')THEN
        IFLAGW=2
      ELSEIF(ICASPL.EQ.'WSAB')THEN
        IFLAGW=3
      ELSEIF(ICASPL.EQ.'WAAB')THEN
        IFLAGW=4
      ELSEIF(ICASPL.EQ.'WSDV')THEN
        IFLAGW=5
      ELSEIF(ICASPL.EQ.'WSSD')THEN
        IFLAGW=6
      ENDIF
      CALL WESUM(TEMP,TEMPZ,NS2,IFLAGW,IWRITE,RIGHT,
     1           IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
11680 CONTINUE
      CALL WECOVA(TEMP,TEMPZ,TEMPZ3,NS2,ICASPL,IWRITE,RIGH1,RIGH2,
     1           IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'WCOV')RIGHT=RIGH1
      IF(ICASPL.EQ.'WCOR')RIGHT=RIGH2
      GOTO79000
C
11685 CONTINUE
      CALL GRPCOR(TEMP,TEMPZ,TEMPZ3,NS2,IWRITE,RIGHT,
     1            XTEMP1,XTEMP2,MAXOBV,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
11690 CONTINUE
      CALL WECODI(TEMP,TEMPZ,TEMPZ3,NS2,ICASPL,IWRITE,RIGH1,RIGH2,
     1           IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'WCDI')RIGHT=RIGH1
      IF(ICASPL.EQ.'WCSI')RIGHT=RIGH2
      GOTO79000
C
11700 CONTINUE
      CALL SDMEAN(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      RIGHT=RIGHT**2
      GOTO79000
C
11710 CONTINUE
      CALL SINFIT(TEMP,XTEMP2,NS2,IWRITE,XSINFR,XSINAM,XRESSD,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=XSINFR
      GOTO79000
C
11720 CONTINUE
      CALL SINFIT(TEMP,XTEMP2,NS2,IWRITE,XSINFR,XSINAM,XRESSD,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=XSINAM
      GOTO79000
C
11730 CONTINUE
      CALL LINFIT(TEMP,TEMPZ,NS2,
     1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=ALPHA
      GOTO79000
C
11735 CONTINUE
      CALL LINFIT(TEMP,TEMPZ,NS2,
     1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=SDALPH
      GOTO79000
C
11740 CONTINUE
      CALL LINFIT(TEMP,TEMPZ,NS2,
     1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=BETA
      GOTO79000
C
11745 CONTINUE
      CALL LINFIT(TEMP,TEMPZ,NS2,
     1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=SDBETA
      GOTO79000
C
11750 CONTINUE
      CALL LINFIT(TEMP,TEMPZ,NS2,
     1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=XRESSD
      GOTO79000
C
11760 CONTINUE
      CALL LINFIT(TEMP,TEMPZ,NS2,
     1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=CCXY
      GOTO79000
C
11770 CONTINUE
      CALL REPEAZ(TEMP,TEMPZ,XTEMP1,XTEMP2,NS2,IWRITE,XREP,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=XREP
      GOTO79000
C
11780 CONTINUE
      CALL REPROD(TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,NS2,IWRITE,XREP,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=XREP
      GOTO79000
C
11790 CONTINUE
      CALL MEAN(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
C
11795 CONTINUE
      CALL SD(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
C
11810 CONTINUE
      CALL TAGUCH(TEMP,NS2,ICASPL,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
C
11900 CONTINUE
      IHP='LSL '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ENGLSL=VALUE(ILOCP)
C
      IHP='USL '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ENGUSL=VALUE(ILOCP)
C
      IF(ICASPL.EQ.'CP')THEN
         CALL CP(TEMP,NS2,ENGLSL,ENGUSL,IWRITE,
     1           RIGHT,XLCL,XUCL,IBUGG3,IERROR)
         GOTO79000
      ELSEIF(ICASPL.EQ.'CPK')THEN
         CALL CPK(TEMP,NS2,ENGLSL,ENGUSL,IWRITE,
     1            RIGHT,XLCL,XUCL,IBUGG3,IERROR)
         GOTO79000
      ELSEIF(ICASPL.EQ.'CPL')THEN
         CALL CPL(TEMP,NS2,ENGLSL,ENGUSL,IWRITE,
     1            RIGHT,XLCL,XUCL,IBUGG3,IERROR)
         GOTO79000
      ELSEIF(ICASPL.EQ.'CPU')THEN
         CALL CPU(TEMP,NS2,ENGLSL,ENGUSL,IWRITE,
     1            RIGHT,XLCL,XUCL,IBUGG3,IERROR)
         GOTO79000
      ELSEIF(ICASPL.EQ.'CNP')THEN
         CALL CNP(TEMP,NS2,XTEMP1,MAXNXT,ENGLSL,ENGUSL,IWRITE,ICNPKD,
     1            RIGHT,IBUGG3,IERROR)
         GOTO79000
      ELSEIF(ICASPL.EQ.'CNPK')THEN
         CALL CNPK(TEMP,NS2,XTEMP1,MAXNXT,ENGLSL,ENGUSL,IWRITE,ICNPKD,
     1             RIGHT,IBUGG3,IERROR)
         GOTO79000
      ENDIF
C
      IF(ICASPL.EQ.'PEDE')THEN
         IFLAG='ACTU'
         CALL PERDEF(TEMP,NS2,ENGLSL,ENGUSL,IWRITE,
     1               RIGHT,RIJUNK,
     1               YACTL,YTHEL,YACTU,YTHEU,
     1               IFLAG,IBUGG3,IERROR)
         GOTO79000
      ENDIF
C
      IF(ICASPL.EQ.'EXLO')THEN
         IHP='USLC'
         IHP2='OST '
         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
         COSUSL=VALUE(ILOCP)
C
         CALL EXPLOS(TEMP,NS2,ENGLSL,ENGUSL,COSUSL,IWRITE,
     1               RIGHT,IBUGG3,IERROR)
         GOTO79000
      ENDIF
C
      IHP='TARG'
      IHP2='ET  '
      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
      TARGET=VALUE(ILOCP)
C
      IF(ICASPL.EQ.'CPM')THEN
         CALL CPM(TEMP,NS2,ENGLSL,ENGUSL,TARGET,IWRITE,
     1            RIGHT,XLCL,XUCL,IBUGG3,IERROR)
         GOTO79000
      ELSEIF(ICASPL.EQ.'CPMK')THEN
         CALL CPMK(TEMP,NS2,ENGLSL,ENGUSL,TARGET,IWRITE,
     1             RIGHT,XLCL,XUCL,IBUGG3,IERROR)
         GOTO79000
      ELSEIF(ICASPL.EQ.'CC')THEN
         CALL CC(TEMP,NS2,ENGLSL,ENGUSL,TARGET,IWRITE,
     1           RIGHT,IBUGG3,IERROR)
         GOTO79000
      ELSEIF(ICASPL.EQ.'CNPM')THEN
         CALL CNPM(TEMP,NS2,XTEMP1,MAXNXT,ENGLSL,ENGUSL,TARGET,
     1             IWRITE,ICNPKD,
     1             RIGHT,IBUGG3,IERROR)
         GOTO79000
      ELSEIF(ICASPL.EQ.'NPMK')THEN
         CALL CNPMK(TEMP,NS2,XTEMP1,MAXNXT,ENGLSL,ENGUSL,TARGET,
     1              IWRITE,ICNPKD,
     1              RIGHT,IBUGG3,IERROR)
         GOTO79000
      ENDIF
C
11910 CONTINUE
      SHAPE=0.0
      IF(ICASPL.EQ.'TLPP' .OR. ICASPL.EQ.'TLSH' .OR.
     1   ICASPL.EQ.'TLLO' .OR. ICASPL.EQ.'TLSC')THEN
        IHP='LAMB'
        IHP2='DA  '
        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
          SHAPE=CPUMIN
        ELSE
          SHAPE=VALUE(ILOCP)
        ENDIF
      ELSEIF(ICASPL.EQ.'LNPP' .OR. ICASPL.EQ.'LNSH' .OR.
     1       ICASPL.EQ.'LNLO' .OR. ICASPL.EQ.'LNSC')THEN
        IHP='SIGM'
        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)
        IF(IERROR.EQ.'YES')THEN
          SHAPE=CPUMIN
        ELSE
          SHAPE=VALUE(ILOCP)
        ENDIF
      ELSEIF(ICASPL.EQ.'GHPP' .OR. ICASPL.EQ.'GHSH' .OR.
     1       ICASPL.EQ.'GHS2' .OR. ICASPL.EQ.'GHLO' .OR.
     1       ICASPL.EQ.'GHSC')THEN
        IHP='G   '
        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)
        IF(IERROR.EQ.'YES')THEN
          SHAPE=CPUMIN
        ELSE
          SHAPE=VALUE(ILOCP)
        ENDIF
        IHP='H   '
        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)
        IF(IERROR.EQ.'YES')THEN
          SHAPE2=CPUMIN
        ELSE
          SHAPE2=VALUE(ILOCP)
        ENDIF
      ELSEIF(ICASPL.EQ.'GPPC' .OR. ICASPL.EQ.'GSHA' .OR.
     1       ICASPL.EQ.'GSCA' .OR. ICASPL.EQ.'GLOC')THEN
        IHP='G   '
        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)
        IF(IERROR.EQ.'YES')THEN
          SHAPE=CPUMIN
        ELSE
          SHAPE=VALUE(ILOCP)
        ENDIF
      ELSEIF(ICASPL.EQ.'WEPP' .OR. ICASPL.EQ.'WESH' .OR.
     1       ICASPL.EQ.'WELO' .OR. ICASPL.EQ.'WESC' .OR.
     1       ICASPL.EQ.'W2PP' .OR. ICASPL.EQ.'WESC' .OR.
     1       ICASPL.EQ.'W2SH' .OR.
     1       ICASPL.EQ.'GPPP' .OR. ICASPL.EQ.'GPSH' .OR.
     1       ICASPL.EQ.'GPLO' .OR. ICASPL.EQ.'GPSC' .OR.
     1       ICASPL.EQ.'FLPP' .OR. ICASPL.EQ.'FLSH' .OR.
     1       ICASPL.EQ.'FLLO' .OR. ICASPL.EQ.'FLSC' .OR.
     1       ICASPL.EQ.'GAPP' .OR. ICASPL.EQ.'GASH' .OR.
     1       ICASPL.EQ.'GALO' .OR. ICASPL.EQ.'GASC' .OR.
     1       ICASPL.EQ.'IWPP' .OR. ICASPL.EQ.'IWSH' .OR.
     1       ICASPL.EQ.'IWLO' .OR. ICASPL.EQ.'IWSC' .OR.
     1       ICASPL.EQ.'WAPP' .OR. ICASPL.EQ.'WASH' .OR.
     1       ICASPL.EQ.'WALO' .OR. ICASPL.EQ.'WASC')THEN
        IHP='GAMM'
        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)
        IF(IERROR.EQ.'YES')THEN
          SHAPE=CPUMIN
        ELSE
          SHAPE=VALUE(ILOCP)
          IF(SHAPE.LE.0.0)SHAPE=CPUMIN
        ENDIF
      ENDIF
      CALL NORPPC(TEMP,NS2,IDIST,SHAPE,SHAPE2,
     1            IWRITE,XTEMP1,XTEMP2,XTEMP3,DTEMP1,MAXNXT,
     1            MINMAX,IGEPDF,
     1            RIGHT,SHAPE3,SHAPE4,ALOC,SCALE,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'WESH' .OR. ICASPL.EQ.'TLSH' .OR.
     1   ICASPL.EQ.'LNSH' .OR. ICASPL.EQ.'GPSH' .OR.
     1   ICASPL.EQ.'FLSH' .OR. ICASPL.EQ.'IWSH' .OR.
     1   ICASPL.EQ.'GASH' .OR. ICASPL.EQ.'GSHA' .OR.
     1   ICASPL.EQ.'W2SH' .OR.
     1   ICASPL.EQ.'GHSH' .OR. ICASPL.EQ.'WASH')RIGHT=SHAPE3
      IF(ICASPL.EQ.'GHS2')RIGHT=SHAPE4
      IF(ICASPL.EQ.'WELO' .OR. ICASPL.EQ.'TLLO' .OR.
     1   ICASPL.EQ.'NOLO' .OR. ICASPL.EQ.'UNLO' .OR.
     1   ICASPL.EQ.'CALO' .OR. ICASPL.EQ.'LOLO' .OR.
     1   ICASPL.EQ.'DELO' .OR. ICASPL.EQ.'COLO' .OR.
     1   ICASPL.EQ.'ANLO' .OR. ICASPL.EQ.'ARLO' .OR.
     1   ICASPL.EQ.'EXLO' .OR. ICASPL.EQ.'HSLO' .OR.
     1   ICASPL.EQ.'SLLO' .OR. ICASPL.EQ.'MXLO' .OR.
     1   ICASPL.EQ.'RALO' .OR. ICASPL.EQ.'HNLO' .OR.
     1   ICASPL.EQ.'HCLO' .OR. ICASPL.EQ.'SCLO' .OR.
     1   ICASPL.EQ.'LNLO' .OR. ICASPL.EQ.'GPLO' .OR.
     1   ICASPL.EQ.'GHLO' .OR. ICASPL.EQ.'WALO' .OR.
     1   ICASPL.EQ.'FLLO' .OR. ICASPL.EQ.'GALO' .OR.
     1   ICASPL.EQ.'IWLO' .OR. ICASPL.EQ.'SILO' .OR.
     1   ICASPL.EQ.'GLOC' .OR.
     1   ICASPL.EQ.'G1LO' .OR. ICASPL.EQ.'G2LO'
     1)RIGHT=ALOC
      IF(ICASPL.EQ.'WESC' .OR. ICASPL.EQ.'TLSC' .OR.
     1   ICASPL.EQ.'NOSC' .OR. ICASPL.EQ.'UNSC' .OR.
     1   ICASPL.EQ.'W2SC' .OR.
     1   ICASPL.EQ.'CASC' .OR. ICASPL.EQ.'LOSC' .OR.
     1   ICASPL.EQ.'DESC' .OR. ICASPL.EQ.'COSC' .OR.
     1   ICASPL.EQ.'ANSC' .OR. ICASPL.EQ.'ARSC' .OR.
     1   ICASPL.EQ.'EXSC' .OR. ICASPL.EQ.'HSSC' .OR.
     1   ICASPL.EQ.'SLSC' .OR. ICASPL.EQ.'MXSC' .OR.
     1   ICASPL.EQ.'RASC' .OR. ICASPL.EQ.'HNSC' .OR.
     1   ICASPL.EQ.'HCSC' .OR. ICASPL.EQ.'SCSC' .OR.
     1   ICASPL.EQ.'LNSC' .OR. ICASPL.EQ.'GPSC' .OR.
     1   ICASPL.EQ.'GHSC' .OR. ICASPL.EQ.'WASC' .OR.
     1   ICASPL.EQ.'GASC' .OR. ICASPL.EQ.'FLSC' .OR.
     1   ICASPL.EQ.'IWSC' .OR. ICASPL.EQ.'SISC' .OR.
     1   ICASPL.EQ.'GSCA' .OR.
     1   ICASPL.EQ.'G1SC' .OR. ICASPL.EQ.'G2SC'
     1)RIGHT=SCALE
      GOTO79000
C
11915 CONTINUE
C
C     FOR WEIBULL CASE WHEN GAUGE LENGTH OPTION IS ON, CHECK FOR
C     L PARAMETER
C
      IF(IDIST.EQ.'WEIB' .AND. IWEIGL.EQ.'ON')THEN
        IHP='L   '
        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)
        IF(IERROR.EQ.'YES')THEN
          AL=0.0
        ELSE
          AL=VALUE(ILOCP)
          IF(AL.LE.0.0)AL=0.0
        ENDIF
      ELSE
        AL=0.0
      ENDIF
      CALL NORADA(TEMP,NS2,IDIST,IWRITE,MAXNXT,
     1            TEMPZ,TEMPZ3,XTEMP1,XTEMP2,XTEMP3,
     1            DTEMP1,DTEMP2,DTEMP3,ITEMP1,
     1            MINMAX,IGEPDF,IDFTTY,IWEIGL,AL,
     1            STATVA,SHAPE1,SHAPE2,ALOC,SCALE,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'NOAD' .OR. ICASPL.EQ.'EXAD' .OR.
     1   ICASPL.EQ.'DXAD' .OR. ICASPL.EQ.'GUAD' .OR.
     1   ICASPL.EQ.'GAAD' .OR. ICASPL.EQ.'WEAD' .OR.
     1   ICASPL.EQ.'LNAD' .OR. ICASPL.EQ.'LOAD' .OR.
     1   ICASPL.EQ.'UNAD' .OR. ICASPL.EQ.'MXAD' .OR.
     1   ICASPL.EQ.'RAAD' .OR. ICASPL.EQ.'FLAD' .OR.
     1   ICASPL.EQ.'FRAD' .OR. ICASPL.EQ.'LXAD' .OR.
     1   ICASPL.EQ.'IGAD' .OR. ICASPL.EQ.'B1AD' .OR.
     1   ICASPL.EQ.'GEAD'
     1  )RIGHT=STATVA
      IF(ICASPL.EQ.'NADL' .OR. ICASPL.EQ.'EADL' .OR.
     1   ICASPL.EQ.'DXAL' .OR. ICASPL.EQ.'GUAL' .OR.
     1   ICASPL.EQ.'LOAL' .OR. ICASPL.EQ.'UNAL' .OR.
     1   ICASPL.EQ.'MXAL' .OR. ICASPL.EQ.'RAAL'
     1   )RIGHT=ALOC
      IF(ICASPL.EQ.'GAAZ' .OR. ICASPL.EQ.'WEAZ' .OR.
     1   ICASPL.EQ.'LNAZ' .OR. ICASPL.EQ.'FLAZ' .OR.
     1   ICASPL.EQ.'FRAZ' .OR. ICASPL.EQ.'LXAZ' .OR.
     1   ICASPL.EQ.'IGAZ' .OR. ICASPL.EQ.'B1AZ' .OR.
     1   ICASPL.EQ.'GEAZ'
     1  )RIGHT=SHAPE1
      IF(ICASPL.EQ.'NADS' .OR. ICASPL.EQ.'EADS' .OR.
     1   ICASPL.EQ.'DXAS' .OR. ICASPL.EQ.'GUAS' .OR.
     1   ICASPL.EQ.'LOAS' .OR. ICASPL.EQ.'UNAS' .OR.
     1   ICASPL.EQ.'MXAS' .OR. ICASPL.EQ.'RAAS' .OR.
     1   ICASPL.EQ.'GAAS' .OR. ICASPL.EQ.'WEAS' .OR.
     1   ICASPL.EQ.'FLAS' .OR. ICASPL.EQ.'FRAS' .OR.
     1   ICASPL.EQ.'LXAS' .OR. ICASPL.EQ.'IGAS' .OR.
     1   ICASPL.EQ.'B1AS' .OR. ICASPL.EQ.'GEAS' .OR.
     1   ICASPL.EQ.'LNAS'
     1  )RIGHT=SCALE
      GOTO79000
C
11920 CONTINUE
      CALL BCNORM(TEMP,NS2,XTEMP1,XTEMP2,XTEMP3,
     1            PPCC,ALAMBA,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'BCPP')RIGHT=PPCC
      IF(ICASPL.EQ.'BCLA')RIGHT=ALAMBA
      GOTO79000
C
11933 CONTINUE
      CALL MINIM(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL MAXIM(TEMP,NS2,IWRITE,RIGH2,IBUGG3,IERROR)
      IF(RIGH1.GE.0.0)THEN
        ASIGN1=1.0
      ELSE
        ASIGN1=-1.0
      ENDIF
      IF(RIGH2.GE.0.0)THEN
        ASIGN2=1.0
      ELSE
        ASIGN2=-1.0
      ENDIF
      RIGH1=ABS(RIGH1)
      RIGH2=ABS(RIGH2)
      IF(RIGH2.GT.RIGH1)THEN
        RIGHT=RIGH2
        RIGHT=ASIGN2*RIGHT
      ELSE
        RIGHT=RIGH1
        RIGHT=ASIGN1*RIGHT
      ENDIF
      GOTO79000
11935 CONTINUE
      ICASE2='MEAN'
      CALL AAD(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,ICASE2,IBUGG3,IERROR)
      GOTO79000
11938 CONTINUE
      ICASE2='MEDI'
      CALL AAD(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,ICASE2,IBUGG3,IERROR)
      GOTO79000
11940 CONTINUE
      CALL MAD(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT,IBUGG3,IERROR)
      IF(ICASPL.EQ.'MADN')RIGHT=RIGHT/0.67449
      GOTO79000
C
11950 CONTINUE
      CALL GEOMEA(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11960 CONTINUE
      CALL GEOSD(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11970 CONTINUE
      CALL HARMEA(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11980 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      IF(ICASPL.EQ.'SIQU' .OR. ICASPL.EQ.'SIQL')THEN
        CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH3,IBUGG3,IERROR)
      ENDIF
      RIGHT=RIGH2-RIGH1
      IF(ICASPL.EQ.'NIQR')THEN
        RIGHT=0.7413*RIGHT
      ELSEIF(ICASPL.EQ.'SIQU')THEN
        RIGHT=RIGH2-RIGH3
      ELSEIF(ICASPL.EQ.'SIQL')THEN
        RIGHT=RIGH3-RIGH1
      ENDIF
      GOTO79000
11981 CONTINUE
CCCCC 2017/12: ALLOW QUANTILE METHOD TO BE SPECIFIED
CCCCC CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RQ1,IBUGG3,IERROR)
CCCCC CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RQ3,IBUGG3,IERROR)
      QNT=0.25
      CALL QUANT(QNT,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,IQUAME,RQ1,
     1           IBUGG3,IERROR)
      QNT=0.75
      CALL QUANT(QNT,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,IQUAME,RQ3,
     1           IBUGG3,IERROR)
      RIGHT=(RQ3 - RQ1)/(RQ1 + RQ3)
      GOTO79000
C
11982 CONTINUE
C
      IHP='QUAN'
      IHP2='T   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      XQUANT=VALUE(ILOCP)
C
      CALL QQRANG(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,XQUANT,RIGHT,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
11983 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RQ1,IBUGG3,IERROR)
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RQ3,IBUGG3,IERROR)
      RIGH1=(RQ3 - RQ1)/(RQ1 + RQ3)
      CALL LOWQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RQ1,IBUGG3,IERROR)
      CALL UPPQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RQ3,IBUGG3,IERROR)
      RIGH2=(RQ3 - RQ1)/(RQ1 + RQ3)
      RIGHT=RIGH1 - RIGH2
      GOTO79000
C
11990 CONTINUE
      CALL BIWLOC(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT,
     1IBUGG3,IERROR)
      GOTO79000
C
12000 CONTINUE
      CALL BIWSCA(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT,
     1IBUGG3,IERROR)
      GOTO79000
C
12010 CONTINUE
      CALL WINSOR(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,XTEMP2,
     1            IBUGG3,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      CALL VAR(XTEMP2,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
C
12030 CONTINUE
      CALL WINSOR(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,XTEMP2,
     1            IBUGG3,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GOTO79000
C
12050 CONTINUE
      CALL WINSOR(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,XTEMP2,
     1            IBUGG3,ISUBRO,IERROR)
      DO12052I=1,NS2
        TEMP(I)=XTEMP2(I)
12052 CONTINUE
      CALL WINSOR(TEMPZ,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,XTEMP2,
     1            IBUGG3,ISUBRO,IERROR)
      DO12054I=1,NS2
        TEMPZ(I)=XTEMP2(I)
12054 CONTINUE
      CALL COV(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
C
12070 CONTINUE
      CALL WINSOR(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,XTEMP2,
     1            IBUGG3,ISUBRO,IERROR)
      DO12072I=1,NS2
        TEMP(I)=XTEMP2(I)
12072 CONTINUE
      CALL WINSOR(TEMPZ,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,XTEMP2,
     1            IBUGG3,ISUBRO,IERROR)
      DO12074I=1,NS2
        TEMPZ(I)=XTEMP2(I)
12074 CONTINUE
      CALL CORR(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
C
12090 CONTINUE
      CALL BIWMDV(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT,
     1IBUGG3,IERROR)
      GOTO79000
C
12100 CONTINUE
      CALL BIWMCV(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT,
     1IBUGG3,IERROR)
      GOTO79000
C
12110 CONTINUE
      CALL PBNMDV(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,BETA,
     1            IBUGG3,IERROR)
      GOTO79000
C
12115 CONTINUE
      CALL PBNCOR(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,
     1            RIGHT,BETA,
     1            IBUGG3,IERROR)
      GOTO79000
C
12120 CONTINUE
      DO12122I=1,NS2
        ITEMP1(I)=0
        ITEMP2(I)=0
        ITEMP3(I)=0
12122 CONTINUE
      CALL HLQEST(TEMP,NS2,XTEMP1,ITEMP1,ITEMP2,ITEMP3,ISEED,RIGHT)
      GOTO79000
C
12130 CONTINUE
C
      IF(APVAL.GE.0.0 .AND. APVAL.LE.1.0)THEN
        XQ=APVAL
      ELSEIF(IPNAM1.NE.'    ')THEN
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IPNAM1,IPNAM2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        XQ=VALUE(ILOCP)
      ELSE
        IHP='XQ  '
        IHP2='    '
        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
        XQ=VALUE(ILOCP)
      ENDIF
C
      CALL QUANT(XQ,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,
     1IQUAME,
     1RIGHT,IBUGG3,IERROR)
      GOTO79000
C
12135 CONTINUE
C
      IHP='XQNU'
      IHP2='M   '
      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
        XQNUM=0.9
      ELSE
        XQNUM=VALUE(ILOCP)
        IF(XQNUM.GT.1.0 .AND. XQNUM.LE.100.0)XQNUM=XQNUM/100.0
        IF(XQNUM.LT.0.0 .OR. XQNUM.GT.100.0)XQNUM=0.9
      ENDIF
C
      IHP='XQDE'
      IHP2='NOM '
      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
        XQDEN=0.4
      ELSE
        XQDEN=VALUE(ILOCP)
        IF(XQDEN.GT.1.0 .AND. XQDEN.LE.100.0)XQDEN=XQDEN/100.0
        IF(XQDEN.LT.0.0 .OR. XQDEN.GT.100.0)XQDEN=0.4
      ENDIF
C
      CALL DECRAT(TEMP,NS2,IWRITE,XQNUM,XQDEN,
     1            RIGHT,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
12140 CONTINUE
C
      IF(APVAL.GE.0.0 .AND. APVAL.LE.1.0)THEN
        XQ=APVAL
      ELSEIF(IPNAM1.NE.'    ')THEN
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IPNAM1,IPNAM2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        XQ=VALUE(ILOCP)
      ELSE
        IHP='XQ  '
        IHP2='    '
        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
        XQ=VALUE(ILOCP)
      ENDIF
C
      CALL QUANSE(XQ,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,
     1IQUASE,
     1RIGHT,IBUGG3,IERROR)
      GOTO79000
C
12150 CONTINUE
      CALL TRIMSE(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,XTEMP2,MAXNXT,RIGHT,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
12160 CONTINUE
      CALL BIWMDV(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH1,
     1IBUGG3,IERROR)
      CALL BIWMDV(TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH2,
     1IBUGG3,IERROR)
      CALL BIWMCV(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH3,
     1IBUGG3,IERROR)
      RIGH4=RIGH1*RIGH2
      IF(RIGH4.GT.0.0)THEN
        RIGHT=RIGH3/SQRT(RIGH4)
      ELSE
        RIGHT=0.0
      ENDIF
      GOTO79000
C
12172 CONTINUE
      CALL COMDIG(TEMP,NS2,IWRITE,RIGHT,NRIGH,IBUGG3,IERROR)
      GOTO79000
C
12174 CONTINUE
      CALL COMDIG(TEMP,NS2,IWRITE,RIGHT,NRIGH,IBUGG3,IERROR)
      RIGHT=REAL(NRIGH)
      GOTO79000
C
12176 CONTINUE
      RIGHT=SN(TEMP,NS2,XTEMP1,XTEMP2,XTEMP3)
      GOTO79000
C
12178 CONTINUE
      RIGHT=QN(TEMP,NS2,XTEMP1,XTEMP2,XTEMP3,
     1        ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6)
      GOTO79000
C
12180 CONTINUE
      CALL MEAN(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL MEAN(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12182 CONTINUE
      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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
      ELSE
        ALPHA=0.95
      ENDIF
C
      CALL HEDGEG(TEMP,TEMPZ,NS2,NSZ,IWRITE,STATVA,STATBC,STATSE,
     1            ALPHA,ALCL,AUCL,
     1            YMEAN1,YSD1,YMEAN2,YSD2,SPOOL,
     1            ICASPL,ISUBRO,IBUGG3,IERROR)
      RIGHT=STATVA
      IF(ICASPL.EQ.'BCHG')THEN
        RIGHT=STATBC
      ELSEIF(ICASPL.EQ.'BCHG')THEN
        RIGHT=STATBC
      ELSEIF(ICASPL.EQ.'HESE')THEN
        RIGHT=STATSE
      ELSEIF(ICASPL.EQ.'HELC')THEN
        RIGHT=ALCL
      ELSEIF(ICASPL.EQ.'HEUC')THEN
        RIGHT=AUCL
      ENDIF
      GOTO79000
C
12190 CONTINUE
      CALL MIDMEA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL MIDMEA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12200 CONTINUE
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL MEDIAN(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12210 CONTINUE
      CALL TRIMME(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,RIGH1,
     1            IBUGG3,ISUBRO,IERROR)
      CALL TRIMME(TEMPZ,NSZ,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,RIGH2,
     1            IBUGG3,ISUBRO,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12220 CONTINUE
      CALL WINDME(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,RIGH1,
     1            IBUGG3,ISUBRO,IERROR)
      CALL WINDME(TEMPZ,NSZ,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,RIGH2,
     1            IBUGG3,ISUBRO,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12230 CONTINUE
      CALL GEOMEA(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL GEOMEA(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12240 CONTINUE
      CALL HARMEA(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL HARMEA(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12250 CONTINUE
      DO12252I=1,NS2
        ITEMP1(I)=0
        ITEMP2(I)=0
        ITEMP3(I)=0
12252 CONTINUE
      CALL HLQEST(TEMP,NS2,XTEMP1,ITEMP1,ITEMP2,ITEMP3,ISEED,RIGH1)
      DO12254I=1,NSZ
        ITEMP1(I)=0
        ITEMP2(I)=0
        ITEMP3(I)=0
12254 CONTINUE
      CALL HLQEST(TEMPZ,NSZ,XTEMP1,ITEMP1,ITEMP2,ITEMP3,ISEED,RIGH2)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12260 CONTINUE
      CALL BIWLOC(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH1,
     1IBUGG3,IERROR)
      CALL BIWLOC(TEMPZ,NSZ,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH2,
     1IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12270 CONTINUE
      CALL SD(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL SD(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12275 CONTINUE
      CALL RMS(TEMP,NS2,IWRITE,RIGH1,IBUGG3,ISUBRO,IERROR)
      CALL RMS(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,ISUBRO,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12280 CONTINUE
      CALL VAR(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL VAR(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12282 CONTINUE
      CALL VAR(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL VAR(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      IF(RIGH1.GT.0.0)THEN
        RIGH1=1.0/RIGH1
      ELSE
        RIGH1=0.0
        IERROR='YES'
      ENDIF
      IF(RIGH2.GT.0.0)THEN
        RIGH2=1.0/RIGH2
      ELSE
        RIGH2=0.0
        IERROR='YES'
      ENDIF
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12284 CONTINUE
      CALL SD(TEMP,NS2,IWRITE,RIGHTV,IBUGG3,IERROR)
      CALL MEAN(TEMP,NS2,IWRITE,RIGHTM,IBUGG3,IERROR)
      RIGH1=0.0
      IF(RIGHTV.NE.0.0)RIGH1=RIGHTM/RIGHTV
      CALL SD(TEMPZ,NSZ,IWRITE,RIGHTV,IBUGG3,IERROR)
      CALL MEAN(TEMPZ,NSZ,IWRITE,RIGHTM,IBUGG3,IERROR)
      RIGH2=0.0
      IF(RIGHTV.NE.0.0)RIGH2=RIGHTM/RIGHTV
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12290 CONTINUE
      ICASE2='MEAN'
      CALL AAD(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,ICASE2,IBUGG3,IERROR)
      CALL AAD(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,ICASE2,
     1         IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12295 CONTINUE
      ICASE2='MEDI'
      CALL AAD(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,ICASE2,IBUGG3,IERROR)
      CALL AAD(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,ICASE2,
     1         IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12300 CONTINUE
      CALL MAD(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH1,
     1         IBUGG3,IERROR)
      IF(ICASPL.EQ.'DMAN')RIGH1=RIGH1/0.67449
      CALL MAD(TEMPZ,NSZ,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH2,
     1         IBUGG3,IERROR)
      IF(ICASPL.EQ.'DMAN')RIGH2=RIGH2/0.67449
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12310 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH3,IBUGG3,IERROR)
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH4,IBUGG3,IERROR)
      RIGH1=RIGH4-RIGH3
      IF(ICASPL.EQ.'DNIQ')RIGH1=0.7413*(RIGH4-RIGH3)
      CALL LOWQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH5,IBUGG3,IERROR)
      CALL UPPQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH6,IBUGG3,IERROR)
      RIGH2=RIGH6-RIGH5
      IF(ICASPL.EQ.'DNIQ')RIGH2=0.7413*(RIGH6-RIGH5)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12320 CONTINUE
      CALL WINSOR(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,XTEMP2,
     1            IBUGG3,ISUBRO,IERROR)
      CALL SD(XTEMP2,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL WINSOR(TEMPZ,NSZ,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,XTEMP2,
     1            IBUGG3,ISUBRO,IERROR)
      CALL SD(XTEMP2,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12330 CONTINUE
      CALL WINSOR(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,XTEMP2,
     1            IBUGG3,ISUBRO,IERROR)
      CALL VAR(XTEMP2,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL WINSOR(TEMPZ,NSZ,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,XTEMP2,
     1            IBUGG3,ISUBRO,IERROR)
      CALL VAR(XTEMP2,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12340 CONTINUE
      CALL BIWMDV(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH1,
     1IBUGG3,IERROR)
      CALL BIWMDV(TEMPZ,NSZ,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH2,
     1IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12350 CONTINUE
      CALL BIWSCA(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH1,
     1IBUGG3,IERROR)
      CALL BIWSCA(TEMPZ,NSZ,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH2,
     1IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12360 CONTINUE
      CALL PBNMDV(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,BETA,
     1            IBUGG3,IERROR)
      CALL PBNMDV(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,BETA,
     1            IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12370 CONTINUE
      CALL GEOSD(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL GEOSD(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12380 CONTINUE
      CALL RANGDP(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL RANGDP(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12390 CONTINUE
      CALL MIDRAN(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL MIDRAN(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12400 CONTINUE
C
      IF(APVAL.GE.0.0 .AND. APVAL.LE.1.0)THEN
        XQ=APVAL
      ELSEIF(IPNAM1.NE.'    ')THEN
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IPNAM1,IPNAM2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        XQ=VALUE(ILOCP)
      ELSE
        IHP='XQ  '
        IHP2='    '
        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
        XQ=VALUE(ILOCP)
      ENDIF
C
      CALL QUANSE(XQ,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,
     1IQUASE,
     1RIGH1,IBUGG3,IERROR)
      CALL QUANSE(XQ,TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,
     1IQUASE,
     1RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12405 CONTINUE
C
      IF(APVAL.GE.0.0 .AND. APVAL.LE.1.0)THEN
        XQ=APVAL
      ELSEIF(IPNAM1.NE.'    ')THEN
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IPNAM1,IPNAM2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        XQ=VALUE(ILOCP)
      ELSE
        IHP='XQ  '
        IHP2='    '
        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
        XQ=VALUE(ILOCP)
      ENDIF
C
      CALL QUANT(XQ,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,
     1IQUAME,
     1RIGH1,IBUGG3,IERROR)
      CALL QUANT(XQ,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,
     1IQUAME,
     1RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12410 CONTINUE
      CALL STMOM3(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL STMOM3(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12412 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,Q1,IBUGG3,IERROR)
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,Q3,IBUGG3,IERROR)
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,Q2,IBUGG3,IERROR)
      IF(Q1.NE.Q3)THEN
        RIGH1=(Q3 + Q1 - 2.0*Q2)/(Q3 - Q1)
      ELSE
        RIGH1=CPUMIN
      ENDIF
C
      CALL LOWQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,Q1,IBUGG3,IERROR)
      CALL UPPQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,Q3,IBUGG3,IERROR)
      CALL MEDIAN(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,Q2,IBUGG3,IERROR)
      IF(Q1.NE.Q3)THEN
        RIGH2=(Q3 + Q1 - 2.0*Q2)/(Q3 - Q1)
      ELSE
        RIGH2=CPUMIN
      ENDIF
C
      IF(RIGH1.EQ.CPUMIN .OR. RIGH2.EQ.CPUMIN)THEN
        RIGHT=CPUMIN
      ELSE
        RIGHT=RIGH1-RIGH2
      ENDIF
      GOTO79000
C
12414 CONTINUE
      CALL MEAN(TEMP,NS2,IWRITE,YMEAN,IBUGG3,IERROR)
      CALL SD(TEMP,NS2,IWRITE,YSD,IBUGG3,IERROR)
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,YMED,IBUGG3,IERROR)
      IF(YSD.GT.0.0)THEN
        RIGHT=3.0*(YMEAN-YMED)/YSD
      ELSE
        RIGHT=CPUMIN
      ENDIF
C
      CALL MEAN(TEMPZ,NSZ,IWRITE,YMEAN,IBUGG3,IERROR)
      CALL SD(TEMPZ,NSZ,IWRITE,YSD,IBUGG3,IERROR)
      CALL MEDIAN(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,YMED,IBUGG3,IERROR)
      IF(YSD.GT.0.0)THEN
        RIGH2=3.0*(YMEAN-YMED)/YSD
      ELSE
        RIGH2=CPUMIN
      ENDIF
C
      IF(RIGH1.EQ.CPUMIN .OR. RIGH2.EQ.CPUMIN)THEN
        RIGHT=CPUMIN
      ELSE
        RIGHT=RIGH1-RIGH2
      ENDIF
      GOTO79000
C
12420 CONTINUE
      CALL STMOM4(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL STMOM4(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12425 CONTINUE
      CALL STMOM4(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      RIGH1=RIGH1-3.0
      CALL STMOM4(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGH2=RIGH2-3.0
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12430 CONTINUE
      CALL RELSD(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL RELSD(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12440 CONTINUE
      CALL SDMEAN(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL SDMEAN(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12450 CONTINUE
      CALL MEAN(TEMP,NS2,IWRITE,RIGHTM,IBUGG3,IERROR)
      CALL VAR(TEMP,NS2,IWRITE,RIGHTV,IBUGG3,IERROR)
      RIGH1=0.0
      IF(RIGHTM.NE.0.0)RIGH1=100.0*RIGHTV/ABS(RIGHTM)
      CALL MEAN(TEMPZ,NSZ,IWRITE,RIGHTM,IBUGG3,IERROR)
      CALL VAR(TEMPZ,NSZ,IWRITE,RIGHTV,IBUGG3,IERROR)
      RIGH2=0.0
      IF(RIGHTM.NE.0.0)RIGH2=100.0*RIGHTV/ABS(RIGHTM)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12460 CONTINUE
      CALL SDMEAN(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      RIGH1=RIGH1**2
      CALL SDMEAN(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGH2=RIGH2**2
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12470 CONTINUE
      CALL MINIM(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL MINIM(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12480 CONTINUE
      CALL MAXIM(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL MAXIM(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12490 CONTINUE
      CALL MINIM(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL MAXIM(TEMP,NS2,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGH1=ABS(RIGH1)
      RIGH2=ABS(RIGH2)
      RIGH3=RIGH1
      IF(RIGH2.GT.RIGH1)RIGH3=RIGH2
C
      CALL MINIM(TEMPZ,NSZ,IWRITE,RIGH4,IBUGG3,IERROR)
      CALL MAXIM(TEMPZ,NSZ,IWRITE,RIGH5,IBUGG3,IERROR)
      RIGH4=ABS(RIGH4)
      RIGH5=ABS(RIGH5)
      RIGH6=RIGH4
      IF(RIGH5.GT.RIGH4)RIGH6=RIGH5
      RIGHT=RIGH3-RIGH6
      GOTO79000
C
12495 CONTINUE
      CALL SD(TEMP,NS2,IWRITE,RIGHTV,IBUGG3,IERROR)
      CALL MEAN(TEMP,NS2,IWRITE,RIGHTM,IBUGG3,IERROR)
      RIGH1=0.0
      IF(RIGHTM.NE.0.0)RIGH1=RIGHTV/RIGHTM
      CALL SD(TEMPZ,NSZ,IWRITE,RIGHTV,IBUGG3,IERROR)
      CALL MEAN(TEMPZ,NSZ,IWRITE,RIGHTM,IBUGG3,IERROR)
      RIGH2=0.0
      IF(RIGHTM.NE.0.0)RIGH2=RIGHTV/RIGHTM
      RIGHT=RIGH1-RIGH2
      GOTO79000
12500 CONTINUE
      CALL SIZE(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL SIZE(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12510 CONTINUE
      CALL SUMDP(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL SUMDP(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12512 CONTINUE
      CALL PROD(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL PROD(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12520 CONTINUE
      RIGH1=SN(TEMP,NS2,XTEMP1,XTEMP2,XTEMP3)
      RIGH2=SN(TEMPZ,NSZ,XTEMP1,XTEMP2,XTEMP3)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12530 CONTINUE
      RIGH1=QN(TEMP,NS2,XTEMP1,XTEMP2,XTEMP3,
     1         ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6)
      RIGH2=QN(TEMPZ,NSZ,XTEMP1,XTEMP2,XTEMP3,
     1         ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12540 CONTINUE
      CALL LPLOC(TEMP,NS2,P,IWRITE,XTEMP1,DTEMP1,MAXNXT,RIGH1,
     1           IBUGG3,IERROR)
      CALL LPLOC(TEMPZ,NSZ,P,IWRITE,XTEMP1,DTEMP1,MAXNXT,RIGH2,
     1           IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12550 CONTINUE
      CALL LPVARI(TEMP,NS2,P,IWRITE,XTEMP1,DTEMP1,MAXNXT,RIGH1,
     1           IQUASE,IBUGG3,IERROR)
      CALL LPVARI(TEMPZ,NSZ,P,IWRITE,XTEMP1,DTEMP1,MAXNXT,RIGH2,
     1           IQUASE,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12560 CONTINUE
      CALL LPVARI(TEMP,NS2,P,IWRITE,XTEMP1,DTEMP1,MAXNXT,RIGH1,
     1           IQUASE,IBUGG3,IERROR)
      RIGH1=SQRT(RIGH1)
      CALL LPVARI(TEMPZ,NSZ,P,IWRITE,XTEMP1,DTEMP1,MAXNXT,RIGH2,
     1           IQUASE,IBUGG3,IERROR)
      RIGH2=SQRT(RIGH2)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12570 CONTINUE
      IHP='ALPH'
      IHP2='A   '
      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
        ALPHA=0.05
      ELSE
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.GT.1.0 .AND. ALPHA.LT.100.0)THEN
          ALPHA=ALPHA/100.0
        ELSEIF(ALPHA.GT.0.0 .AND. ALPHA.LT.1.0)THEN
          CONTINUE
        ELSE
          ALPHA=0.05
        ENDIF
      ENDIF
C
      CALL DPPRC4(TEMP,NS2,TEMPZ,NSZ,ALPHA,PSTAMV,IBI2ME,XTEMP1,
     1            YDIFF,ALOWLM,AUPPLM,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=YDIFF
      IF(ICASPL.EQ.'DBLC')RIGHT=ALOWLM
      IF(ICASPL.EQ.'DBUC')RIGHT=AUPPLM
      GOTO79000
C
12590 CONTINUE
      CALL TRIMSD(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,MAXNXT,
     1            XTEMP1,RIGH1,
     1            IBUGG3,ISUBRO,IERROR)
      CALL TRIMSD(TEMPZ,NSZ,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,MAXNXT,
     1            XTEMP1,RIGH2,
     1            IBUGG3,ISUBRO,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12600 CONTINUE
      IF(ICASPL.EQ.'MIDQ')P100=50.0
      IF(ICASPL.EQ.'1DEC')P100=10.0
      IF(ICASPL.EQ.'2DEC')P100=20.0
      IF(ICASPL.EQ.'3DEC')P100=30.0
      IF(ICASPL.EQ.'4DEC')P100=40.0
      IF(ICASPL.EQ.'5DEC')P100=50.0
      IF(ICASPL.EQ.'6DEC')P100=60.0
      IF(ICASPL.EQ.'7DEC')P100=70.0
      IF(ICASPL.EQ.'8DEC')P100=80.0
      IF(ICASPL.EQ.'9DEC')P100=90.0
      CALL PERCEN(P100,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,
     1RIGH1,IBUGG3,IERROR)
      CALL PERCEN(P100,TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,
     1RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12610 CONTINUE
      CALL LOWHIN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL LOWHIN(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
12620 CONTINUE
      CALL UPPHIN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL UPPHIN(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
12630 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL LOWQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
12640 CONTINUE
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL UPPQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12650 CONTINUE
      NCUT=0
      C=1.0
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH1=AH15
      CALL H15(TEMPZ,NSZ,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH2=AH15
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12660 CONTINUE
      NCUT=0
      C=1.2
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP1,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH1=AH15
      CALL H15(TEMPZ,NSZ,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH2=AH15
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12670 CONTINUE
      NCUT=0
      C=1.5
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH1=AH15
      CALL H15(TEMPZ,NSZ,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH2=AH15
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12680 CONTINUE
      NCUT=0
      C=1.7
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH1=AH15
      CALL H15(TEMPZ,NSZ,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH2=AH15
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12690 CONTINUE
      NCUT=0
      C=2.0
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH1=AH15
      CALL H15(TEMPZ,NSZ,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH2=AH15
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12700 CONTINUE
      NCUT=0
      C=1.0
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH1=XSC
      CALL H15(TEMPZ,NSZ,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH2=XSC
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12710 CONTINUE
      NCUT=0
      C=1.2
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH1=XSC
      CALL H15(TEMPZ,NSZ,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH2=XSC
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12720 CONTINUE
      NCUT=0
      C=1.5
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH1=XSC
      CALL H15(TEMPZ,NSZ,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH2=XSC
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12730 CONTINUE
      NCUT=0
      C=1.7
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH1=XSC
      CALL H15(TEMPZ,NSZ,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH2=XSC
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12740 CONTINUE
      NCUT=0
      C=2.0
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH1=XSC
      CALL H15(TEMPZ,NSZ,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH2=XSC
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12750 CONTINUE
C
      IHP='NREP'
      IHP2='L   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      NREPL=INT(VALUE(ILOCP)+0.5)
C
      ICASE='SD'
      CALL ROBPSD(TEMP,NS2,NREPL,XTEMP1,ICASE,IWRITE,MAXNXT,
     1            RIGHT,IERROR,ISUBRO,IBUGG3)
      GOTO79000
C
12760 CONTINUE
      NREPL=1
      ICASE='RANG'
      CALL ROBPSD(TEMP,NS2,NREPL,XTEMP1,ICASE,IWRITE,MAXNXT,
     1            RIGHT,IERROR,ISUBRO,IBUGG3)
      GOTO79000
C
31720 CONTINUE
      CALL LPLOC(TEMP,NS2,P,IWRITE,XTEMP1,DTEMP1,MAXNXT,RIGHT,
     1           IBUGG3,IERROR)
      GOTO79000
C
31730 CONTINUE
      CALL LPVARI(TEMP,NS2,P,IWRITE,XTEMP1,DTEMP1,MAXNXT,RIGHT,
     1           IQUASE,IBUGG3,IERROR)
      GOTO79000
C
31740 CONTINUE
      CALL LPVARI(TEMP,NS2,P,IWRITE,XTEMP1,DTEMP1,MAXNXT,RIGHT,
     1           IQUASE,IBUGG3,IERROR)
      RIGHT=SQRT(RIGHT)
      GOTO79000
C
31750 CONTINUE
      IHP='ALPH'
      IHP2='A   '
      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
        ALPHA=0.05
      ELSE
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.GT.1.0 .AND. ALPHA.LT.100.0)THEN
          ALPHA=ALPHA/100.0
        ELSEIF(ALPHA.GT.0.0 .AND. ALPHA.LT.1.0)THEN
          CONTINUE
        ELSE
          ALPHA=0.05
        ENDIF
      ENDIF
C
      CALL DPPRC3(TEMP,NS2,ALPHA,PSTAMV,IBINME,XTEMP1,
     1            RIGHT,ALOWLM,AUPPLM,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'BPLC')RIGHT=ALOWLM
      IF(ICASPL.EQ.'BPUC')RIGHT=AUPPLM
      GOTO79000
C
31760 CONTINUE
      CALL MININD(TEMP,NS2,IWRITE,PSTAMV,RIGHT,ISUBRO,IBUGG3,IERROR)
      GOTO79000
C
31770 CONTINUE
      CALL MAXIND(TEMP,NS2,IWRITE,PSTAMV,RIGHT,ISUBRO,IBUGG3,IERROR)
      GOTO79000
C
31780 CONTINUE
      CALL EXTIND(TEMP,NS2,IWRITE,PSTAMV,RIGHT,ISUBRO,IBUGG3,IERROR)
      GOTO79000
C
31790 CONTINUE
      CALL DPGRU3(TEMP,NS2,IWRITE,PSTAMV,XGRUB,XCDF,XDIR,XIND,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=XGRUB
      GOTO79000
C
31795 CONTINUE
      CALL DPGRU3(TEMP,NS2,IWRITE,PSTAMV,XGRUB,XCDF,XDIR,XIND,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=XCDF
      GOTO79000
C
31810 CONTINUE
      CALL DPGRU3(TEMP,NS2,IWRITE,PSTAMV,XGRUB,XCDF,XDIR,XIND,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=XDIR
      GOTO79000
C
31820 CONTINUE
      CALL DPGRU3(TEMP,NS2,IWRITE,PSTAMV,XGRUB,XCDF,XDIR,XIND,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=XIND
      GOTO79000
C
31825 CONTINUE
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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
      ELSE
        ALPHA=0.95
      ENDIF
C
      ALPHAT(1)=ALPHA
      NALPHA=1
      IDAVT2=IDAVTA
      IF(ICASPL.EQ.'DCDF' .OR. ICASPL.EQ.'DPVA')IDAVTA='SIMU'
C
      CALL DPDAV3(TEMP,NS2,XTEMP1,XTEMP2,IWRITE,PSTAMV,
     1            MAXNXT,IDAVTA,ISEED,
     1            ALPHAT,CV,NALPHA,
     1            STATVA,XMEAN,XSD,XRANGE,
     1            PVAL,CDF,XINDMN,XINDMX,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'DAVI')RIGHT=STATVA
      IF(ICASPL.EQ.'DCDF')RIGHT=CDF
      IF(ICASPL.EQ.'DPVA')RIGHT=PVAL
      IF(ICASPL.EQ.'DMNI')RIGHT=XINDMN
      IF(ICASPL.EQ.'DMXI')RIGHT=XINDMX
      IF(ICASPL.EQ.'DACV')RIGHT=CV(1)
      IDAVTA=IDAVT2
      GOTO79000
C
31828 CONTINUE
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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
      ELSE
        ALPHA=0.95
      ENDIF
C
      ALPHAT(1)=ALPHA
      NALPHA=1
      ISKOT2=ISKOTA
      IF(ICASPL.EQ.'SOCD' .OR. ICASPL.EQ.'SOPV')ISKOTA='SIMU'
C
      CALL DPSKO3(TEMP,NS2,XTEMP1,XTEMP2,IWRITE,PSTAMV,
     1            MAXNXT,ISKOTA,ISEED,
     1            ALPHAT,CV,NALPHA,
     1            STATVA,XMEAN,XSD,XMIN,XMAX,XSKEW,
     1            PVAL,STATCD,XINDX,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'SOUT')RIGHT=STATVA
      IF(ICASPL.EQ.'SOCD')RIGHT=STATCD
      IF(ICASPL.EQ.'SOPV')RIGHT=PVAL
      IF(ICASPL.EQ.'SOIN')RIGHT=XINDX
      IF(ICASPL.EQ.'SOCV')RIGHT=CV(1)
      ISKOTA=ISKOT2
      GOTO79000
C
31829 CONTINUE
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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
      ELSE
        ALPHA=0.95
      ENDIF
C
      ALPHAT(1)=ALPHA
      NALPHA=1
      IKUOT2=IKUOTA
      IF(ICASPL.EQ.'KOCD' .OR. ICASPL.EQ.'KOPV')IKUOTA='SIMU'
C
      CALL DPKUO3(TEMP,NS2,XTEMP1,XTEMP2,IWRITE,PSTAMV,
     1            MAXNXT,IKUOTA,ISEED,
     1            ALPHAT,CV,NALPHA,
     1            STATVA,XMEAN,XSD,XMIN,XMAX,XKURT,
     1            PVAL,STATCD,XINDX,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'KOUT')RIGHT=STATVA
      IF(ICASPL.EQ.'KOCD')RIGHT=STATCD
      IF(ICASPL.EQ.'KOPV')RIGHT=PVAL
      IF(ICASPL.EQ.'KOIN')RIGHT=XINDX
      IF(ICASPL.EQ.'KOCV')RIGHT=CV(1)
      IKUOTA=IKUOT2
      GOTO79000
C
31830 CONTINUE
      IHP='MU  '
      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
        AMU=0.0
      ELSE
        AMU=VALUE(ILOCP)
      ENDIF
C
      CALL DPTTE3(TEMP,NS2,AMU,IWRITE,STATVA,STATCD,STATNU,
     1            XMEAN,XSD,XSDM,DEL,
     1            PVAL2T,PVALLT,PVALUT,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'1TTE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'1TCD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'1T2P')THEN
        RIGHT=PVAL2T
      ELSEIF(ICASPL.EQ.'1TLP')THEN
        RIGHT=PVALLT
      ELSEIF(ICASPL.EQ.'1TUP')THEN
        RIGHT=PVALUT
      ENDIF
      GOTO79000
C
31840 CONTINUE
      CALL DPTTE4(TEMP,NS2,TEMPZ,NSZ,IWRITE,
     1            STATVA,STATCD,STATNU,
     1            STATV2,STATC2,STATN2,
     1            Y1MEAN,Y1SD,Y1SDM,
     1            Y2MEAN,Y2SD,Y2SDM,
     1            DEL,POOLSD,DELSD,DELSD2,CDFBAR,
     1            PVAL2T,PVALLT,PVALUT,
     1            ISUBRO,IBUGG3,IERROR)
C
C     FOR NOW, JUST RETURN THE "UNEQUAL VARIANCES" CASE.  MAY
C     ADD "EQUAL VARIANCES" CASE LATER (NEED TO ADD "ITTEVA"
C     TO THE CALL LIST.
C
      IF(ICASPL.EQ.'2TTE')THEN
        RIGHT=STATV2
      ELSEIF(ICASPL.EQ.'2TCD')THEN
        RIGHT=STATC2
      ELSEIF(ICASPL.EQ.'2T2P')THEN
        RIGHT=PVAL2T
      ELSEIF(ICASPL.EQ.'2TLP')THEN
        RIGHT=PVALLT
      ELSEIF(ICASPL.EQ.'2TUP')THEN
        RIGHT=PVALUT
      ENDIF
      GOTO79000
C
31845 CONTINUE
      CALL DPTTE6(TEMP,NS2,TEMPZ,NSZ,XTEMP1,IWRITE,
     1            STATVA,STATCD,STATNU,
     1            Y1MEAN,Y1SD,Y1SDM,
     1            Y2MEAN,Y2SD,Y2SDM,
     1            YDMEAN,YDSD,YDSDM,
     1            PVAL2T,PVALLT,PVALUT,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'PTTE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'PTCD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'PT2P')THEN
        RIGHT=PVAL2T
      ELSEIF(ICASPL.EQ.'PTLP')THEN
        RIGHT=PVALLT
      ELSEIF(ICASPL.EQ.'PTUP')THEN
        RIGHT=PVALUT
      ENDIF
      GOTO79000
C
31850 CONTINUE
      IHP='SIGM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      SIGMA0=VALUE(ILOCP)
C
      CALL DPCST3(TEMP,NS2,SIGMA0,IWRITE,
     1            STATVA,STATCD,STATNU,
     1            YMEAN,YSD,RATIO,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'CSSD')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'CCDF')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'CSLP')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'CSUP')THEN
        RIGHT=1.0 - STATCD
      ELSEIF(ICASPL.EQ.'CS2P')THEN
        IF(YSD.LE.SIGMA0)THEN
          RIGHT=2.0*STATCD
        ELSE
          RIGHT=2.0*(1.0 - STATCD)
        ENDIF
      ENDIF
      GOTO79000
C
31870 CONTINUE
      CALL DPFRT3(TEMP,NS2,IWRITE,XTEMP1,STATVA,STATCD,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=STATVA
      GOTO79000
C
31880 CONTINUE
      CALL DPFRT3(TEMP,NS2,IWRITE,XTEMP1,STATVA,STATCD,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=STATCD
      GOTO79000
C
31905 CONTINUE
C
      IHP='ALPH'
      IHP2='A   '
      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
        ALPHA=0.95
      ELSE
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.GT.1.0 .AND. ALPHA.LT.100.0)THEN
          ALPHA=ALPHA/100.0
        ELSEIF(ALPHA.GT.0.0 .AND. ALPHA.LT.1.0)THEN
          CONTINUE
        ELSE
          ALPHA=0.95
        ENDIF
      ENDIF
      CALL DPMSD3(TEMP,NS2,IWRITE,ALPHA,
     1            STATVA,STATV2,STATCD,PVAL,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=STATVA
      IF(ICASPL.EQ.'MSDN')RIGHT=STATV2
      IF(ICASPL.EQ.'MSDC')RIGHT=STATCD
      IF(ICASPL.EQ.'MSDP')RIGHT=PVAL
      IF(ICASPL.EQ.'ADCD')RIGHT=STATCD
      IF(ICASPL.EQ.'ADPV')RIGHT=PVAL
CCCCC IF(ICASPL.EQ.'AD01')GOTO31905
CCCCC IF(ICASPL.EQ.'AD05')GOTO31905
CCCCC IF(ICASPL.EQ.'AD95')GOTO31905
CCCCC IF(ICASPL.EQ.'AD99')GOTO31905
      GOTO79000
C
31890 CONTINUE
      IHP='M   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AM=VALUE(ILOCP)
      M=INT(AM+0.5)
C
      CALL DPFRT4(TEMP,NS2,M,IWRITE,XTEMP1,STATVA,STATCD,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=STATVA
      GOTO79000
C
31900 CONTINUE
      IHP='M   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AM=VALUE(ILOCP)
      M=INT(AM+0.5)
C
      CALL DPFRT4(TEMP,NS2,M,IWRITE,XTEMP1,STATVA,STATCD,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=STATCD
      GOTO79000
C
31910 CONTINUE
      NCUT=0
      C=1.0
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGHT=AH15
      GOTO79000
C
31920 CONTINUE
      NCUT=0
      C=1.2
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGHT=AH15
      GOTO79000
C
31930 CONTINUE
      NCUT=0
      C=1.5
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGHT=AH15
      GOTO79000
C
31940 CONTINUE
      NCUT=0
      C=1.7
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGHT=AH15
      GOTO79000
C
31950 CONTINUE
      NCUT=0
      C=2.0
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGHT=AH15
      GOTO79000
C
31960 CONTINUE
      NCUT=0
      C=1.0
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGHT=XSC
      GOTO79000
C
31970 CONTINUE
      NCUT=0
      C=1.2
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP1,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGHT=XSC
      GOTO79000
C
31980 CONTINUE
      NCUT=0
      C=1.5
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGHT=XSC
      GOTO79000
C
31990 CONTINUE
      NCUT=0
      C=1.7
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGHT=XSC
      GOTO79000
C
32000 CONTINUE
      NCUT=0
      C=2.0
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGHT=XSC
      GOTO79000
C
32010 CONTINUE
C
      IHP='NOUT'
      IHP2='LIER'
      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
        IR=1
      ELSE
        AVAL=VALUE(ILOCP)
        IR=INT(AVAL+0.1)
        IF(IR.LT.1)IR=1
        IF(IR.GT.NS2/2)IR=NS2/2
      ENDIF
C
      IF(ICASPL.EQ.'TM2S')THEN
        ICASAN='TWOS'
      ELSEIF(ICASPL.EQ.'TMMN')THEN
        ICASAN='MINI'
      ELSEIF(ICASPL.EQ.'TMMX')THEN
        ICASAN='MAXI'
      ENDIF
C
      CALL DPTIE3(TEMP,NS2,ICASAN,IR,
     1            XTEMP1,XTEMP2,XTEMP3,ITEMP1,ITEMP2,
     1            RIGHT,YMEAN,YSD,YMIN,YMAX,
     1            ISUBRO,IBUGG3,IERROR)
      GOTO79000
C
32020 CONTINUE
C
      IHP='NOUT'
      IHP2='LIER'
      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
        IR=1
      ELSE
        AVAL=VALUE(ILOCP)
        IR=INT(AVAL+0.1)
        IF(IR.LT.1)IR=1
        IF(IR.GT.NS2/2)IR=NS2/2
      ENDIF
C
      CALL DPGES3(TEMP,NS2,IR,
     1            XTEMP1,XTEMP2,ITEMP1,ITEMP2,
     1            RIGHT,
     1            ISUBRO,IBUGG3,IERROR)
      GOTO79000
C
 3185 CONTINUE
C
      IF(NUMV2.EQ.1)THEN
        YMEAN=CPUMIN
        YSD=CPUMIN
        IF(ICASPL.EQ.'SCVA')THEN
          CALL MEAN(TEMP,NS2,IWRITE,YMEAN,IBUGG3,IERROR)
          CALL SD(TEMP,NS2,IWRITE,YSD,IBUGG3,IERROR)
          IF(YMEAN.NE.0.0)THEN
            RIGHT=YSD/YMEAN
          ELSE
            RIGHT=CPUMAX
          ENDIF
          GOTO79000
        ENDIF
      ELSE
        YMEAN=TEMP(1)
        YSD=TEMPZ(1)
        IF(ICASPL.EQ.'SCVA')THEN
          IF(YMEAN.NE.0.0)THEN
            RIGHT=YSD/YMEAN
          ELSE
            RIGHT=CPUMAX
          ENDIF
          GOTO79000
        ENDIF
        NS2=INT(TEMPZ3(1)+0.1)
      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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.GT.1.0 .AND. ALPHA.LT.100.0)THEN
          ALPHA=ALPHA/100.0
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSEIF(ALPHA.GT.0.0 .AND. ALPHA.LT.1.0)THEN
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSE
          ALPHA=0.95
        ENDIF
      ELSE
        ALPHA=0.95
      ENDIF
C
      ICASA2='CVLI'
      ICASA3='UPPE'
      ICASA4='RAW'
      ICASA5='TWOS'
C
      IF(ICASPL(1:1).EQ.'S')ICASA4='SUMM'
C
      IF(ICASPL.EQ.'CVLC')ICASA3='LOWE'
      IF(ICASPL.EQ.'CVLO')ICASA3='LOWE'
      IF(ICASPL.EQ.'CVUC')ICASA3='UPPE'
      IF(ICASPL.EQ.'CVUO')ICASA3='UPPE'
      IF(ICASPL.EQ.'SCVL')ICASA3='LOWE'
      IF(ICASPL.EQ.'SCVU')ICASA3='UPPE'
C
      IF(ICASPL.EQ.'CVLO')ICASA5='ONES'
      IF(ICASPL.EQ.'CVUO')ICASA5='ONES'
C
      IDIST2='NORM'
      IF(ICASPL.EQ.'LLCV')IDIST2='LOGN'
      IF(ICASPL.EQ.'LLCV')ICASA3='LOWE'
      IF(ICASPL.EQ.'ULCV')IDIST2='LOGN'
      IF(ICASPL.EQ.'LCVA')IDIST2='LOGN'
C
      ALPHAT(1)=ALPHA
      NALPHA=1
C
      CALL DPCVC3(TEMP,NS2,YMEAN,YSD,
     1            ICASA2,ICASA3,ICASA4,ICASA5,
     1            ISEED,MAXNXT,IDIST2,
     1            XTEMP1,XTEMP2,
     1            ICVACI,ALPHAT,NALPHA,ALOWLV,AUPPLV,CVAR,
     1            ISUBRO,IBUGG3,IERROR)
C
      IF(ICASPL.EQ.'CVLC')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'CVLO')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'SCVL')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'CVUC')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'CVUO')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'SCVU')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'LCVA')RIGHT=CVAR
      IF(ICASPL.EQ.'LLCV')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'ULCV')RIGHT=AUPPLV(1)
C
      GOTO79000
C
 3195 CONTINUE
C
      IF(NUMV2.EQ.2)THEN
        ICASA4='RAW'
        DO3196II=1,NS2
          ITEMP1(II)=0
 3196   CONTINUE
      ELSEIF(NUMV2.EQ.3)THEN
        ICASA4='SUMM'
        DO3197II=1,NS2
          ITEMP1(II)=INT(TEMPZ3(II)+0.1)
 3197   CONTINUE
      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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.GT.1.0 .AND. ALPHA.LT.100.0)THEN
          ALPHA=ALPHA/100.0
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSEIF(ALPHA.GT.0.0 .AND. ALPHA.LT.1.0)THEN
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSE
          ALPHA=0.95
        ENDIF
      ELSE
        ALPHA=0.95
      ENDIF
C
      ICASA2='CVLI'
      ICASA3='UPPE'
      ICASA5='TWOS'
      ALPHAT(1)=ALPHA
      NALPHA=1
C
      CALL DPCVC4(TEMP,TEMPZ,NS2,ITEMP1,XTEMP1,XTEMP2,
     1            ICASA2,ICASA3,ICASA4,ICASA5,
     1            ALPHAT,NALPHA,ALOWLV,AUPPLV,
     1            AVAL1,AVAL2,NDIST,NGROUP,
     1            ISUBRO,IBUGG3,IERROR)
C
      IF(ICASPL.EQ.'CCVA')RIGHT=AVAL1
      IF(ICASPL.EQ.'UCCV')RIGHT=AVAL2
      IF(ICASPL.EQ.'LCCV')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'UCC2')RIGHT=AUPPLV(1)
      GOTO79000
C
32030 CONTINUE
C
      IF(ICASPL.EQ.'DI2S')THEN
        ICASAN='TWOS'
      ELSEIF(ICASPL.EQ.'DIMN')THEN
        ICASAN='MINI'
      ELSEIF(ICASPL.EQ.'DIMX')THEN
        ICASAN='MAXI'
      ENDIF
C
      CALL DPDIX3(TEMP,XTEMP1,NS2,XTEMP2,IWRITE,ICASAN,
     1            RIGHT,
     1            ISUBRO,IBUGG3,IERROR)
      GOTO79000
C
32040 CONTINUE
      EPS=0.1E-05
      XTEMP1(1)=PSTAMV
      XTEMP1(2)=PSTAMV
      CALL DISTIN(TEMP,NS2,IWRITE,XTEMP1,NDIST,IBUGG3,IERROR)
      IF(NDIST.GT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32041)
32041   FORMAT('***** ERROR FROM CMPSTA (AGRESTI-COUL BINOMIAL ',
     1         'LIMITS)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32042)
32042   FORMAT('      FOR AGRESTI-COUL LIMITS CASE, MORE THAN ',
     1         'TWO DISTINCT VALUES DETECTED.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32043)NDIST
32043   FORMAT('      NUMBER OF DISTINCT VALUES = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
C
C       IF ALL VALUES ARE EQUAL TO THE "MISSING VALUE",
C       THEN SET VALUE OF STATISTIC TO MISSING VALUE.
C
      ELSEIF(NDIST.EQ.1 .AND. XTEMP1(1).EQ.PSTAMV)THEN
        RIGHT=PSTAMV
        GOTO79000
      ENDIF
C
      HOLD1=XTEMP1(1)
      HOLD2=XTEMP1(2)
      IF(NDIST.EQ.1)THEN
        IF(XTEMP1(1).GE.0.5)THEN
          XMAX=XTEMP1(1)
          XMIN=CPUMIN
        ELSE
          XMIN=XTEMP1(1)
          XMAX=CPUMAX
        ENDIF
      ELSEIF(NDIST.EQ.2)THEN
        IF(HOLD1.LT.HOLD2)THEN
          XMIN=HOLD1
          XMAX=HOLD2
        ELSE
          XMAX=HOLD1
          XMIN=HOLD2
        ENDIF
      ENDIF
C
      DO32045I=1,NS2
        IF(TEMP(I).EQ.XMAX)THEN
          TEMP(I)=1.0
        ELSE
          TEMP(I)=0.0
        ENDIF
32045 CONTINUE
C
      XSUM=0.0
      DO32048I=1,NS2
        XSUM=XSUM + TEMP(I)
32048 CONTINUE
      P=XSUM/REAL(NS2)
C
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(ICASPL.EQ.'1LAC')THEN
        IDIR='LOWE'
        CALL DPAGC1(P,NS2,ALPHA,IDIR,IWRITE,RIGHT,IBUGG3,IERROR)
      ELSEIF(ICASPL.EQ.'1UAC')THEN
        IDIR='UPPE'
        CALL DPAGC1(P,NS2,ALPHA,IDIR,IWRITE,RIGHT,IBUGG3,IERROR)
      ELSEIF(ICASPL.EQ.'2LAC')THEN
        CALL DPAGCO(P,NS2,ALPHA,IWRITE,ALOWLM,AUPPLM,IBUGG3,IERROR)
        RIGHT=ALOWLM
      ELSEIF(ICASPL.EQ.'2UAC')THEN
        CALL DPAGCO(P,NS2,ALPHA,IWRITE,ALOWLM,AUPPLM,IBUGG3,IERROR)
        RIGHT=AUPPLM
      ENDIF
C
      GOTO79000
32050 CONTINUE
      EPS=0.1E-05
      XTEMP1(1)=PSTAMV
      XTEMP1(2)=PSTAMV
      CALL DISTIN(TEMP,NS2,IWRITE,XTEMP1,NDIST,IBUGG3,IERROR)
      IF(NDIST.GT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32051)
32051   FORMAT('***** ERROR FROM CMPSTA (EXACT BINOMIAL LIMITS)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32052)
32052   FORMAT('      FOR EXACT BINOMIAL LIMITS CASE, MORE THAN ',
     1         'TWO DISTINCT VALUES DETECTED.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32053)NDIST
32053   FORMAT('      NUMBER OF DISTINCT VALUES = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
C
C       IF ALL VALUES ARE EQUAL TO THE "MISSING VALUE",
C       THEN SET VALUE OF STATISTIC TO MISSING VALUE.
C
      ELSEIF(NDIST.EQ.1 .AND. XTEMP1(1).EQ.PSTAMV)THEN
        RIGHT=PSTAMV
        GOTO79000
      ENDIF
C
      HOLD1=XTEMP1(1)
      HOLD2=XTEMP1(2)
      IF(HOLD1.LT.HOLD2)THEN
        XMIN=HOLD1
        XMAX=HOLD2
      ELSE
        XMAX=HOLD1
        XMIN=HOLD2
      ENDIF
C
      DO32055I=1,NS2
        IF(TEMP(I).EQ.XMAX)THEN
          TEMP(I)=1.0
        ELSE
          TEMP(I)=0.0
        ENDIF
32055 CONTINUE
C
      XSUM=0.0
      DO32058I=1,NS2
        XSUM=XSUM + TEMP(I)
32058 CONTINUE
      P=XSUM/REAL(NS2)
C
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(ICASPL.EQ.'1LEB')THEN
        CALL DPEBLL(P,NS2,ALPHA,IWRITE,RIGHT,'ONES',IBUGG3,IERROR)
      ELSEIF(ICASPL.EQ.'1UEB')THEN
        CALL DPEBUL(P,NS2,ALPHA,IWRITE,RIGHT,'ONES',IBUGG3,IERROR)
      ELSEIF(ICASPL.EQ.'2LEB')THEN
        CALL DPEBLL(P,NS2,ALPHA,IWRITE,RIGHT,'TWOS',IBUGG3,IERROR)
      ELSEIF(ICASPL.EQ.'2UEB')THEN
        CALL DPEBUL(P,NS2,ALPHA,IWRITE,RIGHT,'TWOS',IBUGG3,IERROR)
      ENDIF
      GOTO79000
C
32060 CONTINUE
C
      IHP='ALPH'
      IHP2='A   '
      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
        ALPHA=0.95
      ELSE
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.LE.0.0)THEN
          ALPHA=0.95
        ELSEIF(ALPHA.GE.1.0 .OR. ALPHA.LE.100.0)THEN
          ALPHA=ALPHA/100.0
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSEIF(ALPHA.LT.0.5)THEN
          ALPHA=1.0 - ALPHA
        ENDIF
      ENDIF
C
      ALPHAT(1)=100.0*ALPHA
      NUMALP=1
      CALL DPADK3(TEMP,TEMPZ,NS2,ALPHAT,NUMALP,
     1            XTEMP1,XTEMP2,DTEMP1,DTEMP2,DTEMP3,ITEMP1,ITEMP2,
     1            ITEMP3,ITEMP4,
     1            ADKSTA,ADC,DSD,IFLGZZ,NBCH,MINSIZ,MAXSIZ,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'ADKS')RIGHT=ADKSTA
      IF(ICASPL.EQ.'ADKC')RIGHT=ADC(1)
      GOTO79000
C
32070 CONTINUE
C
C     FOR VARIOUS CONSENSUS MEANS COMMANDS, IF WE HAVE RAW DATA
C     WE FIRST NEED TO CONVERT TO SUMMARY DATA (I.E., MEAN, SD's,
C     AND SAMPLE SIZES) BEFORE CALLING APPROPRIATE METHOD.
C
      CALL DISTIN(TEMPZ,NS2,IWRITE,XTEMP1,NLAB,IBUGG3,IERROR)
C
      DO32075I=1,NLAB
        ATEMP=XTEMP1(I)
        NTEMP=0
        DO32079J=1,NS2
          IF(TEMPZ(J).EQ.ATEMP)THEN
            NTEMP=NTEMP+1
            TEMPZ3(NTEMP)=TEMP(J)
          ENDIF
32079   CONTINUE
        ITEMP1(I)=NTEMP
C
        CALL MEAN(TEMPZ3,NTEMP,IWRITE,AMEAN,IBUGG3,IERROR)
        CALL SD(TEMPZ3,NTEMP,IWRITE,ASD,IBUGG3,IERROR)
        XTEMP2(I)=AMEAN
        XTEMP3(I)=ASD
C
32075 CONTINUE
C
      DO32080I=1,NLAB
        TEMP(I)=XTEMP2(I)
        TEMPZ(I)=XTEMP3(I)
        TEMPZ3(I)=REAL(ITEMP1(I))
32080 CONTINUE
      NS2=NLAB
C
      IF(ICASPL.EQ.'DSLA')GOTO32100
      IF(ICASPL.EQ.'DHHD')GOTO32100
      IF(ICASPL.EQ.'DSMM')GOTO32100
      IF(ICASPL.EQ.'DSSE')GOTO32100
      IF(ICASPL.EQ.'MPAU')GOTO32200
      IF(ICASPL.EQ.'MPSE')GOTO32200
      IF(ICASPL.EQ.'MMPA')GOTO32200
      IF(ICASPL.EQ.'MMPS')GOTO32200
      IF(ICASPL.EQ.'VARU')GOTO32200
      IF(ICASPL.EQ.'VRSE')GOTO32200
      IF(ICASPL.EQ.'BOB ')GOTO32300
      IF(ICASPL.EQ.'BOBS')GOTO32300
      IF(ICASPL.EQ.'GCIN')GOTO32400
      IF(ICASPL.EQ.'GCIS')GOTO32400
      IF(ICASPL.EQ.'BCP ')GOTO32500
      IF(ICASPL.EQ.'BCPS')GOTO32500
      IF(ICASPL.EQ.'MMEA')GOTO32600
      IF(ICASPL.EQ.'MMES')GOTO32600
      IF(ICASPL.EQ.'FAIR')GOTO32700
      IF(ICASPL.EQ.'FWSE')GOTO32700
      IF(ICASPL.EQ.'GDEA')GOTO32800
      IF(ICASPL.EQ.'GDSE')GOTO32800
      IF(ICASPL.EQ.'GDSN')GOTO32800
      IF(ICASPL.EQ.'GDZ1')GOTO32800
      IF(ICASPL.EQ.'GDZ2')GOTO32800
      IF(ICASPL.EQ.'SCEB')GOTO32900
      IF(ICASPL.EQ.'SESE')GOTO32900
C
32100 CONTINUE
C
C     CHECK FOR LABS WITH LESS THAN 2 OBSERVATIONS OR WITH
C     NON-POSITIVE STANDARD DEVIATION.
C
      IPRINT='OFF'
      NLAB=NS2
      NPTS=0
      IF(NLAB.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32101)
32101   FORMAT('***** ERROR FROM CMPSTA (DERSIMONIAN-LAIRD ',
     1         'ESTIMATION)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32103)
32103   FORMAT('      THE NUMBER OF LABS IS LESS THAN TWO.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      DO32111I=1,NLAB
        ITEMP9=INT(TEMPZ3(I)+0.1)
        IF(TEMPZ(I).LE.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32101)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32113)I,TEMPZ(I)
32113     FORMAT('      LAB ',I6,' HAS NON-POSITIVE STANDARD ',
     1           'DEVIATION (= ',G15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSEIF(ITEMP9.LE.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32101)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32118)I
32118     FORMAT('      LAB ',I6,' HAS LESS THAN 2 OBSERVATIONS.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
        ITEMP1(I)=ITEMP9
        NPTS=NPTS+ITEMP9
32111 CONTINUE
C
      ICAPSW='XXXX'
      ICAPTY='XXXX'
      NUMDIG=-99
      IWRITE='OFF'
CCCCC IOUNI5=-99
CCCCC CALL DPDERS(NPTS,NLAB,
CCCCC1            TEMP,TEMPZ,ITEMP1,
CCCCC1            XTEMP3(1),XTEMP3(MAXNXT/2),ITEMP2,
CCCCC1            XTEMP1,XTEMP2,DTEMP1,
CCCCC1            DTEMP2,DTEMP2(5001),DTEMP3,
CCCCC1            XDL,XDLS2,YDL,SEDLK1,SEDLK2,DLOWDL,DHIGDL,
CCCCC1            SERUK1,SERUK2,DLOWD2,DHIGD2,
CCCCC1            SEHDK1,SEHDK2,DLOWD3,DHIGD3,
CCCCC1            SEBOK1,SEBOK2,DLOWD4,DHIGD4,
CCCCC1            DLOWD5,DHIGD5,DLOWD6,DHIGD6,
CCCCC1            AK2,AK3,
CCCCC1            IWRITE,IOUNI5,
CCCCC1            ICAPSW,ICAPTY,NUMDIG,ISEED,
CCCCC1            ISUBRO,IBUGG3,IERROR)
CCCCC IF(ICASPL.EQ.'DSLA')RIGHT=XDL
CCCCC IF(ICASPL.EQ.'DHHD')RIGHT=SEHDK1
CCCCC IF(ICASPL.EQ.'DSMM')RIGHT=SERUK1
CCCCC IF(ICASPL.EQ.'DSSE')RIGHT=SEDLK1
CCCCC IF(ICASPL.EQ.'DSBO')RIGHT=SEBOK1
      RIGHT=CPUMIN
      GOTO79000
C
32200 CONTINUE
C
C     CHECK FOR LABS WITH LESS THAN 2 OBSERVATIONS OR WITH
C     NON-POSITIVE STANDARD DEVIATION.
C
      IPRINT='OFF'
      NLAB=NS2
      NPTS=0
      IF(NLAB.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32201)
32201   FORMAT('***** ERROR FROM CMPSTA (MANDEL-PAULE ',
     1         'ESTIMATION)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32203)
32203   FORMAT('      THE NUMBER OF LABS IS LESS THAN TWO.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      DO32211I=1,NLAB
        ITEMP9=INT(TEMPZ3(I)+0.1)
        IF(TEMPZ(I).LE.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32201)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32213)I,TEMPZ(I)
32213     FORMAT('      LAB ',I6,' HAS NON-POSITIVE STANDARD ',
     1           'DEVIATION (= ',G15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSEIF(ITEMP9.LE.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32201)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32218)I
32218     FORMAT('      LAB ',I6,' HAS LESS THAN 2 OBSERVATIONS.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
        ITEMP1(I)=ITEMP9
        NPTS=NPTS+ITEMP9
32211 CONTINUE
C
      T0=10000000.D0
      T1=-T0
C
      AMNX=CPUMAX
      AMXX=CPUMIN
      AMNSD=CPUMAX
      AMXSD=CPUMIN
C
      DO32250I=1,NLAB
C
        DTEMP1(I)=DBLE(TEMP(I))
        IF(DTEMP1(I).LT.T0) T0=DTEMP1(I)
        IF(DTEMP1(I).GT.T1) T1=DTEMP1(I)
        IF(TEMP(I).GT.AMXX)AMXX=TEMP(I)
        IF(TEMP(I).LT.AMNX)AMNX=TEMP(I)
C
        DTEMP2(I)=DBLE(TEMPZ(I))**2/DBLE(ITEMP1(I))
        IF(TEMPZ(I).GT.0.0)THEN
          IF(TEMPZ(I).LT.AMNSD)AMNSD=TEMPZ(I)
          IF(TEMPZ(I).GT.AMXSD)AMXSD=TEMPZ(I)
        ENDIF
C
32250 CONTINUE
C
      EPS=0.00001
      T0=AMNX - EPS
      T1=AMXX
      DO32270I=1,NS2
        DTEMP1(I)=(DTEMP1(I)-T0)/(T1-T0)
        DTEMP2(I)=DTEMP2(I)/((T1-T0)**2)
32270 CONTINUE
C
      ICAPSW='XXXX'
      ICAPTY='XXXX'
      NUMDIG=-99
      IWRITE='OFF'
C
      IF(ICASPL.EQ.'MPAU' .OR. ICASPL.EQ.'MPSE' .OR.
     1   ICASPL.EQ.'VARU' .OR. ICASPL.EQ.'VRSE')THEN
        CALL DPMNPL(TEMP,TEMPZ,TEMPZ3,NPTS,NLAB,
     1              DTEMP1,DTEMP2,ITEMP1,
     1              XMPS,S2BMPS,SEMP,SEMPK1,SEMPK2,
     1              DLOWMP,DHIGMP,STXMU,STS2B,
     1              IWRITE,
     1              ICAPSW,ICAPTY,NUMDIG,
     1              ISUBRO,IBUGG3,IERROR)
      ELSEIF(ICASPL.EQ.'MMPA' .OR. ICASPL.EQ.'MMPS')THEN
        CALL DPMMPL(TEMP,TEMPZ,TEMPZ3,NPTS,NLAB,
     1              DTEMP1,DTEMP2,ITEMP1,
     1              XMMPS,S2BMMP,SEMMP,SEMMP1,SEMMP2,
     1              DLOWMM,DHIGMM,
     1              IWRITE,
     1              ICAPSW,ICAPTY,NUMDIG,
     1              ISUBRO,IBUGG3,IERROR)
      ENDIF
C
      IF(ICASPL.EQ.'VARU' .OR. ICASPL.EQ.'VRSE')THEN
        CALL DPVRML(NPTS,NLAB,
     1              TEMP,TEMPZ,ITEMP1,
     1              XTEMP3(1),XTEMP3(MAXNXT/2),ITEMP2,XTEMP1,XTEMP2,
     1              DTEMP1,DTEMP2,DTEMP3,
     1              DTEMP2(MAXNXT/2),DTEMP3(MAXNXT/2),
     1              XMLS,S2BMLS,SEML,SEMLK1,SEMLK2,
     1              DLOWML,DHIGML,STXMU,STS2B,
     1              SEMLBO,DLOWM2,DHIGM2,
     1              IWRITE,
     1              ICAPSW,ICAPTY,IOUNI5,NUMDIG,ISEED,
     1              ISUBRO,IBUGG3,IERROR)
      ENDIF
C
      IF(ICASPL.EQ.'MPAU')RIGHT=XMPS
      IF(ICASPL.EQ.'MPSE')RIGHT=SEMP
      IF(ICASPL.EQ.'VARU')RIGHT=XMLS
      IF(ICASPL.EQ.'VRSE')RIGHT=SEML
      IF(ICASPL.EQ.'MMPA')RIGHT=XMMPS
      IF(ICASPL.EQ.'MMPS')RIGHT=SEMMP
      GOTO79000
C
32300 CONTINUE
C
C     CHECK FOR LABS WITH LESS THAN 2 OBSERVATIONS OR WITH
C     NON-POSITIVE STANDARD DEVIATION.
C
      IPRINT='OFF'
      NLAB=NS2
      NPTS=0
      IF(NLAB.LT.2 .OR. NLAB.GT.5)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32301)
32301   FORMAT('***** ERROR FROM CMPSTA (BOB ESTIMATION)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32303)
32303   FORMAT('      THE NUMBER OF LABS IS LESS THAN TWO OR ',
     1         'GREATER THAN FIVE.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      DO32311I=1,NLAB
        ITEMP9=INT(TEMPZ3(I)+0.1)
        IF(TEMPZ(I).LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32301)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32313)I,TEMPZ(I)
32313     FORMAT('      LAB ',I6,' HAS NEGATIVE STANDARD ',
     1           'DEVIATION (= ',G15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSEIF(ITEMP9.LE.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32301)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32318)I
32318     FORMAT('      LAB ',I6,' HAS LESS THAN 1 OBSERVATION.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
        ITEMP1(I)=ITEMP9
        NPTS=NPTS+ITEMP9
32311 CONTINUE
C
      AMNX=CPUMAX
      AMXX=CPUMIN
C
      DSUM1=0.0D0
      DO32350I=1,NLAB
        IF(TEMP(I).GT.AMXX)AMXX=TEMP(I)
        IF(TEMP(I).LT.AMNX)AMNX=TEMP(I)
        DSUM1=DSUM1 + DBLE(TEMPZ(I))**2/DBLE(ITEMP1(I))
32350 CONTINUE
      SW=REAL(DSQRT(DSUM1)/DBLE(NLAB))
C
      ICAPSW='XXXX'
      ICAPTY='XXXX'
      NUMDIG=-99
      IWRITE='OFF'
      CALL DPBOB(NPTS,NLAB,
     1           TEMP,TEMPZ,AMNX,AMXX,SW,
     1           ASM,ASB,AKU,AKUK1,AKUK2,
     1           DLOWBO,DHIGBO,
     1           IWRITE,
     1           ICAPSW,ICAPTY,NUMDIG,
     1           ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'BOB ')RIGHT=ASM
      IF(ICASPL.EQ.'BOBS')RIGHT=AKUK1
      GOTO79000
C
32400 CONTINUE
C
C     CHECK FOR LABS WITH LESS THAN 2 OBSERVATIONS OR WITH
C     NON-POSITIVE STANDARD DEVIATION.
C

      IPRINT='OFF'
      NLAB=NS2
      NPTS=0
      IF(NLAB.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32401)
32401   FORMAT('***** ERROR FROM CMPSTA (GENERALIZED CONFIDENCE ',
     1         'INTERVAL ESTIMATION)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32403)
32403   FORMAT('      THE NUMBER OF LABS IS LESS THAN TWO.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      DO32411I=1,NLAB
        ITEMP9=INT(TEMPZ3(I)+0.1)
        IF(TEMPZ(I).LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32401)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32413)I,TEMPZ(I)
32413     FORMAT('      LAB ',I6,' HAS NEGATIVE STANDARD ',
     1           'DEVIATION (= ',G15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSEIF(ITEMP9.LT.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32401)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32418)I
32418     FORMAT('      LAB ',I6,' HAS LESS THAN 1 OBSERVATION.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
        ITEMP1(I)=ITEMP9
        NPTS=NPTS+ITEMP9
32411 CONTINUE
C
      ICAPSW='XXXX'
      ICAPTY='XXXX'
      NUMDIG=-99
      IWRITE='OFF'
      CALL DPGCI(NPTS,NLAB,
     1           TEMP,TEMPZ,ITEMP1,
     1           DTEMP1,DTEMP2,
     1           XGCI,SEGCI,
     1           DLOWGC,DHIGGC,
     1           IWRITE,IOUNI5,
     1           ICAPSW,ICAPTY,NUMDIG,
     1           ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'GCIN')RIGHT=XGCI
      IF(ICASPL.EQ.'GCIS')RIGHT=SEGCI
      GOTO79000
C
32500 CONTINUE
C
C     CHECK FOR LABS WITH LESS THAN 2 OBSERVATIONS OR WITH
C     NON-POSITIVE STANDARD DEVIATION.
C
      IPRINT='OFF'
      NLAB=NS2
      NPTS=0
      IF(NLAB.LT.2 .OR. NLAB.GT.6)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32501)
32501   FORMAT('***** ERROR FROM CMPSTA (BCP ESTIMATION)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32503)
32503   FORMAT('      THE NUMBER OF LABS IS LESS THAN TWO OR ',
     1         'GREATER THAN SIX.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      DO32511I=1,NLAB
        ITEMP9=INT(TEMPZ3(I)+0.1)
        IF(TEMPZ(I).LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32501)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32513)I,TEMPZ(I)
32513     FORMAT('      LAB ',I6,' HAS NEGATIVE STANDARD ',
     1           'DEVIATION (= ',G15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSEIF(ITEMP9.LE.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32501)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32518)I
32518     FORMAT('      LAB ',I6,' HAS LESS THAN 1 OBSERVATION.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
        ITEMP1(I)=ITEMP9
        NPTS=NPTS+ITEMP9
32511 CONTINUE
C
      AMNX=CPUMAX
      AMXX=CPUMIN
C
      DO32550I=1,NLAB
        IF(TEMP(I).GT.AMXX)AMXX=TEMP(I)
        IF(TEMP(I).LT.AMNX)AMNX=TEMP(I)
32550 CONTINUE
C
      ICAPSW='XXXX'
      ICAPTY='XXXX'
      NUMDIG=-99
      IWRITE='OFF'
      CALL DPBCP(NPTS,NLAB,
     1           TEMP,TEMPZ,ITEMP1,AMNX,AMXX,
     1           XBCP,XBCPSE,XBCPK1,SBCPK2,
     1           DLOWBC,DHIGBC,
     1           IWRITE,
     1           ICAPSW,ICAPTY,NUMDIG,
     1           ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'BCP ')RIGHT=XBCP
      IF(ICASPL.EQ.'BCPS')RIGHT=XBCPSE
      GOTO79000
C
32600 CONTINUE
C
C     CHECK FOR LABS WITH LESS THAN 2 OBSERVATIONS OR WITH
C     NON-POSITIVE STANDARD DEVIATION.
C

      IPRINT='OFF'
      NLAB=NS2
      IF(NLAB.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32601)
32601   FORMAT('***** ERROR FROM CMPSTA (MEAN OF MEANS ESTIMATION)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32603)
32603   FORMAT('      THE NUMBER OF LABS IS LESS THAN TWO.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      CALL MEAN(TEMP,NLAB,IWRITE,ASM,IBUGG3,IERROR)
      CALL SD(TEMP,NLAB,IWRITE,ASD,IBUGG3,IERROR)
      IF(ICASPL.EQ.'MMEA')RIGHT=ASM
      IF(ICASPL.EQ.'MMES')RIGHT=ASD/SQRT(REAL(NLAB))
      GOTO79000
C
32700 CONTINUE
C
C     CHECK FOR LABS WITH LESS THAN 2 OBSERVATIONS OR WITH
C     NON-POSITIVE STANDARD DEVIATION.
C

      IPRINT='OFF'
      NLAB=NS2
      NPTS=0
      IF(NLAB.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32701)
32701   FORMAT('***** ERROR FROM CMPSTA (FAIRWEATHER ESTIMATION)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32703)
32703   FORMAT('      THE NUMBER OF LABS IS LESS THAN TWO.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      DO32711I=1,NLAB
        ITEMP9=INT(TEMPZ3(I)+0.1)
        IF(TEMPZ(I).LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32701)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32713)I,TEMPZ(I)
32713     FORMAT('      LAB ',I6,' HAS NEGATIVE STANDARD ',
     1           'DEVIATION (= ',G15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSEIF(ITEMP9.LT.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32701)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32718)I
32718     FORMAT('      LAB ',I6,' HAS LESS THAN 1 OBSERVATION.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
        ITEMP1(I)=ITEMP9
        NPTS=NPTS+ITEMP9
32711 CONTINUE
C
      ICAPSW='XXXX'
      ICAPTY='XXXX'
      NUMDIG=-99
      IWRITE='OFF'
      CALL DPFAIR(NPTS,NLAB,
     1            TEMP,TEMPZ,ITEMP1,
     1            XFW,XFWS2,SEFWK1,SEFWK2,
     1            DLOWFW,DHIGFW,DLOWF2,DHIGF2,DLOWF3,DHIGF3,
     1            IWRITE,
     1            ICAPSW,ICAPTY,IFLAG9,NUMDIG,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=CPUMIN
      IF(IFLAG9)THEN
        IF(ICASPL.EQ.'FAIR')RIGHT=XFW
        IF(ICASPL.EQ.'FWSE')RIGHT=SEFWK1
      ENDIF
      GOTO79000
C
32800 CONTINUE
C
C     CHECK FOR LABS WITH LESS THAN 2 OBSERVATIONS OR WITH
C     NON-POSITIVE STANDARD DEVIATION.
C
      IPRINT='OFF'
      NLAB=NS2
      NPTS=0
      IF(NLAB.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32801)
32801   FORMAT('***** ERROR FROM CMPSTA (GRAYBILL-DEAL ESTIMATION)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32803)
32803   FORMAT('      THE NUMBER OF LABS IS LESS THAN TWO.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      DO32811I=1,NLAB
        ITEMP9=INT(TEMPZ3(I)+0.1)
        IF(TEMPZ(I).LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32801)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32813)I,TEMPZ(I)
32813     FORMAT('      LAB ',I6,' HAS NEGATIVE STANDARD ',
     1           'DEVIATION (= ',G15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSEIF(ITEMP9.LT.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32801)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32818)I
32818     FORMAT('      LAB ',I6,' HAS LESS THAN 1 OBSERVATION.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
        ITEMP1(I)=ITEMP9
        NPTS=NPTS+ITEMP9
32811 CONTINUE
C
      ICAPSW='XXXX'
      ICAPTY='XXXX'
      NUMDIG=-99
      IWRITE='OFF'
      IOUNI5=-99
      CALL DPGRAY(NPTS,NLAB,
     1            TEMP,TEMPZ,ITEMP1,
     1            XGD,XGDS2,SEGDK1,SEGDK2,
     1            XGDS20,XGDSZ1,XGDSZ2,
     1            DLOWGD,DHIGGD,
     1            IWRITE,IOUNI5,
     1            ICAPSW,ICAPTY,NUMDIG,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'GDEA')RIGHT=XGD
      IF(ICASPL.EQ.'GDSE')RIGHT=SEGDK1
      IF(ICASPL.EQ.'GDSN')RIGHT=SQRT(XGDS20)
      IF(ICASPL.EQ.'GDZ1')RIGHT=SQRT(XGDSZ1)
      IF(ICASPL.EQ.'GDZ2')RIGHT=SQRT(XGDSZ2)
      GOTO79000
C
32900 CONTINUE
C
C     CHECK FOR LABS WITH LESS THAN 2 OBSERVATIONS OR WITH
C     NON-POSITIVE STANDARD DEVIATION.
C
      IPRINT='OFF'
      NLAB=NS2
      NPTS=0
      IF(NLAB.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32901)
32901   FORMAT('***** ERROR FROM CMPSTA (SCHILLER-EBERHARDT ',
     1         'ESTIMATION)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32903)
32903   FORMAT('      THE NUMBER OF LABS IS LESS THAN TWO.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      DO32911I=1,NLAB
        ITEMP9=INT(TEMPZ3(I)+0.1)
        IF(TEMPZ(I).LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32901)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32913)I,TEMPZ(I)
32913     FORMAT('      LAB ',I6,' HAS NEGATIVE STANDARD ',
     1           'DEVIATION (= ',G15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSEIF(ITEMP9.LT.2)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32901)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32918)I
32918     FORMAT('      LAB ',I6,' HAS LESS THAN 2 OBSERVATIONS.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
        ITEMP1(I)=ITEMP9
        NPTS=NPTS+ITEMP9
32911 CONTINUE
C
      IHP='SIGM'
      IHP2='AH  '
      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
        SIGMAH=0.0
      ELSE
        SIGMAH=VALUE(ILOCP)
        IF(SIGMAH.LT.0.0)SIGMAH=0.0
      ENDIF
      IHP='DFH '
      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
        IDFH=1
      ELSE
        IDFH=INT(VALUE(ILOCP)+ 0.5)
      ENDIF
      IF(IDFH.LE.0)IDFH=1
C
C     SCHILLER-EBERHARDT NEEDS TO CALL MANDEL-PAULE TO
C     OBTAIN "S2BMPS" VALUE.
C
      T0=10000000.D0
      T1=-T0
C
      AMNX=CPUMAX
      AMXX=CPUMIN
      AMNSD=CPUMAX
      AMXSD=CPUMIN
C
      DO32950I=1,NLAB
C
        DTEMP1(I)=DBLE(TEMP(I))
        IF(DTEMP1(I).LT.T0) T0=DTEMP1(I)
        IF(DTEMP1(I).GT.T1) T1=DTEMP1(I)
        IF(TEMP(I).GT.AMXX)AMXX=TEMP(I)
        IF(TEMP(I).LT.AMNX)AMNX=TEMP(I)
C
        DTEMP2(I)=DBLE(TEMPZ(I))**2/DBLE(ITEMP1(I))
        IF(TEMPZ(I).GT.0.0)THEN
          IF(TEMPZ(I).LT.AMNSD)AMNSD=TEMPZ(I)
          IF(TEMPZ(I).GT.AMXSD)AMXSD=TEMPZ(I)
        ENDIF
C
32950 CONTINUE
C
      EPS=0.00001
      T0=AMNX - EPS
      T1=AMXX
      DO32970I=1,NS2
        DTEMP1(I)=(DTEMP1(I)-T0)/(T1-T0)
        DTEMP2(I)=DTEMP2(I)/((T1-T0)**2)
32970 CONTINUE
C
      ICAPSW='XXXX'
      ICAPTY='XXXX'
      NUMDIG=-99
      IWRITE='OFF'
C
      CALL DPMNPL(TEMP,TEMPZ,TEMPZ3,NPTS,NLAB,
     1            DTEMP1,DTEMP2,ITEMP1,
     1            XMPS,S2BMPS,SEMP,SEMPK1,SEMPK2,
     1            DLOWMP,DHIGMP,STXMU,STS2B,
     1            IWRITE,
     1            ICAPSW,ICAPTY,NUMDIG,
     1            ISUBRO,IBUGG3,IERROR)
      CALL DPSCEB(NPTS,NLAB,
     1            DTEMP1,ITEMP1,
     1            TEMP,TEMPZ,S2BMPS,
     1            XSE,XSES2,IDFH,SIGMAH,
     1            SESUK1,SESUK2,
     1            DLOWSE,DHIGSE,
     1            IWRITE,
     1            ICAPSW,ICAPTY,NUMDIG,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'SCEB')RIGHT=XSE
      IF(ICASPL.EQ.'SESE')RIGHT=SESUK1
      GOTO79000
C
33100 CONTINUE
C
      IHP='ALPH'
      IHP2='A   '
      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
        ALPHA=0.95
      ELSE
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.EQ.90.0 .OR. ALPHA.EQ.0.90)THEN
          ALPHA=0.90
        ELSEIF(ALPHA.EQ.10.0 .OR. ALPHA.EQ.0.10)THEN
          ALPHA=0.90
        ELSEIF(ALPHA.EQ.99.0 .OR. ALPHA.EQ.0.99)THEN
          ALPHA=0.99
        ELSEIF(ALPHA.EQ.1.0 .OR. ALPHA.EQ.0.01)THEN
          ALPHA=0.99
        ELSEIF(ALPHA.EQ.95.0 .OR. ALPHA.EQ.0.95)THEN
          ALPHA=0.95
        ELSEIF(ALPHA.EQ.5.0 .OR. ALPHA.EQ.0.05)THEN
          ALPHA=0.95
        ELSE
          ALPHA=0.95
        ENDIF
      ENDIF
C
      CALL DP2KS3(TEMP,TEMPZ,NS2,NSZ,
     1            XTEMP1,
     1            STATVA,STATCD,CUTU90,CUTU95,CUTU99,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'KS2S')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'KSCV')THEN
        IF(ALPHA.EQ.0.90)THEN
          RIGHT=CUTU90
        ELSEIF(ALPHA.EQ.0.99)THEN
          RIGHT=CUTU99
        ELSE
          RIGHT=CUTU95
        ENDIF
      ENDIF
      GOTO79000
C
33105 CONTINUE
      IDATSW='RAW'
      CLWID=CLWIDT(1)
      XSTART=CLLIMI(1)
      XSTOP=CLLIMI(2)
      MAXOB2=MAXOBV/2
      IINDX=(MAXOBV/2) + 1
      CALL DP2CH3(TEMP,TEMPZ,TEMPZ3,NS2,NSZ,NSZ3,
     1            IDATSW,IRHSTG,
     1            CLWID,XSTART,XSTOP,
     1            CLWID2,DXSTAR,DXSTOP,
     1            XTEMP1,IHSTCW,IHSTOU,MAXOBV,MAXOB2,
     1            STATVA,STATCD,STATNU,NCELLS,
     1            Y1MEAN,Y1SD,Y1MIN,Y1MAX,
     1            Y2MEAN,Y2SD,Y2MIN,Y2MAX,
     1            XTEMP2,XTEMP3,XTEMP2(IINDX),XTEMP3(IINDX),M2,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'CS2S')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'CC2S')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'CP2S')THEN
        RIGHT=1.0 - STATCD
      ENDIF
      GOTO79000
C
33110 CONTINUE
C
      CALL DPWSH3(TEMP,NS2,
     1            XTEMP1,MAXNXT,
     1            STATVA,PVAL,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'WSHA')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'WSPV')THEN
        RIGHT=PVAL
      ENDIF
      GOTO79000
C
33120 CONTINUE
C
      CALL DPCUS3(TEMP,NS2,
     1            STATVA,STATV2,STATCD,STATC2,PVAL1,PVAL2,
     1            XTEMP1,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'CSFT')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'CSFP')THEN
        RIGHT=PVAL1
      ELSEIF(ICASPL.EQ.'CSBT')THEN
        RIGHT=STATV2
      ELSEIF(ICASPL.EQ.'CSBP')THEN
        RIGHT=PVAL2
      ENDIF
      GOTO79000
C
33130 CONTINUE
C
      IF(NUMV2.EQ.1)THEN
        XMEAN=CPUMIN
        XSD=CPUMIN
        AN=CPUMIN
      ELSE
        XMEAN=TEMP(1)
        XSD=TEMPZ(1)
        AN=TEMPZ3(1)
      ENDIF
C
      IHP='ALPH'
      IHP2='A   '
      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
        ALPHA=0.95
      ELSE
        ALPHA=VALUE(ILOCP)
      ENDIF
C
      IHP='GAMM'
      IHP2='A   '
      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
        GAMMA=0.95
      ELSE
        GAMMA=VALUE(ILOCP)
      ENDIF
C
      CALL DPTOL3(TEMP,NS2,XMEAN,XSD,AN,PTOLDF,
     1            ICASPL,ALPHA,GAMMA,ITOLGC,ITOLM2,
     1            AK,ALOWLM,AUPPLM,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'1LNT' .OR. ICASPL.EQ.'2LNT')THEN
        RIGHT=ALOWLM
      ELSEIF(ICASPL.EQ.'1UNT' .OR. ICASPL.EQ.'2UNT')THEN
        RIGHT=AUPPLM
      ELSEIF(ICASPL.EQ.'1KNT' .OR. ICASPL.EQ.'2KNT')THEN
        RIGHT=AK
      ENDIF
      GOTO79000
C
33140 CONTINUE
C
      CALL DPFTE3(TEMP,NS2,TEMPZ,NSZ,MAXNXT,
     1            Y1MEAN,Y1SD,Y2MEAN,Y2SD,
     1            SDNUM,SDDEN,IDFNUM,IDFDEN,
     1            STATVA,STANU1,STANU2,POOLSD,STATCD,PVAL,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'FTES')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'FTPV')THEN
        RIGHT=PVAL
      ELSEIF(ICASPL.EQ.'FTCD')THEN
        RIGHT=STATCD
      ENDIF
      GOTO79000
C
33150 CONTINUE
      IHP='MU  '
      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
        AMU=0.0
      ELSE
        AMU=VALUE(ILOCP)
      ENDIF
C
      CALL DPSIG3(TEMP,NS2,AMU,IWRITE,
     1            XTEMP1,XTEMP2,MAXNXT,
     1            XMEAN,XMED,XSD,XMAD,
     1            STATV1,STATC1,STATV2,STATC2,RTIES,NTEMP,
     1            PVAL2T,PVALLT,PVALUT,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'1STE')THEN
        RIGHT=STATV1
      ELSEIF(ICASPL.EQ.'1SCD')THEN
        RIGHT=STATC1
      ELSEIF(ICASPL.EQ.'1S2P')THEN
        RIGHT=PVAL2T
      ELSEIF(ICASPL.EQ.'1SLP')THEN
        RIGHT=PVALLT
      ELSEIF(ICASPL.EQ.'1SUP')THEN
        RIGHT=PVALUT
      ENDIF
      GOTO79000
C
33160 CONTINUE
      IHP='D0  '
      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
        D0=0.0
      ELSE
        D0=VALUE(ILOCP)
      ENDIF
C
      CALL DPSIG4(TEMP,NS2,TEMPZ,NSZ,D0,IWRITE,
     1            XTEMP1,XTEMP2,MAXNXT,
     1            X1MEAN,X1MED,X1SD,X1MAD,
     1            X2MEAN,X2MED,X2SD,X2MAD,
     1            STATV1,STATC1,STATV2,STATC2,RTIES,NTEMP,
     1            PVAL2T,PVALLT,PVALUT,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'2STE')THEN
        RIGHT=STATV1
      ELSEIF(ICASPL.EQ.'2SCD')THEN
        RIGHT=STATC1
      ELSEIF(ICASPL.EQ.'2S2P')THEN
        RIGHT=PVAL2T
      ELSEIF(ICASPL.EQ.'2SLP')THEN
        RIGHT=PVALLT
      ELSEIF(ICASPL.EQ.'2SUP')THEN
        RIGHT=PVALUT
      ENDIF
      GOTO79000
C
33165 CONTINUE
      IF(MAXNXT.GE.1000000)THEN
        MAXSAM=22
      ELSE
        MAXSAM=20
      ENDIF
      SUMX=CPUMIN
      PTEMP=CPUMIN
      CALL FISHER(TEMP,NS2,TEMPZ,NSZ,ITOTAL,POSSIB,PTEMP,
     1            SUMX,SUMY,XMEAN,YMEAN,
     1            XTEMP1,XTEMP2,ITEMP1,MAXSAM,MAXNXT,
     1            IFAULT,IBUGG3)
      IF(IFAULT.GT.0)THEN
        RIGHT=CPUMIN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,33166)
33166   FORMAT('****** ERROR IN FISHER TWO-SAMPLE RANDOMIZATION TEST--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,33167)
33167   FORMAT('       MAXIMUM STORAGE SPACE EXCEEDED.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,33168)NS2
33168   FORMAT('       NUMBER OF OBSERVATIONS FOR SAMPLE ONE  = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,33169)NSZ
33169   FORMAT('       NUMBER OF OBSERVATIONS FOR SAMPLE TWO  = ',I8)
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICASPL.EQ.'2FRT')THEN
        RIGHT=SUMX
      ELSEIF(ICASPL.EQ.'2F2P' .AND. NS2.EQ.NSZ)THEN
        RIGHT=2.0*PTEMP
      ELSEIF(ICASPL.EQ.'2F2P' .AND. NS2.NE.NSZ)THEN
        RIGHT=2.0*PTEMP
      ELSEIF(ICASPL.EQ.'2F1P')THEN
        RIGHT=PTEMP
      ENDIF
      GOTO79000
C
33170 CONTINUE
      IF(ICASPL.EQ.'WABA')THEN
        ICASAN='ABAS'
        ICASDI='WEIB'
      ELSEIF(ICASPL.EQ.'WBBA')THEN
        ICASAN='BBAS'
        ICASDI='WEIB'
      ELSEIF(ICASPL.EQ.'LABA')THEN
        ICASAN='ABAS'
        ICASDI='LOGN'
      ELSEIF(ICASPL.EQ.'LBBA')THEN
        ICASAN='BBAS'
        ICASDI='LOGN'
      ELSEIF(ICASPL.EQ.'NABA')THEN
        ICASAN='ABAS'
        ICASDI='NORM'
      ELSEIF(ICASPL.EQ.'NBBA')THEN
        ICASAN='BBAS'
        ICASDI='NORM'
      ELSEIF(ICASPL.EQ.'ZABA')THEN
        ICASAN='ABAS'
        ICASDI='NONP'
      ELSEIF(ICASPL.EQ.'ZBBA')THEN
        ICASAN='BBAS'
        ICASDI='NONP'
      ENDIF
      CALL DPABA3(TEMP,NS2,
     1            XTEMP1,MAXNXT,
     1            ICASAN,ICASDI,
     1            T10,V10,NDF,GAMMA,ALPHA,YMEAN,YSD,YMIN,YMAX,
     1            ABASIS,BBASIS,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'WABA')RIGHT=ABASIS
      IF(ICASPL.EQ.'WBBA')RIGHT=BBASIS
      IF(ICASPL.EQ.'LABA')RIGHT=ABASIS
      IF(ICASPL.EQ.'LBBA')RIGHT=BBASIS
      IF(ICASPL.EQ.'NABA')RIGHT=ABASIS
      IF(ICASPL.EQ.'NBBA')RIGHT=BBASIS
      IF(ICASPL.EQ.'ZABA')RIGHT=ABASIS
      IF(ICASPL.EQ.'ZBBA')RIGHT=BBASIS
      GOTO79000
C
34000 CONTINUE
      IHP='D0  '
      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
        D0=0.0
      ELSE
        D0=VALUE(ILOCP)
      ENDIF
C
      ICASAN='ONES'
      IF(ICASPL.EQ.'1WLP')THEN
        ICASA2='LOWE'
      ELSEIF(ICASPL.EQ.'1WUP')THEN
        ICASA2='UPPE'
      ELSE
        ICASA2='TWOT'
      ENDIF
      CALL DPWIL3(TEMP,TEMPZ,NS2,D0,ICASAN,ICASA2,
     1            XTEMP1,XTEMP2,XTEMP3,MAXNXT,
     1            STATVA,STATV2,STATCD,
     1            PVAL2T,PVALLT,PVALUT,
     1            NTEMP,NPLUS,NMINUS,NTIES,
     1            TPLUS,TMINUS,RSUM,RSUMSQ,
     1            IBUGG3,ISUBRO,IERROR)
C
C     NOTE: RETURN THE "NORMAL APPROXIMATION" TEST STATISTIC
C
      IF(ICASPL.EQ.'1WTE')THEN
        RIGHT=STATV2
      ELSEIF(ICASPL.EQ.'1WCD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'1W2P')THEN
        RIGHT=PVAL2T
      ELSEIF(ICASPL.EQ.'1WLP')THEN
        RIGHT=PVALLT
      ELSEIF(ICASPL.EQ.'1WUP')THEN
        RIGHT=PVALUT
      ENDIF
      GOTO79000
C
34010 CONTINUE
      IHP='D0  '
      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
        D0=0.0
      ELSE
        D0=VALUE(ILOCP)
      ENDIF
C
      ICASAN='TWOS'
      IF(ICASPL.EQ.'1WLP')THEN
        ICASA2='LOWE'
      ELSEIF(ICASPL.EQ.'1WUP')THEN
        ICASA2='UPPE'
      ELSE
        ICASA2='TWOT'
      ENDIF
      CALL DPWIL3(TEMP,TEMPZ,NS2,D0,ICASAN,ICASA2,
     1            XTEMP1,XTEMP2,XTEMP3,MAXNXT,
     1            STATVA,STATV2,STATCD,
     1            PVAL2T,PVALLT,PVALUT,
     1            NTEMP,NPLUS,NMINUS,NTIES,
     1            TPLUS,TMINUS,RSUM,RSUMSQ,
     1            IBUGG3,ISUBRO,IERROR)
C
C     NOTE: RETURN THE "NORMAL APPROXIMATION" TEST STATISTIC
C
      IF(ICASPL.EQ.'2WTE')THEN
        RIGHT=STATV2
      ELSEIF(ICASPL.EQ.'2WCD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'2W2P')THEN
        RIGHT=PVAL2T
      ELSEIF(ICASPL.EQ.'2WLP')THEN
        RIGHT=PVALLT
      ELSEIF(ICASPL.EQ.'2WUP')THEN
        RIGHT=PVALUT
      ENDIF
      GOTO79000
C
34020 CONTINUE
      CALL DPMNN3(TEMP,NS2,TEMPZ,NSZ,
     1            XTEMP1,XTEMP2,XTEMP3,MAXNXT,
     1            STATVA,STATV1,STATV2,STATV3,STATCD,NTIES,
     1            PVAL2T,PVALLT,PVALUT,
     1            IBUGG3,ISUBRO,IERROR)
C
      IF(ICASPL.EQ.'MWTE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'MWCD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'MW2P')THEN
        RIGHT=PVAL2T
      ELSEIF(ICASPL.EQ.'MWLP')THEN
        RIGHT=PVALLT
      ELSEIF(ICASPL.EQ.'MWUP')THEN
        RIGHT=PVALUT
      ELSEIF(ICASPL.EQ.'MWUS')THEN
        RIGHT=STATV3
      ENDIF
      GOTO79000
C
34030 CONTINUE
      CALL DPKLO3(TEMP,NS2,TEMPZ,NSZ,
     1            XTEMP1,XTEMP2,XTEMP3,MAXNXT,
     1            STATVA,STATCD,PVAL2T,PVALLT,PVALUT,
     1            IBUGG3,ISUBRO,IERROR)
C
      IF(ICASPL.EQ.'KLTE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'KLCD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'KL2P')THEN
        RIGHT=PVAL2T
      ELSEIF(ICASPL.EQ.'KLLP')THEN
        RIGHT=PVALLT
      ELSEIF(ICASPL.EQ.'KLUP')THEN
        RIGHT=PVALUT
      ENDIF
      GOTO79000
C
34035 CONTINUE
      IKRUGS='OFF'
      CALL DPKRU3(TEMP,TEMPZ,NS2,
     1            TEMPZ3,XTEMP1,ITEMP1,MAXOBV,
     1            XTEMP2,XTEMP3,XTEMP3,XTEMP3,XTEMP3,XTEMP3,
     1            STATVA,STATCD,PVAL2T,NUMDF,NUMDIS,S2,
     1            IKRUGS,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'KWTE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'KWCD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'KW2P')THEN
        RIGHT=PVAL2T
      ENDIF
      GOTO79000
C
34040 CONTINUE
      CALL DPSQR3(TEMP,TEMPZ,NS2,
     1            XTEMP1,XTEMP2,XTEMP3,TEMPZ3,MAXNXT,
     1            DTEMP1,DTEMP2,
     1            STATVA,STATCD,PVAL2T,PVALLT,PVALUT,
     1            IDF,NDIST,D2,
     1            IBUGG3,ISUBRO,IERROR)
C
      IF(ICASPL.EQ.'SRTE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'SRCD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'SR2P')THEN
        RIGHT=PVAL2T
      ELSEIF(ICASPL.EQ.'SRLP')THEN
        RIGHT=PVALLT
      ELSEIF(ICASPL.EQ.'SRUP')THEN
        RIGHT=PVALUT
      ENDIF
      GOTO79000
C
34050 CONTINUE
      IHP='XQ  '
      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)
      IF(IERROR.EQ.'YES')THEN
        PMTEQU=0.5
      ELSE
        PMTEQU=VALUE(ILOCP)
        IF(PMTEQU.LE.0.0 .OR. PMTEQU.GE.1.0)PMTEQU=0.5
      ENDIF
      CALL DPMET3(TEMP,TEMPZ,NS2,
     1            XTEMP1,XTEMP2,XTEMP3,PMTEQU,IQUAME,MAXNXT,
     1            XMED,XA,XB,IDF,NDIST,
     1            STATVA,STATCD,PVAL2T,
     1            IBUGG3,ISUBRO,IERROR)
C
      IF(ICASPL.EQ.'METE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'MECD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'ME2P')THEN
        RIGHT=PVAL2T
      ENDIF
      GOTO79000
C
34060 CONTINUE
      MAXOB2=MAXOBV/2
      IINDX=MAXOB2+1
      CALL DPFRI3(TEMP,TEMPZ,TEMPZ3,NS2,
     1            XTEMP1,XTEMP1(IINDX),XTEMP2,XTEMP3,XTEMP3(IINDX),
     1            DTEMP1,
     1            MAXOBV,MAXOB2,
     1            STATVA,STATCD,PVAL2T,
     1            NBLOCK,NTREAT,NUMDF1,NUMDF2,AT1,AT2,A1,C1,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'FZTE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'FZCD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'FZ2P')THEN
        RIGHT=PVAL2T
      ENDIF
      GOTO79000
C
34070 CONTINUE
      MAXOB2=MAXOBV/2
      IINDX=MAXOB2+1
      CALL DPQUT3(TEMP,TEMPZ,TEMPZ3,NS2,
     1            XTEMP1,XTEMP1(IINDX),XTEMP2,XTEMP2(IINDX),
     1            XTEMP3,XTEMP3(IINDX),
     1            DTEMP1,
     1            MAXOBV,MAXOB2,
     1            STATVA,STATCD,PVAL2T,
     1            NBLOCK,NTREAT,NUMDF1,NUMDF2,
     1            AT1,AT2,A1,C1,SSTR,SSTO,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'QUTE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'QUCD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'QU2P')THEN
        RIGHT=PVAL2T
      ENDIF
      GOTO79000
C
34075 CONTINUE
      MAXOB2=MAXOBV/2
      IINDX=MAXOB2+1
      CALL DPPAG3(TEMP,TEMPZ,TEMPZ3,NS2,
     1            XTEMP1,XTEMP1(IINDX),XTEMP2,XTEMP3,XTEMP3(IINDX),
     1            DTEMP1,
     1            MAXOBV,MAXOB2,
     1            STATVA,STATV2,STATCD,PVAL,
     1            NBLOCK,NTREAT,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'PATE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'PAT2')THEN
        RIGHT=STATV2
      ELSEIF(ICASPL.EQ.'PACD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'PAPV')THEN
        RIGHT=PVAL
      ENDIF
      GOTO79000
C
34080 CONTINUE
      CALL DPINDM(TEMP,NS2,TEMPZ,NSZ,ICASPL,
     1            RIGHT,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
34090 CONTINUE
      ICASE='SUMM'
      ICASE2='DIVE'
      IF(ICASPL.EQ.'SHEI')ICASE2='EQUI'
      CALL SHANDI(TEMP,NS2,IWRITE,RIGHT,XTEMP1,XTEMP2,ICASE,ICASE2,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
34095 CONTINUE
      ICASE='RAW'
      ICASE2='DIVE'
      IF(ICASPL.EQ.'SEII')ICASE2='EQUI'
      CALL SHANDI(TEMP,NS2,IWRITE,RIGHT,XTEMP1,XTEMP2,ICASE,ICASE2,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
34100 CONTINUE
      ICASE='SUMM'
      CALL SIMPDI(TEMP,NS2,IWRITE,RIGHT,XTEMP1,XTEMP2,ICASE,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
34105 CONTINUE
      ICASE='SUMM'
      CALL SIMPDI(TEMP,NS2,IWRITE,RIGHT,XTEMP1,XTEMP2,ICASE,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
34110 CONTINUE
      CALL DPJAB3(TEMP,NS2,ISEED,IRANAL,MAXNXT,
     1            XTEMP1,XTEMP2,
     1            XSKEW,XKURT,
     1            STATVA,PVAL,CDF,
     1            CUT25,CUT50,CUT75,CUT80,CUT90,
     1            CUT95,CUT975,CUT99,CUT999,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'JABE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'JAPV')THEN
        RIGHT=PVAL
      ELSEIF(ICASPL.EQ.'JACD')THEN
        RIGHT=CDF
      ENDIF
      GOTO79000
C
34120 CONTINUE
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
      IF(ALPHA.GT.1.0 .AND. ALPHA.LT.100.0)THEN
        ALPHA=ALPHA/100.0
        IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
      ELSEIF(ALPHA.GT.0.0 .AND. ALPHA.LT.1.0)THEN
        IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
      ELSE
        ALPHA=0.95
      ENDIF
C
      IF(ICASPL(1:1).EQ.'S')THEN
        YMEAN=TEMP(1)
        YSD=TEMPZ(1)
        NS2=INT(TEMPZ3(1)+0.5)
      ELSE
        CALL MEAN(TEMP,NS2,IWRITE,YMEAN,IBUGG3,IERROR)
        CALL SD(TEMP,NS2,IWRITE,YSD,IBUGG3,IERROR)
      ENDIF
      YSDMEA=YSD/SQRT(REAL(NS2))
C
      PCONF=ALPHA
      IF(ICASPL.EQ.'LCL ' .OR. ICASPL.EQ.'UCL ' .OR.
     1   ICASPL.EQ.'SLCL' .OR. ICASPL.EQ.'SUCL')THEN
        CDF=0.5+(PCONF/2.0)
      ELSEIF(ICASPL.EQ.'1LCL' .OR. ICASPL.EQ.'1UCL' .OR.
     1       ICASPL.EQ.'SLC1' .OR. ICASPL.EQ.'SUC1')THEN
        CDF=PCONF
      ENDIF
      NM1=NS2-1
      CALL TPPF(CDF,REAL(NM1),TVAL)
      TSDM=TVAL*YSDMEA
      ALOWER=YMEAN-TSDM
      AUPPER=YMEAN+TSDM
      IF(ICASPL.EQ.'LCL ' .OR. ICASPL.EQ.'SLCL')THEN
        RIGHT=ALOWER
      ELSEIF(ICASPL.EQ.'UCL ' .OR. ICASPL.EQ.'SUCL')THEN
        RIGHT=AUPPER
      ELSEIF(ICASPL.EQ.'1LCL' .OR. ICASPL.EQ.'SLC1')THEN
        RIGHT=ALOWER
      ELSEIF(ICASPL.EQ.'1UCL' .OR. ICASPL.EQ.'SUC1')THEN
        RIGHT=AUPPER
      ENDIF
      GOTO79000
C
34130 CONTINUE
      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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.GT.1.0 .AND. ALPHA.LT.100.0)THEN
          ALPHA=ALPHA/100.0
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSEIF(ALPHA.GT.0.0 .AND. ALPHA.LT.1.0)THEN
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSE
          ALPHA=0.95
        ENDIF
      ELSE
        ALPHA=0.95
      ENDIF
C
      IHP='NNEW'
      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)
      IF(IERROR.EQ.'NO')THEN
        NNEW=INT(VALUE(ILOCP)+0.5)
      ELSE
        NNEW=1
      ENDIF
      IF(NNEW.LT.1)NNEW=1
C
      IF(ICASPL(1:1).EQ.'S')THEN
        IF(ICASPL.EQ.'SLS2' .OR. ICASPL.EQ.'SUS2' .OR.
     1     ICASPL.EQ.'SLS1' .OR. ICASPL.EQ.'SUS1')THEN
          YSD=TEMP(1)
          NS2=INT(TEMPZ(1)+0.5)
        ELSE
          YMEAN=TEMP(1)
          YSD=TEMPZ(1)
          NS2=INT(TEMPZ3(1)+0.5)
        ENDIF
      ENDIF
C
      ICASA2='LIMI'
      ICASA3='UPPE'
      ICASA4='RAW'
      ICASA5='TWOS'
C
      IF(ICASPL(1:1).EQ.'S')ICASA4='SUMM'
C
      IF(ICASPL.EQ.'LPB ')THEN
        ICASA2='BOUN'
        ICASA3='LOWE'
      ENDIF
      IF(ICASPL.EQ.'UPB ')ICASA2='BOUN'
      IF(ICASPL.EQ.'UPB1')ICASA2='BOUN'
C
      IF(ICASPL.EQ.'LPL1')THEN
        ICASA3='LOWE'
        ICASA5='ONES'
      ENDIF
      IF(ICASPL.EQ.'LPB1')THEN
        ICASA2='BOUN'
        ICASA3='LOWE'
        ICASA5='ONES'
      ENDIF
      IF(ICASPL.EQ.'UPL1')ICASA5='ONES'
      IF(ICASPL.EQ.'UPB1')ICASA5='ONES'
C
      IF(ICASPL.EQ.'SLPB')THEN
        ICASA2='BOUN'
        ICASA3='LOWE'
      ENDIF
      IF(ICASPL.EQ.'SUPB')ICASA2='BOUN'
      IF(ICASPL.EQ.'SUB1')ICASA2='BOUN'
C
      IF(ICASPL.EQ.'SLP1')THEN
        ICASA3='LOWE'
        ICASA5='ONES'
      ENDIF
      IF(ICASPL.EQ.'SLB1')THEN
        ICASA2='BOUN'
        ICASA3='LOWE'
        ICASA5='ONES'
      ENDIF
      IF(ICASPL.EQ.'SUB1')ICASA5='ONES'
      IF(ICASPL.EQ.'SUP1')ICASA5='ONES'
C
      IF(ICASPL.EQ.'UPS1')THEN
        ICASA2='SDLI'
        ICASA5='ONES'
      ELSEIF(ICASPL.EQ.'LPS1')THEN
        ICASA2='SDLI'
        ICASA3='LOWE'
        ICASA5='ONES'
      ELSEIF(ICASPL.EQ.'UPS2')THEN
        ICASA2='SDLI'
      ELSEIF(ICASPL.EQ.'LPS2')THEN
        ICASA2='SDLI'
        ICASA3='LOWE'
      ELSEIF(ICASPL.EQ.'SUS1')THEN
        ICASA2='SDLI'
        ICASA5='ONES'
      ELSEIF(ICASPL.EQ.'SLS1')THEN
        ICASA2='SDLI'
        ICASA3='LOWE'
        ICASA5='ONES'
      ELSEIF(ICASPL.EQ.'SUS2')THEN
        ICASA2='SDLI'
      ELSEIF(ICASPL.EQ.'SLS2')THEN
        ICASA2='SDLI'
        ICASA3='LOWE'
      ENDIF
C
      ALPHAT(1)=ALPHA
      NALPHA=1
      CALL DPPRL3(TEMP,NS2,NNEW,ICASA2,ICASA3,ICASA4,ICASA5,
     1            YMEAN,YSD,
     1            ALPHAT,NALPHA,ALOWLV,AUPPLV,
     1            ISUBRO,IBUGG3,IERROR)
C
      IF(ICASPL.EQ.'LPL ')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'LPB ')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'LPL1')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'LPB1')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'UPL ')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'UPB ')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'UPL1')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'UPB1')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'SLPL')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'SLPB')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'SLP1')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'SLB1')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'SUPL')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'SUPB')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'SUP1')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'SUB1')RIGHT=AUPPLV(1)
C
      IF(ICASPL.EQ.'SUS1')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'SUS2')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'UPS1')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'UPS2')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'SLS1')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'SLS2')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'LPS1')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'LPS2')RIGHT=ALOWLV(1)
C
      GOTO79000
C
34140 CONTINUE
      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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.GT.1.0 .AND. ALPHA.LT.100.0)THEN
          ALPHA=ALPHA/100.0
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSEIF(ALPHA.GT.0.0 .AND. ALPHA.LT.1.0)THEN
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSE
          ALPHA=0.95
        ENDIF
      ELSE
        ALPHA=0.95
      ENDIF
C
      IF(ICASPL(1:1).EQ.'S')THEN
        YSD=TEMP(1)
        NS2=INT(TEMPZ(1)+0.1)
      ENDIF
C
      ICASA2='LIMI'
      ICASA3='UPPE'
      ICASA4='RAW'
      ICASA5='TWOS'
C
      IF(ICASPL(1:1).EQ.'S')ICASA4='SUMM'
C
      IF(ICASPL.EQ.'LCS1')ICASA3='LOWE'
      IF(ICASPL.EQ.'LCS2')ICASA3='LOWE'
      IF(ICASPL.EQ.'SLZ1')ICASA3='LOWE'
      IF(ICASPL.EQ.'SLZ2')ICASA3='LOWE'
C
      IF(ICASPL.EQ.'LCS1')ICASA5='ONES'
      IF(ICASPL.EQ.'UCS1')ICASA5='ONES'
      IF(ICASPL.EQ.'SLZ1')ICASA5='ONES'
      IF(ICASPL.EQ.'SUZ1')ICASA5='ONES'
C
      ALPHAT(1)=ALPHA
      NALPHA=1
      CALL DPSDC3(TEMP,NS2,ICASA2,ICASA3,ICASA4,ICASA5,
     1            YSD,
     1            ALPHAT,NALPHA,ALOWLV,AUPPLV,
     1            ISUBRO,IBUGG3,IERROR)
C
      IF(ICASPL.EQ.'LCS1')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'LCS2')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'SLZ1')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'SLZ2')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'UCS1')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'UCS2')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'SUZ1')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'SUZ2')RIGHT=AUPPLV(1)
C
      GOTO79000
C
34145 CONTINUE
      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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.GT.1.0 .AND. ALPHA.LT.100.0)THEN
          ALPHA=ALPHA/100.0
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSEIF(ALPHA.GT.0.0 .AND. ALPHA.LT.1.0)THEN
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSE
          ALPHA=0.95
        ENDIF
      ELSE
        ALPHA=0.95
      ENDIF
C
      IHP='N0  '
      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)
      IF(IERROR.EQ.'NO')THEN
        N0=INT(VALUE(ILOCP)+0.5)
      ELSE
        N0=0
      ENDIF
C
      IHP='KURT'
      IHP2='OSIS'
      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.'NO')THEN
        AKURT=VALUE(ILOCP)
      ELSE
        AKURT=CPUMIN
      ENDIF
C
      ICASA3='UPPE'
      ICASA5='TWOS'
      IF(ICASPL.EQ.'BLSD')ICASA3='LOWE'
      ALPHAT(1)=ALPHA
      NALPHA=1
      CALL DPSDR3(TEMP,NS2,ICASA3,ICASA5,MAXNXT,
     1            XTEMP1,AKURT,N0,IBONAD,
     1            YSD,
     1            ALPHAT,NALPHA,ALOWLV,AUPPLV,
     1            ISUBRO,IBUGG3,IERROR)
C
      IF(ICASPL.EQ.'BLSD')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'BUSD')RIGHT=AUPPLV(1)
      GOTO79000
C
34150 CONTINUE
      ICASE='STAT'
      IF(ICASPL.EQ.'MWLC')ICASE='CV'
      IF(ICASPL.EQ.'MWPV')ICASE='CV'
      CALL DPMCW3(TEMP,TEMPZ,NS2,
     1            TEMPZ3,XTEMP1,XTEMP2,XTEMP3,DTEMP1,ITEMP1,
     1            ICASE,ISEED,MAXNXT,
     1            STATVA,STATCD,PVAL,CV50,CV90,CV95,
     1            CA,CL,IR,IR1,IMCCR1,IRANAL,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'MWLT')RIGHT=STATVA
      IF(ICASPL.EQ.'MWLC')RIGHT=STATCD
      IF(ICASPL.EQ.'MWPV')RIGHT=PVAL
      IF(ICASPL.EQ.'MW50')RIGHT=CV50
      IF(ICASPL.EQ.'MW90')RIGHT=CV90
      IF(ICASPL.EQ.'MW95')RIGHT=CV95
      GOTO79000
C
34160 CONTINUE
      ICASE='RAW'
      CALL DPPDT3(TEMP,TEMPZ,NS2,ICASE,
     1            STATVA,STATCD,STATNU,PVALUE,
     1            YMEAN,YSD,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'PDTE')RIGHT=STATVA
      IF(ICASPL.EQ.'PDCD')RIGHT=STATCD
      IF(ICASPL.EQ.'PDPV')RIGHT=PVALUE
      GOTO79000
C
34170 CONTINUE
      ICASE='GROU'
      CALL DPPDT3(TEMP,TEMPZ,NS2,ICASE,
     1            STATVA,STATCD,STATNU,PVALUE,
     1            YMEAN,YSD,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'GPDT')RIGHT=STATVA
      IF(ICASPL.EQ.'GPDC')RIGHT=STATCD
      IF(ICASPL.EQ.'GPDP')RIGHT=PVALUE
      GOTO79000
C
34180 CONTINUE
C
      IHP='XMIN'
      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)
      IF(IERROR.EQ.'NO')THEN
        XMIN=VALUE(ILOCP)
      ELSE
        XMIN=CPUMIN
      ENDIF
C
      IHP='XMAX'
      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)
      IF(IERROR.EQ.'NO')THEN
        XMAX=VALUE(ILOCP)
      ELSE
        XMAX=CPUMIN
      ENDIF
C
      IHP='YMIN'
      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)
      IF(IERROR.EQ.'NO')THEN
        YMIN=VALUE(ILOCP)
      ELSE
        YMIN=CPUMIN
      ENDIF
C
      IHP='YMAX'
      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)
      IF(IERROR.EQ.'NO')THEN
        YMAX=VALUE(ILOCP)
      ELSE
        YMAX=CPUMIN
      ENDIF
C
      CALL DPCSR3(TEMP,TEMPZ,NS2,XTEMP1,XTEMP2,
     1            XMIN,XMAX,YMIN,YMAX,
     1            STATVA,
     1            CV01,CV02,CV05,CV10,CV15,CV25,CV50,
     1            CV75,CV85,CV090,CV95,CV98,CV99,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'BCVM')RIGHT=STATVA
      IF(ICASPL.EQ.'BC95')RIGHT=CV95
      IF(ICASPL.EQ.'BC05')RIGHT=CV05
      GOTO79000
C
C     ---------------------------
C
34190 CONTINUE
      CALL DPCSR4(TEMP,TEMPZ,NS2,XTEMP1,XTEMP2,
     1            STATVA,STATCD,PVALUE,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'MNNC')RIGHT=STATVA
      IF(ICASPL.EQ.'MNND')RIGHT=STATCD
      IF(ICASPL.EQ.'MNNP')RIGHT=PVALUE
      GOTO79000
C
34200 CONTINUE
      IF(ICASPL.EQ.'POL1')JINDX=1
      IF(ICASPL.EQ.'POL2')JINDX=2
      IF(ICASPL.EQ.'POL3')JINDX=3
      IF(ICASPL.EQ.'POL4')JINDX=4
      IF(ICASPL.EQ.'POL5')JINDX=5
      IF(ICASPL.EQ.'POC1')JINDX=1
      IF(ICASPL.EQ.'POC2')JINDX=2
      IF(ICASPL.EQ.'POC3')JINDX=3
      IF(ICASPL.EQ.'POC4')JINDX=4
      IF(ICASPL.EQ.'POC5')JINDX=5
      IF(ICASPL.EQ.'POP1')JINDX=1
      IF(ICASPL.EQ.'POP2')JINDX=2
      IF(ICASPL.EQ.'POP3')JINDX=3
      IF(ICASPL.EQ.'POP4')JINDX=4
      IF(ICASPL.EQ.'POP5')JINDX=5
C
      CALL DPCSR5(TEMP,TEMPZ,NS2,JINDX,XTEMP1,
     1            STATVA,STATV2,STATCD,PVALUE,STATNU,
     1            ISUBRO,IBUGG3,IERROR)
C
      IF(ICASPL.EQ.'POL1')RIGHT=STATVA
      IF(ICASPL.EQ.'POL2')RIGHT=STATVA
      IF(ICASPL.EQ.'POL3')RIGHT=STATVA
      IF(ICASPL.EQ.'POL4')RIGHT=STATVA
      IF(ICASPL.EQ.'POL5')RIGHT=STATVA
      IF(ICASPL.EQ.'PO1C')RIGHT=STATCD
      IF(ICASPL.EQ.'PO2C')RIGHT=STATCD
      IF(ICASPL.EQ.'PO3C')RIGHT=STATCD
      IF(ICASPL.EQ.'PO4C')RIGHT=STATCD
      IF(ICASPL.EQ.'PO5C')RIGHT=STATCD
      IF(ICASPL.EQ.'PO1P')RIGHT=PVALUE
      IF(ICASPL.EQ.'PO2P')RIGHT=PVALUE
      IF(ICASPL.EQ.'PO3P')RIGHT=PVALUE
      IF(ICASPL.EQ.'PO4P')RIGHT=PVALUE
      IF(ICASPL.EQ.'PO5P')RIGHT=PVALUE
      GOTO79000
C
34210 CONTINUE
      IHP='XVAL'
      IHP2='UE  '
      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.'NO')THEN
        XVAL=VALUE(ILOCP)
        CALL VALCNT(TEMP,NS2,XVAL,IWRITE,RIGHT,ISUBRO,IBUGG3,IERROR)
      ELSE
        RIGHT=0.0
      ENDIF
C
      GOTO79000
C
34220 CONTINUE
      CALL VARDIS(TEMP,NS2,IWRITE,VDIST,RDI,CHISQ,
     1            ICASPL,ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'VDIS')RIGHT=VDIST
      IF(ICASPL.EQ.'RDI ')RIGHT=RDI
      IF(ICASPL.EQ.'UCHS')RIGHT=CHISQ
      GOTO79000
C
34230 CONTINUE
      CALL DPCWS3(TEMP,TEMPZ,NS2,IWRITE,ISEED,MINMAX,MAXNXT,
     1            XTEMP1,DTEMP2,XTEMP2,XTEMP3,TEMPZ3,DTEMP1,
     1            STATVA,STATCD,PVALUE,NDIST,NGROUP,
     1            CV90,CV95,CV99,BETACM,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'WSHT')RIGHT=STATVA
      IF(ICASPL.EQ.'WSCD')RIGHT=STATCD
      IF(ICASPL.EQ.'WSHP')RIGHT=PVALUE
      IF(ICASPL.EQ.'WS90')RIGHT=CV90
      IF(ICASPL.EQ.'WS95')RIGHT=CV95
      IF(ICASPL.EQ.'WS99')RIGHT=CV99
      GOTO79000
C
34240 CONTINUE
      CALL DPKAR3(TEMP,NS2,XTEMP1,MAXNXT,
     1            STATVA,CUTOFF,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=STATVA
      IF(ICASPL.EQ.'KARC')RIGHT=CUTOFF
      GOTO79000
C
34260 CONTINUE
      ICASAN='UPPE'
      IF(ICASPL.EQ.'CV05')ICASAN='LOWE'
      IF(ICASPL.EQ.'CV01')ICASAN='LOWE'
      IF(ICASPL.EQ.'CMVC')ICASAN='LOWE'
      IF(ICASPL.EQ.'CMVP')ICASAN='LOWE'
      IF(ICASPL.EQ.'CVMO')ICASAN='LOWE'
      CALL DPCVO3(TEMP,TEMPZ,NS2,ICASAN,
     1            XTEMP1,XTEMP2,XTEMP3,TEMPZ3,ITEMP1,
     1            STATVA,STATV2,STATCU,STATCL,PVALU,PVALL,
     1            ALPHAV,CV,NUMALZ,
     1            IDF1,IDF2,ILABMX,ILABMN,NUMDIS,NGROUP,
     1            DVARTO,VARMAX,VARMIN,
     1            IBUGG3,ISUBRO,IERROR)
      RIGHT=STATVA
      IF(ICASPL.EQ.'CV95')RIGHT=CV(11)
      IF(ICASPL.EQ.'CV99')RIGHT=CV(13)
      IF(ICASPL.EQ.'CVCD')RIGHT=STATCU
      IF(ICASPL.EQ.'CVPV')RIGHT=PVALU
      IF(ICASPL.EQ.'CV01')RIGHT=CV(3)
      IF(ICASPL.EQ.'CV05')RIGHT=CV(5)
      IF(ICASPL.EQ.'CVMO')RIGHT=STATV2
      IF(ICASPL.EQ.'CMVC')RIGHT=STATCL
      IF(ICASPL.EQ.'CMVP')RIGHT=PVALL
      GOTO79000
C
34270 CONTINUE
      CALL DPEQS3(TEMP,TEMPZ,TEMPZ3,NS2,MAXNXT,
     1            XTEMP1,XTEMP2,XTEMP3,
     1            DTEMP1(1),DTEMP1(10000),DTEMP1(20000),
     1            DTEMP1(30000),DTEMP1(40000),
     1            DTEMP1(50000),DTEMP1(60000),ITEMP1,
     1            NUMSLO,ICASEE,
     1            STATVA,STATCD,PVAL2T,
     1            STATV1,STATC1,PVAL1,
     1            STATV2,STATC2,PVAL2,
     1            STATV3,STATC2,PVAL3,
     1            CV80,CV90,CV95,CV99,
     1            CV180,CV190,CV195,CV199,
     1            CV280,CV290,CV295,CV299,
     1            CV380,CV390,CV395,CV399,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASEE.EQ.'3ORMORE')THEN
        RIGHT=STATV2
        IF(ICASPL.EQ.'ESCD')RIGHT=STATC2
        IF(ICASPL.EQ.'ESCV')RIGHT=CV295
        IF(ICASPL.EQ.'ESPV')RIGHT=PVAL2
      ELSE
        RIGHT=STATVA
        IF(ICASPL.EQ.'ESCD')RIGHT=STATCD
        IF(ICASPL.EQ.'ESCV')RIGHT=CV95
        IF(ICASPL.EQ.'ESPV')RIGHT=PVAL2T
      ENDIF
      GOTO79000
C
34280 CONTINUE
C
      IHP='GAMM'
      IHP2='A0  '
      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')THEN
          RIGHT=0.0
          GOTO9000
      ELSE
        GAMMA0=VALUE(ILOCP)
      ENDIF
C
      ICASA3='RAW'
      CALL DPCVT3(TEMP,TEMPZ,ITEMP1,NS2,GAMMA0,IWRITE,ICASA3,
     1            XTEMP1,XTEMP2,
     1            NDIST,NGROUP,YMEAN,YSD,YCV,
     1            STATVA,STATCD,STATNU,
     1            PVAL2T,PVALLT,PVALUT,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'1CTE')RIGHT=STATVA
      IF(ICASPL.EQ.'1CCD')RIGHT=STATCD
      IF(ICASPL.EQ.'1C2P')RIGHT=PVAL2T
      IF(ICASPL.EQ.'1CLP')RIGHT=PVALLT
      IF(ICASPL.EQ.'1CUP')RIGHT=PVALUT
C
      GOTO79000
C
34290 CONTINUE
C
      IHP='GAMM'
      IHP2='A0  '
      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')THEN
          RIGHT=0.0
          GOTO9000
      ELSE
        GAMMA0=VALUE(ILOCP)
      ENDIF
C
      ICASA3='SUMM'
      DO34291II=1,NS2
        ITEMP1(II)=INT(TEMPZ3(II)+0.5)
34291 CONTINUE
      CALL DPCVT3(TEMP,TEMPZ,ITEMP1,NS2,GAMMA0,IWRITE,ICASA3,
     1            XTEMP1,XTEMP2,
     1            NDIST,NGROUP,YMEAN,YSD,YCV,
     1            STATVA,STATCD,STATNU,
     1            PVAL2T,PVALLT,PVALUT,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'S1CT')RIGHT=STATVA
      IF(ICASPL.EQ.'S1CC')RIGHT=STATCD
      IF(ICASPL.EQ.'S1CP')RIGHT=PVAL2T
C
      GOTO79000
C
34300 CONTINUE
      DO34301II=1,NS2
        TEMPZ3(II)=1.0
34301 CONTINUE
      DO34303II=1,NSZ
        XTEMP3(II)=1.0
34303 CONTINUE
      IF(ICVTTE.EQ.'MILL')THEN
        CALL DPCVT6(TEMP,NS2,TEMPZ,NSZ,IWRITE,
     1              YMEAN1,YSD1,CV1,YMEAN2,YSD2,CV2,
     1              STATVA,STATCD,PVAL2T,PVALLT,PVALUT,
     1              ISUBRO,IBUGG3,IERROR)
      ELSE
        CALL DPCVT4(TEMP,TEMPZ3,NS2,TEMPZ,XTEMP3,NSZ,IWRITE,
     1              XTEMP1,XTEMP2,NGROU1,NGROU2,
     1              YMEAN1,YSD1,CV1,YMEAN2,YSD2,CV2,
     1              STATVA,STATCD,STATN1,STATN2,
     1              PVAL2T,PVALLT,PVALUT,
     1              ISUBRO,IBUGG3,IERROR)
      ENDIF
      IF(ICASPL.EQ.'2CTE')RIGHT=STATVA
      IF(ICASPL.EQ.'2CCD')RIGHT=STATCD
      IF(ICASPL.EQ.'2C2P')RIGHT=PVAL2T
      IF(ICASPL.EQ.'2CLP')RIGHT=PVALLT
      IF(ICASPL.EQ.'2CUP')RIGHT=PVALUT
      GOTO79000
C
C     ---------------------------
C
79000 CONTINUE
      NS2=NS2SAV
      NSZ=NSZSAV
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IPRINT=IPRSAV
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PSTA')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF CMPSTA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)ICASPL,IERROR,NS2,NUMV2,RIGHT
 9013   FORMAT('ICASPL,IERROR,NS2,NUMV2,RIGHT = ',2(A4,2X),2I8,G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE CMPST2(TEMP,TEMPZ,TEMPZ3,XTEMP1,XTEMP2,XTEMP3,
     1                  MAXNXT,NS2,NSZ,NSZ3,NUMV2,ICASPL,
     1                  ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1                  DTEMP1,DTEMP2,DTEMP3,
     1                  RIGHT,
     1                  ISUBRO,IBUGG3,IERROR)
C
C     PURPOSE--THIS IS A COPY OF CMPSTA.  IT IS USED BY DPSBEX (USED
C              TO IMPLEMENT STATISTIC BLOCKS) TO AVOID CIRCULAR CALLS.
C              THE ONE DISTINCTION IS THAT CMPST2 DOES NOT CALL OTHER
C              STATISTIC BLOCKS.
C     WRITTEN BY--ALAN HECKERT
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2016/08
C     ORIGINAL VERSION--AUGUST    2016.
C     UPDATED         --DECEMBER  2016. COEFFICIENT OF VARIATION
C                                       CONFIDENCE LIMITS
C     UPDATED         --JANUARY   2017. UNBIASED COEFFICIENT OF VARIATION
C     UPDATED         --JANUARY   2017. SIGNAL TO NOISE RATIO
C     UPDATED         --JANUARY   2017. QUARTILE COEFFICIENT OF
C                                       DISPERSION
C     UPDATED         --JANUARY   2017. LOGNORMAL COEFFICIENT OF VARIATION
C     UPDATED         --JANUARY   2017. LOGNORMAL COEFFICIENT OF VARIATION
C                                       CONFIDENCE LIMITS
C     UPDATED         --JANUARY   2017. PRECISION
C     UPDATED         --JANUARY   2017. COMMON COEFFICIENT OF VARIATION
C     UPDATED         --JANUARY   2017. COMMON BIAS CORRECTED COEFFICIENT
C                                       OF VARIATION
C     UPDATED         --JANUARY   2017. LOWER COMMON COEFFICIENT OF
C                                       VARIATION CONFIDENCE LIMIT
C     UPDATED         --JANUARY   2017. UPPER COMMON COEFFICIENT OF
C                                       VARIATION CONFIDENCE LIMIT
C     UPDATED         --JANUARY   2017. COEFFICIENT OF DISPERSION
C     UPDATED         --JANUARY   2017. INDEX OF DISPERSION
C     UPDATED         --JANUARY   2017. AAD TO MEDIAN
C     UPDATED         --FEBRUARY  2017. SHORTEST HALF MIDMEAN
C     UPDATED         --FEBRUARY  2017. SHORTEST HALF MIDRANGE
C     UPDATED         --MARCH     2017. COSINE DISTANCE
C     UPDATED         --MARCH     2017. COSINE SIMILARITY
C     UPDATED         --MARCH     2017. ANGULAR COSINE DISTANCE
C     UPDATED         --MARCH     2017. ANGULAR COSINE SIMILARITY
C     UPDATED         --MARCH     2017. MANHATTAN DISTANCE
C     UPDATED         --MARCH     2017. EUCLIDEAN DISTANCE
C     UPDATED         --MARCH     2017. EUCLIDEAN LENGTH (SYNONYM FOR
C                                       SUM OF SQuARES)
C     UPDATED         --MARCH     2017. DOT PRODUCT
C     UPDATED         --MARCH     2017. DIFFERENCE OF PRECISION
C     UPDATED         --MARCH     2017. DIFFERENCE OF SNR
C     UPDATED         --APRIL     2017. ONE SAMPLE COEF OF VARI CDF
C     UPDATED         --APRIL     2017. ONE SAMPLE COEF OF VARI PVALUE
C     UPDATED         --JUNE      2017. PERCENTAGE DIFFERENCE OF MEAN
C     UPDATED         --JUNE      2017. ONE SAMPLE COEF OF VARI TEST
C     UPDATED         --JUNE      2017. ONE SAMPLE COEF OF VARI TEST CDF
C     UPDATED         --JUNE      2017. ONE SAMPLE COEF OF VARI TEST PVALUE
C     UPDATED         --JUNE      2017. ONE SAMPLE COEF OF VARI LOWER PVALUE
C     UPDATED         --JUNE      2017. ONE SAMPLE COEF OF VARI UPPER PVALUE
C     UPDATED         --JUNE      2017. SUMMARY ONE SAMPLE COEF OF VARI TEST
C     UPDATED         --JUNE      2017. SUMMARY ONE SAMPLE COEF OF VARI CDF
C     UPDATED         --JUNE      2017. SUMMARY ONE SAMPLE COEF OF VARI PVALUE
C     UPDATED         --JUNE      2017. TWO SAMPLE COEF OF VARI TEST
C     UPDATED         --JUNE      2017. TWO SAMPLE COEF OF VARI TEST CDF
C     UPDATED         --JUNE      2017. TWO SAMPLE COEF OF VARI TEST PVALUE
C     UPDATED         --JUNE      2017. TWO SAMPLE COEF OF VARI LOWER PVALUE
C     UPDATED         --JUNE      2017. TWO SAMPLE COEF OF VARI UPPER PVALUE
C     UPDATED         --JUNE      2017. DIFFERENCE OF AAD TO MEDIAN
C     UPDATED         --JUNE      2017. DIFFERENCE OF COEFFICIENT OF
C                                                  DISPERSION
C     UPDATED         --JUNE      2017. DIFFERENCE OF INDEX OF DISPERSION
C     UPDATED         --JUNE      2017. DIFFERENCE OF QUARTILE COEFFICIENT
C                                                  OF DISPERSION
C     UPDATED         --JUNE      2017. DIFFERENCE OF SHORTEST HALF
C                                                  MIDMEAN
C     UPDATED         --JUNE      2017. DIFFERENCE OF SHORTEST HALF
C                                                  MIDRANGE
C     UPDATED         --JULY      2017. HEDGES G
C     UPDATED         --JULY      2017. BIAS CORRECTED HEDGES G
C     UPDATED         --JULY      2017. GLASS G
C     UPDATED         --JULY      2017. COHENS D
C     UPDATED         --JULY      2017. MIDHINGE, TRIMEAN
C     UPDATED         --JULY      2017. DIFFERENCE OF MIDHINGE
C     UPDATED         --JULY      2017. DIFFERENCE OF TRIMEAN
C     UPDATED         --AUGUST    2017. PEARSON DISSIMILARITY
C     UPDATED         --AUGUST    2017. SPEARMAN DISSIMILARITY
C     UPDATED         --AUGUST    2017. KENDALL TAU DISSIMILARITY
C     UPDATED         --AUGUST    2017. BINARY MATCH DISSIMILARITY
C     UPDATED         --AUGUST    2017. BINARY MATCH SIMILARITY
C     UPDATED         --AUGUST    2017. BINARY ROGERS DISSIMILARITY
C     UPDATED         --AUGUST    2017. BINARY ROGERS SIMILARITY
C     UPDATED         --AUGUST    2017. BINARY SOKAL DISSIMILARITY
C     UPDATED         --AUGUST    2017. BINARY SOKAL SIMILARITY
C     UPDATED         --AUGUST    2017. BINARY JACCARD DISSIMILARITY
C     UPDATED         --AUGUST    2017. BINARY JACCARD SIMILARITY
C     UPDATED         --AUGUST    2017. BINARY ASYMMETRIC DICE DISSIMILARITY
C     UPDATED         --AUGUST    2017. BINARY ASYMMETRIC DICE SIMILARITY
C     UPDATED         --AUGUST    2017. BINARY ASYMMETRIC SOKAL DISSIMILARITY
C     UPDATED         --AUGUST    2017. BINARY ASYMMETRIC SOKAL SIMILARITY
C     UPDATED         --AUGUST    2017. YULES Q
C     UPDATED         --AUGUST    2017. CHEYSHEV DISTANCE
C     UPDATED         --AUGUST    2017. MINKOWSKI DISTANCE
C     UPDATED         --AUGUST    2017. GENERALIZED JACCARD COEFFICIENT
C     UPDATED         --AUGUST    2017. GENERALIZED JACCARD DISTANCE
C     UPDATED         --NOVEMBER  2017. DIFF OF BINO PROP LOWE CONF LIMI
C     UPDATED         --NOVEMBER  2017. DIFF OF BINO PROP UPPE CONF LIMI
C     UPDATED         --NOVEMBER  2017. BINOMIAL PROP LOWE CONF LIMI
C     UPDATED         --NOVEMBER  2017. BINOMIAL PROP UPPE CONF LIMI
C     UPDATED         --NOVEMBER  2017. COEFFICIENT OF DISPERSION
C                                       CONFIDENCE LIMITS
C     UPDATED         --DECEMBER  2017. LOWER BONETT STANDARD DEVIATION
C                                       CONFIDENCE LIMIT
C     UPDATED         --DECEMBER  2017. UPPER BONETT STANDARD DEVIATION
C                                       CONFIDENCE LIMIT
C     UPDATED         --JULY      2018. WEIGHTED COVARIANCE
C     UPDATED         --JULY      2018. WEIGHTED CORRELATION
C     UPDATED         --AUGUST    2018. HEDGES G STANDARD ERROR
C     UPDATED         --AUGUST    2018. HEDGES G LOWER CONFIDENCE LIMIT
C     UPDATED         --AUGUST    2018. HEDGES G UPPER CONFIDENCE LIMIT
C     UPDATED         --AUGUST    2018. HAMMING DISTANCE
C     UPDATED         --AUGUST    2018. CANBERRA DISTANCE
C     UPDATED         --AUGUST    2018. WEIGHTED COSINE DISTANCE
C     UPDATED         --OCTOBER   2018. PEARSON SIMILARITY
C     UPDATED         --OCTOBER   2018. SPEARMAN SIMILARITY
C     UPDATED         --OCTOBER   2018. KENDELLS TAU SIMILARITY
C     UPDATED         --OCTOBER   2018. WEIGHTED COSINE DISTANCE
C     UPDATED         --OCTOBER   2018. WEIGHTED COSINE SIMILARITY
C     UPDATED         --NOVEMBER  2018. GROUPED CORRELATION
C     UPDATED         --JANUARY   2019. PYTHON MEAN
C     UPDATED         --JANUARY   2019. YOUDEN INDEX
C     UPDATED         --JULY      2019. LOWER SEMI-INTERQUARTILE RANGE
C     UPDATED         --JULY      2019. UPPER SEMI-INTERQUARTILE RANGE
C     UPDATED         --AUGUST    2019. BINARY GAMMA COEFFICIENT
C     UPDATED         --AUGUST    2019. YULES Y
C     UPDATED         --AUGUST    2019. KENDALL TAU A
C     UPDATED         --AUGUST    2019. KENDALL TAU B
C     UPDATED         --AUGUST    2019. KENDALL TAU C (NOT WORKING YET)
C     UPDATED         --AUGUST    2019. CORRECTION TO RLP COMPUTATION
C     UPDATED         --AUGUST    2019. INTRACLASS CORRELATION
C     UPDATED         --AUGUST    2019. CORRELATION RATIO
C     UPDATED         --SEPTEMBER 2019. RATIO OF MEANS
C     UPDATED         --SEPTEMBER 2019. RATIO OF MEANS LOWER CONFIDENCE
C                                       LIMIT
C     UPDATED         --SEPTEMBER 2019. RATIO OF MEANS UPPER CONFIDENCE
C                                       LIMIT
C     UPDATED         --OCTOBER   2019. DAVID TEST, DAVID TEST CDF
C     UPDATED         --OCTOBER   2019. DAVID TEST PVALUE
C     UPDATED         --OCTOBER   2019. DAVID TEST MINIMUM INDEX
C     UPDATED         --OCTOBER   2019. DAVID TEST MAXIMUM INDEX
C     UPDATED         --OCTOBER   2019. SKEW OUTLIER TEST
C     UPDATED         --OCTOBER   2019. SKEW OUTLIER CDF
C     UPDATED         --OCTOBER   2019. SKEW OUTLIER CRITICAL VALUE
C     UPDATED         --OCTOBER   2019. SKEW OUTLIER INDEX
C     UPDATED         --OCTOBER   2019. SKEW OUTLIER PVALUE
C     UPDATED         --OCTOBER   2019. KURTOSIS OUTLIER TEST
C     UPDATED         --OCTOBER   2019. KURTOSIS OUTLIER CDF
C     UPDATED         --OCTOBER   2019. KURTOSIS OUTLIER CRITICAL VALUE
C     UPDATED         --OCTOBER   2019. KURTOSIS OUTLIER INDEX
C     UPDATED         --OCTOBER   2019. KURTOSIS OUTLIER PVALUE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
C
      CHARACTER*4 ICASZZ
      CHARACTER*4 ITYP91
      CHARACTER*4 IWRITE
      CHARACTER*4 ICASE
      CHARACTER*4 ICASE2
      CHARACTER*12 ICASEE
      CHARACTER*4 IPRSAV
      CHARACTER*4 IDIR
      CHARACTER*4 IFLAG
CCCCC CHARACTER*4 IQUAME
CCCCC CHARACTER*4 IQUASE
      CHARACTER*4 ICASAN
      CHARACTER*4 ICASA2
      CHARACTER*4 ICASA3
      CHARACTER*4 ICASA4
      CHARACTER*4 ICASA5
      CHARACTER*4 ICASDI
      CHARACTER*4 ICAPSW
CCCCC CHARACTER*4 ICAPTY
      CHARACTER*4 IDATSW
      CHARACTER*20 IDIST
      CHARACTER*4 IDIST2
      CHARACTER*4 IDAVT2
      CHARACTER*4 ISKOT2
      CHARACTER*4 IKUOT2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 IFOUND
C
C---------------------------------------------------------------------
C
      DIMENSION TEMP(*)
      DIMENSION TEMPZ(*)
      DIMENSION TEMPZ3(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
      DIMENSION XTEMP3(*)
C
      INTEGER ITEMP1(*)
      INTEGER ITEMP2(*)
      INTEGER ITEMP3(*)
      INTEGER ITEMP4(*)
      INTEGER ITEMP5(*)
      INTEGER ITEMP6(*)
C
      DOUBLE PRECISION DTEMP1(*)
      DOUBLE PRECISION DTEMP2(*)
      DOUBLE PRECISION DTEMP3(*)
C
      DIMENSION ALPHAT(1)
      DIMENSION ADC(1)
      DIMENSION ALOWLV(1)
      DIMENSION AUPPLV(1)
C
      PARAMETER(NUMALZ=15)
      DIMENSION ALPHAV(NUMALZ)
      DIMENSION CV(NUMALZ)
C
      CHARACTER*4 IPNAM1
      CHARACTER*4 IPNAM2
      COMMON/STATIS/APVAL,IPNAM1,IPNAM2
C
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCOS2.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCOHK.INC'
C
      DOUBLE PRECISION DSD
      DOUBLE PRECISION D2
C
      DOUBLE PRECISION DLOWMP
      DOUBLE PRECISION DHIGMP
      DOUBLE PRECISION DLOWMM
      DOUBLE PRECISION DHIGMM
      DOUBLE PRECISION DLOWM2
      DOUBLE PRECISION DHIGM2
      DOUBLE PRECISION DLOWML
      DOUBLE PRECISION DHIGML
      DOUBLE PRECISION DLOWBO
      DOUBLE PRECISION DHIGBO
      DOUBLE PRECISION DLOWGC
      DOUBLE PRECISION DHIGGC
      DOUBLE PRECISION DLOWBC
      DOUBLE PRECISION DHIGBC
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DLOWFW
      DOUBLE PRECISION DHIGFW
CCCCC DOUBLE PRECISION DLOWF1
CCCCC DOUBLE PRECISION DHIGF1
      DOUBLE PRECISION DLOWF2
      DOUBLE PRECISION DHIGF2
      DOUBLE PRECISION DLOWF3
      DOUBLE PRECISION DHIGF3
      DOUBLE PRECISION DLOWSE
      DOUBLE PRECISION DHIGSE
      DOUBLE PRECISION XGDS20
      DOUBLE PRECISION XGDSZ1
      DOUBLE PRECISION XGDSZ2
      DOUBLE PRECISION DLOWGD
      DOUBLE PRECISION DHIGGD
      DOUBLE PRECISION TPLUS
      DOUBLE PRECISION TMINUS
      DOUBLE PRECISION RSUM
      DOUBLE PRECISION RSUMSQ
C
      DOUBLE PRECISION T0
      DOUBLE PRECISION T1
      COMMON /MPCOM/ T0, T1
      LOGICAL IFLAG9
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      INCLUDE 'DPCOP2.INC'
C
C-----START POINT-----------------------------------------------------
C
      DATA ALPHAV/
     1 0.1, 0.5, 1.0, 2.5, 5.0, 10.0, 25.0,
     1 50.0,
     1 75.0, 90.0, 95.0, 97.5, 99.0, 99.5, 99.9/
C
      ISUBN1='CMPS'
      ISUBN2='T2  '
      IWRITE='OFF'
      IPRSAV=IPRINT
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(NS2.LT.1)THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,31)
   31   FORMAT('***** ERROR IN CMPST2--THE NUMBER OF OBSERVATIONS ',
     1         'MUST BE AT LEAST 1;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,34)NS2
   34   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PSTA')THEN
        WRITE(ICOUT,70)
   70   FORMAT('AT THE BEGINNING OF CMPST2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,71)IBUGG3,ISUBRO
   71   FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,72)NS2,NSZ,NUMV2,ICASPL
   72   FORMAT('NS2,NSZ,NUMV2,ICASPL = ',3I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
        DO73I=1,MAX(NS2,NSZ)
          WRITE(ICOUT,74)I,TEMP(I),TEMPZ(I)
   74     FORMAT('I, TEMP(I),TEMPZ(I) = ',I8,2F15.7)
          CALL DPWRST('XXX','BUG ')
   73   CONTINUE
      ENDIF
C
      NS2SAV=NS2
      NSZSAV=NSZ
      IF(ICASPL.EQ.'NUMB')GOTO11310
      IF(ICASPL.EQ.'COUN')GOTO11310
      IF(ICASPL.EQ.'SIZE')GOTO11310
      IF(ICASPL.EQ.'INTC')GOTO11312
      IF(ICASPL.EQ.'INMN')GOTO31760
      IF(ICASPL.EQ.'INMX')GOTO31770
      IF(ICASPL.EQ.'INEX')GOTO31780
      IF(ICASPL.EQ.'UNIQ')GOTO11315
C
      IFLAGN=0
      IF(NUMV2.GT.1)THEN
        IF(NSZ.GT.0 .AND. NSZ.NE.NS2)THEN
          IFLAGN=2
        ELSE
          IFLAGN=1
        ENDIF
      ENDIF
C
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PSTA')THEN
        WRITE(ICOUT,78)IFLAGN
   78   FORMAT('IFLAGN = ',I4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      ICNT=0
      DO110I=1,NS2
        IF(IFLAGN.EQ.0 .OR. IFLAGN.EQ.2)THEN
          IF(TEMP(I).NE.PSTAMV)THEN
            ICNT=ICNT+1
            TEMP(ICNT)=TEMP(I)
          ENDIF
        ELSEIF(IFLAGN.EQ.1)THEN
          IF(TEMP(I).NE.PSTAMV .AND. TEMPZ(I).NE.PSTAMV)THEN
            ICNT=ICNT+1
            TEMP(ICNT)=TEMP(I)
            TEMPZ(ICNT)=TEMPZ(I)
          ENDIF
        ENDIF
  110 CONTINUE
C
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PSTA')THEN
        WRITE(ICOUT,79)ICNT
   79   FORMAT('AFTER CHECK FOR MISSING VALUES, ICNT = ',I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(ICNT.EQ.0)THEN
        RIGHT=PSTAMV
        GOTO79000
      ENDIF
      NS2=ICNT
C
      IF(IFLAGN.EQ.2)THEN
        ICNT=0
        DO120I=1,NSZ
          IF(TEMPZ(I).NE.PSTAMV)THEN
            ICNT=ICNT+1
            TEMPZ(ICNT)=TEMPZ(I)
          ENDIF
  120   CONTINUE
C
        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PSTA')THEN
          WRITE(ICOUT,129)ICNT
  129     FORMAT('AFTER CHECK TEMPZ FOR MISSING VALUES, ICNT = ',I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        IF(ICNT.EQ.0)THEN
          RIGHT=PSTAMV
          GOTO79000
        ENDIF
        NSZ=ICNT
      ENDIF
C
      IF(ICASPL.EQ.'SUM')GOTO11320
      IF(ICASPL.EQ.'PROD')GOTO11330
      IF(ICASPL.EQ.'INTE')GOTO11340
      IF(ICASPL.EQ.'MIDR')GOTO11350
      IF(ICASPL.EQ.'MEAN'.OR.ICASPL.EQ.'AVER')GOTO11360
      IF(ICASPL.EQ.'MECL')GOTO11360
      IF(ICASPL.EQ.'MIDM')GOTO11370
      IF(ICASPL.EQ.'SHMM')GOTO11372
      IF(ICASPL.EQ.'DSHM')GOTO11373
      IF(ICASPL.EQ.'SHMR')GOTO11374
      IF(ICASPL.EQ.'DSHR')GOTO11375
      IF(ICASPL.EQ.'MEDI')GOTO11380
      IF(ICASPL.EQ.'MDCL')GOTO11380
      IF(ICASPL.EQ.'SD')GOTO11390
      IF(ICASPL.EQ.'RMS')GOTO11395
      IF(ICASPL.EQ.'SSQM')GOTO11399
      IF(ICASPL.EQ.'DSSQ')GOTO19399
C
      IF(ICASPL.EQ.'SSQ' .OR. ICASPL.EQ.'RSUM' .OR.
     1   ICASPL.EQ.'RLP' .OR. ICASPL.EQ.'DSSQ' .OR.
     1   ICASPL.EQ.'DRSC')THEN
C
        IHP='CAPV'
        IHP2='ALUE'
        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
          XCAP=CPUMIN
        ELSE
          XCAP=VALUE(ILOCP)
        ENDIF
C
        IF(ICASPL.EQ.'SSQ')GOTO11396
        IF(ICASPL.EQ.'RSUM')GOTO11397
        IF(ICASPL.EQ.'RLP ')GOTO11405
        IF(ICASPL.EQ.'DSSQ')GOTO11398
        IF(ICASPL.EQ.'DRSC')GOTO11401
      ENDIF
      IF(ICASPL.EQ.'JSCO')GOTO11403
C
      IF(ICASPL.EQ.'VARI')GOTO11400
      IF(ICASPL.EQ.'PREC')GOTO11400
      IF(ICASPL.EQ.'RESD')GOTO11410
      IF(ICASPL.EQ.'REVA')GOTO11415
      IF(ICASPL.EQ.'CVAR')GOTO11418
      IF(ICASPL.EQ.'UCVA')GOTO11418
      IF(ICASPL.EQ.'SNRA')GOTO11419
      IF(ICASPL.EQ.'RANG')GOTO11420
      IF(ICASPL.EQ.'CDIS')GOTO11421
      IF(ICASPL.EQ.'LCDL')GOTO11427
      IF(ICASPL.EQ.'UCDL')GOTO11427
      IF(ICASPL.EQ.'1LCD')GOTO11427
      IF(ICASPL.EQ.'1UCD')GOTO11427
      IF(ICASPL.EQ.'LCDQ')GOTO11428
      IF(ICASPL.EQ.'UCDQ')GOTO11428
      IF(ICASPL.EQ.'IDIS')GOTO11422
      IF(ICASPL.EQ.'MADR')GOTO11423
      IF(ICASPL.EQ.'DCDI')GOTO11424
      IF(ICASPL.EQ.'DIDI')GOTO11425
      IF(ICASPL.EQ.'DMMD')GOTO11426
      IF(ICASPL.EQ.'MINI')GOTO11430
      IF(ICASPL.EQ.'MAXI')GOTO11440
      IF(ICASPL.EQ.'SKEW')GOTO11450
      IF(ICASPL.EQ.'GSKE')GOTO11452
      IF(ICASPL.EQ.'PSK2')GOTO11454
      IF(ICASPL.EQ.'KURT')GOTO11460
      IF(ICASPL.EQ.'EKUR')GOTO11465
      IF(ICASPL.EQ.'AUCR')GOTO11470
      IF(ICASPL.EQ.'COVA')GOTO11480
      IF(ICASPL.EQ.'CORR')GOTO11490
      IF(ICASPL.EQ.'COAB')GOTO11490
      IF(ICASPL.EQ.'COPV')GOTO11490
      IF(ICASPL.EQ.'COCD')GOTO11490
      IF(ICASPL.EQ.'PDIS')GOTO11490
      IF(ICASPL.EQ.'PSIM')GOTO11490
      IF(ICASPL.EQ.'MDIS')GOTO11491
      IF(ICASPL.EQ.'CNDI')GOTO11492
      IF(ICASPL.EQ.'PCOR')GOTO11495
      IF(ICASPL.EQ.'PCAB')GOTO11495
      IF(ICASPL.EQ.'PCPV')GOTO11495
      IF(ICASPL.EQ.'PCCD')GOTO11495
      IF(ICASPL.EQ.'MAND')GOTO11496
      IF(ICASPL.EQ.'CHDI')GOTO11497
      IF(ICASPL.EQ.'COSD')GOTO11498
      IF(ICASPL.EQ.'COSS')GOTO11498
      IF(ICASPL.EQ.'ACOS')GOTO11498
      IF(ICASPL.EQ.'ACOD')GOTO11498
      IF(ICASPL.EQ.'EUCD')GOTO11499
      IF(ICASPL.EQ.'EUCL')GOTO11499
      IF(ICASPL.EQ.'DOTP')GOTO11499
      IF(ICASPL.EQ.'RACR')GOTO11500
      IF(ICASPL.EQ.'RACC')GOTO11500
      IF(ICASPL.EQ.'RACP')GOTO11500
      IF(ICASPL.EQ.'RALP')GOTO11500
      IF(ICASPL.EQ.'RAUP')GOTO11500
      IF(ICASPL.EQ.'RACA')GOTO11500
      IF(ICASPL.EQ.'RDIS')GOTO11500
      IF(ICASPL.EQ.'RSIM')GOTO11500
      IF(ICASPL.EQ.'HDIS')GOTO11502
      IF(ICASPL.EQ.'RPCR')GOTO11505
      IF(ICASPL.EQ.'RPCA')GOTO11505
      IF(ICASPL.EQ.'PDIF')GOTO11509
      IF(ICASPL.EQ.'SDME')GOTO11510
      IF(ICASPL.EQ.'AUCV')GOTO11520
      IF(ICASPL.EQ.'RACV')GOTO11530
      IF(ICASPL.EQ.'PEAG')GOTO11531
      IF(ICASPL.EQ.'PEDI')GOTO11531
      IF(ICASPL.EQ.'COMO')GOTO31480
      IF(ICASPL.EQ.'RACM')GOTO31530
      IF(ICASPL.EQ.'KTAU')GOTO31540
      IF(ICASPL.EQ.'KTAA')GOTO31540
      IF(ICASPL.EQ.'KTCD')GOTO31540
      IF(ICASPL.EQ.'KTPV')GOTO31540
      IF(ICASPL.EQ.'KTPL')GOTO31540
      IF(ICASPL.EQ.'KTPU')GOTO31540
      IF(ICASPL.EQ.'KDIS')GOTO31540
      IF(ICASPL.EQ.'KSIM')GOTO31540
      IF(ICASPL.EQ.'PKTA')GOTO31545
      IF(ICASPL.EQ.'PKAB')GOTO31545
      IF(ICASPL.EQ.'RATI')GOTO31550
      IF(ICASPL.EQ.'BRAT')GOTO31551
      IF(ICASPL.EQ.'RMEA')GOTO31565
      IF(ICASPL.EQ.'RMLL')GOTO31565
      IF(ICASPL.EQ.'RMUL')GOTO31565
      IF(ICASPL.EQ.'ODRA')GOTO31560
      IF(ICASPL.EQ.'ORSE')GOTO31570
      IF(ICASPL.EQ.'RELR')GOTO31580
      IF(ICASPL.EQ.'CRAM')GOTO31590
      IF(ICASPL.EQ.'PEAR')GOTO31600
      IF(ICASPL.EQ.'FALP')GOTO31610
      IF(ICASPL.EQ.'FALN')GOTO31620
      IF(ICASPL.EQ.'TRUP')GOTO31630
      IF(ICASPL.EQ.'TRUN')GOTO31640
      IF(ICASPL.EQ.'SENS')GOTO31650
      IF(ICASPL.EQ.'SPEC')GOTO31660
      IF(ICASPL.EQ.'PPV ')GOTO31670
      IF(ICASPL.EQ.'NPV ')GOTO31680
      IF(ICASPL.EQ.'BMDI')GOTO31685
      IF(ICASPL.EQ.'BMRD')GOTO31685
      IF(ICASPL.EQ.'BMSD')GOTO31685
      IF(ICASPL.EQ.'BJDI')GOTO31685
      IF(ICASPL.EQ.'BSDI')GOTO31685
      IF(ICASPL.EQ.'BDDI')GOTO31685
      IF(ICASPL.EQ.'BMSI')GOTO31685
      IF(ICASPL.EQ.'BMRS')GOTO31685
      IF(ICASPL.EQ.'BMSS')GOTO31685
      IF(ICASPL.EQ.'BJSI')GOTO31685
      IF(ICASPL.EQ.'BSSI')GOTO31685
      IF(ICASPL.EQ.'BDSI')GOTO31685
      IF(ICASPL.EQ.'YULQ')GOTO31685
      IF(ICASPL.EQ.'YULY')GOTO31685
      IF(ICASPL.EQ.'GC22')GOTO31685
      IF(ICASPL.EQ.'YOUD')GOTO31685
      IF(ICASPL.EQ.'GJCO')GOTO31688
      IF(ICASPL.EQ.'GJDI')GOTO31688
      IF(ICASPL.EQ.'LODR')GOTO31690
      IF(ICASPL.EQ.'LOSE')GOTO31700
      IF(ICASPL.EQ.'ICCR')GOTO31715
      IF(ICASPL.EQ.'CRAT')GOTO31715
C
      IF(ICASPL.EQ.'LOWH')GOTO11540
      IF(ICASPL.EQ.'UPPH')GOTO11550
      IF(ICASPL.EQ.'LOWQ')GOTO11560
      IF(ICASPL.EQ.'UPPQ')GOTO11570
      IF(ICASPL.EQ.'MHIN')GOTO11575
      IF(ICASPL.EQ.'DMHI')GOTO11576
      IF(ICASPL.EQ.'TMEA')GOTO11578
      IF(ICASPL.EQ.'DTRI')GOTO11579
C
      IF(ICASPL.EQ.'TRIM' .OR. ICASPL.EQ.'WINM' .OR.
     1   ICASPL.EQ.'WIVA' .OR. ICASPL.EQ.'WISD' .OR.
     1   ICASPL.EQ.'WICV' .OR. ICASPL.EQ.'WICR' .OR.
     1   ICASPL.EQ.'TRSD' .OR. ICASPL.EQ.'WETM' .OR.
     1   ICASPL.EQ.'TMSE' .OR. ICASPL.EQ.'DTRM' .OR.
     1   ICASPL.EQ.'DWNM' .OR. ICASPL.EQ.'DWSD' .OR.
     1   ICASPL.EQ.'DWVA' .OR. ICASPL.EQ.'DTSD')THEN
C
C        2012/10: FOR TRIMMED MEAN, CAN SPECIFY EITHER A SPECIFIC NUMBER
C                 TO TRIM OR A PERCENTAGE TO TRIM.  CHECK FOR SPECIFIC
C                 NUMBER FIRST AND IF NOT SPECIFIED, CHECK FOR A
C                 PERCENTAGE.
C
        NTRIM1=-1
        NTRIM2=-1
        P1=-99.0
        P2=-99.0
C
        IHP='NTRI'
        IHP2='M1  '
        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.'NO')THEN
          NTRIM1=INT(VALUE(ILOCP)+0.1)
          IF(NTRIM1.LT.0)NTRIM1=0
        ENDIF
C
        IHP='NTRI'
        IHP2='M2  '
        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.'NO')THEN
          NTRIM2=INT(VALUE(ILOCP)+0.1)
          IF(NTRIM2.LT.0)NTRIM2=0
        ENDIF
C
        IF(NTRIM1.LE.0)THEN
          IHP='P1  '
          IHP2='    '
          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
          IF(PROP1.LT.0.0 .OR. PROP1.GT.100.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11581)
11581       FORMAT('***** ERROR IN CMPSTA--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11582)
11582       FORMAT('      THE PROPORTION FOR TRIMMING/WINSORIZING ',
     1             'BELOW')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11583)
11583       FORMAT('      MUST BE BETWEEN 0 AND 100, BUT WAS NOT.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11584)PROP1
11584       FORMAT('      PARAMETER P1 = LOWER PROPORTION = ',G15.7)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11586)
11586       FORMAT('      USE THE LET COMMAND TO PRE-DEFINE P1 AS IN')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11587)
11587       FORMAT('      LET P1 = 25')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ELSE
            PROP1=VALUE(ILOCP)
          ENDIF
        ENDIF
C
        IF(NTRIM2.LE.0)THEN
          IHP='P2  '
          IHP2='    '
          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
          IF(PROP2.LT.0.0 .OR. PROP2.GT.100.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11581)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11592)
11592       FORMAT('      THE PROPORTION FOR TRIMMING/WINSORIZING ',
     1             'ABOVE')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11583)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11594)PROP2
11594       FORMAT('      PARAMETER P2 = LOWER PROPORTION = ',G15.7)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11596)
11596       FORMAT('      USE THE LET COMMAND TO PRE-DEFINE P2 AS IN')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,11597)
11597       FORMAT('      LET P2 = 25')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ELSE
            PROP2=VALUE(ILOCP)
          ENDIF
        ENDIF
C
        IF(ICASPL.EQ.'TRIM')GOTO11580
        IF(ICASPL.EQ.'WINM')GOTO11590
        IF(ICASPL.EQ.'WIVA')GOTO12010
        IF(ICASPL.EQ.'WISD')GOTO12030
        IF(ICASPL.EQ.'WICV')GOTO12050
        IF(ICASPL.EQ.'WICR')GOTO12070
        IF(ICASPL.EQ.'WETM')GOTO11660
        IF(ICASPL.EQ.'TMSE')GOTO12150
        IF(ICASPL.EQ.'DTRM')GOTO12210
        IF(ICASPL.EQ.'DWNM')GOTO12220
        IF(ICASPL.EQ.'DWSD')GOTO12320
        IF(ICASPL.EQ.'DWVA')GOTO12330
        IF(ICASPL.EQ.'DTSD')GOTO12590
        IF(ICASPL.EQ.'TRSD')GOTO31710
      ENDIF
C
      IF(ICASPL.EQ.'MIDQ')GOTO11610
      IF(ICASPL.EQ.'1DEC')GOTO11610
      IF(ICASPL.EQ.'2DEC')GOTO11610
      IF(ICASPL.EQ.'3DEC')GOTO11610
      IF(ICASPL.EQ.'4DEC')GOTO11610
      IF(ICASPL.EQ.'5DEC')GOTO11610
      IF(ICASPL.EQ.'6DEC')GOTO11610
      IF(ICASPL.EQ.'7DEC')GOTO11610
      IF(ICASPL.EQ.'8DEC')GOTO11610
      IF(ICASPL.EQ.'9DEC')GOTO11610
C
      IF(ICASPL.EQ.'PERC')GOTO11615
C
      IF(ICASPL.EQ.'WEME')GOTO11620
      IF(ICASPL.EQ.'WOSM')GOTO11625
      IF(ICASPL.EQ.'WEMD')GOTO11630
      IF(ICASPL.EQ.'WESD')GOTO11640
      IF(ICASPL.EQ.'WEVA')GOTO11650
      IF(ICASPL.EQ.'WESK')GOTO11655
      IF(ICASPL.EQ.'WSUM')GOTO11670
      IF(ICASPL.EQ.'WSSQ')GOTO11670
      IF(ICASPL.EQ.'WSAB')GOTO11670
      IF(ICASPL.EQ.'WSDV')GOTO11670
      IF(ICASPL.EQ.'WAAB')GOTO11670
      IF(ICASPL.EQ.'WSSD')GOTO11670
      IF(ICASPL.EQ.'WCOV')GOTO11680
      IF(ICASPL.EQ.'WCOR')GOTO11680
      IF(ICASPL.EQ.'GCOR')GOTO11685
      IF(ICASPL.EQ.'WCDI')GOTO11690
      IF(ICASPL.EQ.'WCSI')GOTO11690
C
      IF(ICASPL.EQ.'VM')GOTO11700
      IF(ICASPL.EQ.'VAME')GOTO11700
C
      IF(ICASPL.EQ.'SIFR')GOTO11710
      IF(ICASPL.EQ.'SIAM')GOTO11720
      IF(ICASPL.EQ.'LIIN')GOTO11730
      IF(ICASPL.EQ.'LIIS')GOTO11735
      IF(ICASPL.EQ.'LISL')GOTO11740
      IF(ICASPL.EQ.'LISS')GOTO11745
      IF(ICASPL.EQ.'LIRE')GOTO11750
      IF(ICASPL.EQ.'LICO')GOTO11760
      IF(ICASPL.EQ.'REPE')GOTO11770
      IF(ICASPL.EQ.'REPR')GOTO11780
      IF(ICASPL.EQ.'CINT')GOTO11790
      IF(ICASPL.EQ.'CSD ')GOTO11795
C
      IF(ICASPL.EQ.'SN0')GOTO11810
      IF(ICASPL.EQ.'SN+')GOTO11810
      IF(ICASPL.EQ.'SN-')GOTO11810
      IF(ICASPL.EQ.'SN00')GOTO11810
C
      IF(ICASPL.EQ.'CP')GOTO11900
      IF(ICASPL.EQ.'CPK')GOTO11900
      IF(ICASPL.EQ.'CNPK')GOTO11900
      IF(ICASPL.EQ.'CPM')GOTO11900
      IF(ICASPL.EQ.'CC')GOTO11900
      IF(ICASPL.EQ.'CPL')GOTO11900
      IF(ICASPL.EQ.'CPU')GOTO11900
      IF(ICASPL.EQ.'NPMK')GOTO11900
      IF(ICASPL.EQ.'CNPM')GOTO11900
      IF(ICASPL.EQ.'CNP')GOTO11900
      IF(ICASPL.EQ.'CPMK')GOTO11900
      IF(ICASPL.EQ.'PEDE')GOTO11900
      IF(ICASPL.EQ.'EXLO')GOTO11900
C
      IF(ICASPL.EQ.'NOPP' .OR. ICASPL.EQ.'NOLO' .OR.
     1   ICASPL.EQ.'NOSC')THEN
        IDIST='NORMAL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'UNPP' .OR. ICASPL.EQ.'UNLO' .OR.
     1   ICASPL.EQ.'UNSC')THEN
        IDIST='UNIFORM'
        GOTO11910
      ELSEIF(ICASPL.EQ.'CAPP' .OR. ICASPL.EQ.'CALO' .OR.
     1   ICASPL.EQ.'CASC')THEN
        IDIST='CAUCHY'
        GOTO11910
      ELSEIF(ICASPL.EQ.'LOPP' .OR. ICASPL.EQ.'LOLO' .OR.
     1   ICASPL.EQ.'LOSC')THEN
        IDIST='LOGISTIC'
        GOTO11910
      ELSEIF(ICASPL.EQ.'DEPP' .OR. ICASPL.EQ.'DELO' .OR.
     1   ICASPL.EQ.'DESC')THEN
        IDIST='DOUBLE EXPONENTIAL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'COPP' .OR. ICASPL.EQ.'COLO' .OR.
     1   ICASPL.EQ.'COSC')THEN
        IDIST='COSINE'
        GOTO11910
      ELSEIF(ICASPL.EQ.'SIPP' .OR. ICASPL.EQ.'SILO' .OR.
     1   ICASPL.EQ.'SISC')THEN
        IDIST='SINE'
        GOTO11910
      ELSEIF(ICASPL.EQ.'ANPP' .OR. ICASPL.EQ.'ANLO' .OR.
     1   ICASPL.EQ.'ANSC')THEN
        IDIST='ANGLIT'
        GOTO11910
      ELSEIF(ICASPL.EQ.'ARPP' .OR. ICASPL.EQ.'ARLO' .OR.
     1   ICASPL.EQ.'ARSC')THEN
        IDIST='ARCSINE'
        GOTO11910
      ELSEIF(ICASPL.EQ.'EXPP' .OR. ICASPL.EQ.'EXLO' .OR.
     1   ICASPL.EQ.'EXSC')THEN
        IDIST='EXPONENTIAL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'HSPP' .OR. ICASPL.EQ.'HSLO' .OR.
     1   ICASPL.EQ.'HSSC')THEN
        IDIST='HYPERBOLIC SECANT'
        GOTO11910
      ELSEIF(ICASPL.EQ.'SLPP' .OR. ICASPL.EQ.'SLLO' .OR.
     1   ICASPL.EQ.'SLSC')THEN
        IDIST='SLASH'
        GOTO11910
      ELSEIF(ICASPL.EQ.'MXPP' .OR. ICASPL.EQ.'MXLO' .OR.
     1   ICASPL.EQ.'MXSC')THEN
        IDIST='MAXWELL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'RAPP' .OR. ICASPL.EQ.'RALO' .OR.
     1   ICASPL.EQ.'RASC')THEN
        IDIST='RAYLEIGH'
        GOTO11910
      ELSEIF(ICASPL.EQ.'HNPP' .OR. ICASPL.EQ.'HNLO' .OR.
     1   ICASPL.EQ.'HNSC')THEN
        IDIST='HALF-NORMAL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'HCPP' .OR. ICASPL.EQ.'HCLO' .OR.
     1   ICASPL.EQ.'HCSC')THEN
        IDIST='HALF-CAUCHY'
        GOTO11910
      ELSEIF(ICASPL.EQ.'SCPP' .OR. ICASPL.EQ.'SCLO' .OR.
     1   ICASPL.EQ.'SCSC')THEN
        IDIST='SEMI-CIRCULAR'
        GOTO11910
      ELSEIF(ICASPL.EQ.'G1PP' .OR. ICASPL.EQ.'G1LO' .OR.
     1   ICASPL.EQ.'G1SC')THEN
        IDIST='MINIMUM GUMBEL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'G2PP' .OR. ICASPL.EQ.'G2LO' .OR.
     1   ICASPL.EQ.'G2SC')THEN
        IDIST='MAXIMUM GUMBEL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'TLPP' .OR. ICASPL.EQ.'TLSH' .OR.
     1       ICASPL.EQ.'TLLO' .OR. ICASPL.EQ.'TLSC')THEN
        IDIST='TUKEY-LAMBDA'
        GOTO11910
      ELSEIF(ICASPL.EQ.'WEPP' .OR. ICASPL.EQ.'WESH' .OR.
     1       ICASPL.EQ.'WELO' .OR. ICASPL.EQ.'WESC')THEN
        IDIST='WEIBULL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'W2PP' .OR. ICASPL.EQ.'W2SH' .OR.
     1       ICASPL.EQ.'W2SC')THEN
        IDIST='2PAR WEIBULL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'LNPP' .OR. ICASPL.EQ.'LNSH' .OR.
     1       ICASPL.EQ.'LNLO' .OR. ICASPL.EQ.'LNSC')THEN
        IDIST='LOGNORMAL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'GPPP' .OR. ICASPL.EQ.'GPSH' .OR.
     1       ICASPL.EQ.'GPLO' .OR. ICASPL.EQ.'GPSC')THEN
        IDIST='GPARETO'
        GOTO11910
      ELSEIF(ICASPL.EQ.'GHPP' .OR. ICASPL.EQ.'GHSH' .OR.
     1       ICASPL.EQ.'GHS2' .OR.
     1       ICASPL.EQ.'GHLO' .OR. ICASPL.EQ.'GHSC')THEN
        IDIST='GH'
        GOTO11910
      ELSEIF(ICASPL.EQ.'GPPC' .OR. ICASPL.EQ.'GSHA' .OR.
     1       ICASPL.EQ.'GLOC' .OR. ICASPL.EQ.'GSCA')THEN
        IDIST='G'
        GOTO11910
      ELSEIF(ICASPL.EQ.'WAPP' .OR. ICASPL.EQ.'WASH' .OR.
     1       ICASPL.EQ.'WALO' .OR. ICASPL.EQ.'WASC')THEN
        IDIST='WALD'
        GOTO11910
      ELSEIF(ICASPL.EQ.'GAPP' .OR. ICASPL.EQ.'GASH' .OR.
     1       ICASPL.EQ.'GALO' .OR. ICASPL.EQ.'GASC')THEN
        IDIST='GAMMA'
        GOTO11910
      ELSEIF(ICASPL.EQ.'IWPP' .OR. ICASPL.EQ.'IWSH' .OR.
     1       ICASPL.EQ.'IWLO' .OR. ICASPL.EQ.'IWSC')THEN
        IDIST='INVERTED WEIBULL'
        GOTO11910
      ELSEIF(ICASPL.EQ.'FLPP' .OR. ICASPL.EQ.'FLSH' .OR.
     1       ICASPL.EQ.'FLLO' .OR. ICASPL.EQ.'FLSC')THEN
        IDIST='FATIGUE LIFE'
        GOTO11910
      ENDIF
C
      IF(ICASPL.EQ.'NOAD' .OR. ICASPL.EQ.'NADL' .OR.
     1   ICASPL.EQ.'NADS')THEN
        IDIST='NORMAL'
        GOTO11915
      ELSEIF(ICASPL.EQ.'EXAD' .OR. ICASPL.EQ.'EADL' .OR.
     1   ICASPL.EQ.'EADS')THEN
        IDIST='EXPONENTIAL'
        GOTO11915
      ELSEIF(ICASPL.EQ.'DXAL' .OR. ICASPL.EQ.'DXAS' .OR.
     1   ICASPL.EQ.'DXAD')THEN
        IDIST='DOUBLE EXPONENTIAL'
        GOTO11915
      ELSEIF(ICASPL.EQ.'GUAL' .OR. ICASPL.EQ.'GUAS' .OR.
     1   ICASPL.EQ.'GUAD')THEN
        IDIST='GUMBEL'
        GOTO11915
      ELSEIF(ICASPL.EQ.'LOAL' .OR. ICASPL.EQ.'LOAS' .OR.
     1   ICASPL.EQ.'LOAD')THEN
        IDIST='LOGISTIC'
        GOTO11915
      ELSEIF(ICASPL.EQ.'UNAL' .OR. ICASPL.EQ.'UNAS' .OR.
     1   ICASPL.EQ.'UNAD')THEN
        IDIST='UNIFORM'
        GOTO11915
      ELSEIF(ICASPL.EQ.'MXAL' .OR. ICASPL.EQ.'MXAS' .OR.
     1   ICASPL.EQ.'MXAD')THEN
        IDIST='MAXWELL'
        GOTO11915
      ELSEIF(ICASPL.EQ.'RAAL' .OR. ICASPL.EQ.'RAAS' .OR.
     1   ICASPL.EQ.'RAAD')THEN
        IDIST='RAYLEIGH'
        GOTO11915
      ELSEIF(ICASPL.EQ.'GAAZ' .OR. ICASPL.EQ.'GAAS' .OR.
     1   ICASPL.EQ.'GAAD')THEN
        IDIST='GAMMA'
        GOTO11915
      ELSEIF(ICASPL.EQ.'WEAZ' .OR. ICASPL.EQ.'WEAS' .OR.
     1   ICASPL.EQ.'WEAD')THEN
        IDIST='WEIBULL'
        GOTO11915
      ELSEIF(ICASPL.EQ.'LNAZ' .OR. ICASPL.EQ.'LNAS' .OR.
     1   ICASPL.EQ.'LNAD')THEN
        IDIST='LOGNORMAL'
        GOTO11915
      ELSEIF(ICASPL.EQ.'FLAZ' .OR. ICASPL.EQ.'FLAS' .OR.
     1   ICASPL.EQ.'FLAD')THEN
        IDIST='FATIGUE LIFE'
        GOTO11915
      ELSEIF(ICASPL.EQ.'FRAZ' .OR. ICASPL.EQ.'FRAS' .OR.
     1   ICASPL.EQ.'FRAD')THEN
        IDIST='FRECHET'
        GOTO11915
      ELSEIF(ICASPL.EQ.'LXAZ' .OR. ICASPL.EQ.'LXAS' .OR.
     1   ICASPL.EQ.'LXAD')THEN
        IDIST='LOGISTIC EXPONENTIAL'
        GOTO11915
      ELSEIF(ICASPL.EQ.'IGAZ' .OR. ICASPL.EQ.'IGAS' .OR.
     1   ICASPL.EQ.'IGAD')THEN
        IDIST='INVERTED GAMMA'
        GOTO11915
      ELSEIF(ICASPL.EQ.'B1AZ' .OR. ICASPL.EQ.'B1AS' .OR.
     1   ICASPL.EQ.'B1AD')THEN
        IDIST='BURR TYPE 10'
        GOTO11915
      ELSEIF(ICASPL.EQ.'GEAZ' .OR. ICASPL.EQ.'GEAS' .OR.
     1   ICASPL.EQ.'GEAD')THEN
        IDIST='GEOMETRIC EXTR EXPO'
        GOTO11915
      ENDIF
C
      IF(ICASPL.EQ.'BCPP')GOTO11920
      IF(ICASPL.EQ.'BCLA')GOTO11920
C
      IF(ICASPL.EQ.'EXTR')GOTO11933
      IF(ICASPL.EQ.'AAD ')GOTO11935
      IF(ICASPL.EQ.'AADM')GOTO11938
      IF(ICASPL.EQ.'MAD ')GOTO11940
      IF(ICASPL.EQ.'MADN')GOTO11940
      IF(ICASPL.EQ.'GEME')GOTO11950
      IF(ICASPL.EQ.'GESD')GOTO11960
      IF(ICASPL.EQ.'HAME')GOTO11970
      IF(ICASPL.EQ.'IQRA')GOTO11980
      IF(ICASPL.EQ.'NIQR')GOTO11980
      IF(ICASPL.EQ.'SIQL')GOTO11980
      IF(ICASPL.EQ.'SIQU')GOTO11980
      IF(ICASPL.EQ.'QQRA')GOTO11982
      IF(ICASPL.EQ.'BILO')GOTO11990
      IF(ICASPL.EQ.'BISC')GOTO12000
      IF(ICASPL.EQ.'BIMV')GOTO12090
      IF(ICASPL.EQ.'BIMC')GOTO12100
C
      IF(ICASPL.EQ.'PBMV' .OR. ICASPL.EQ.'PBCR' .OR.
     1   ICASPL.EQ.'DPBN')THEN
C
        IHP='BETA'
        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)
        IF(IERROR.EQ.'YES')THEN
          BETA=0.1
        ELSE
          BETA=VALUE(ILOCP)
        ENDIF
C
        IF(ICASPL.EQ.'PBMV')GOTO12110
        IF(ICASPL.EQ.'PBCR')GOTO12115
        IF(ICASPL.EQ.'DPBN')GOTO12360
      ENDIF
C
      IF(ICASPL.EQ.'HLEH')GOTO12120
      IF(ICASPL.EQ.'QUAN')GOTO12130
      IF(ICASPL.EQ.'DRAT')GOTO12135
      IF(ICASPL.EQ.'QUSE')GOTO12140
      IF(ICASPL.EQ.'BICR')GOTO12160
      IF(ICASPL.EQ.'CDIG')GOTO12172
      IF(ICASPL.EQ.'NCDI')GOTO12174
      IF(ICASPL.EQ.'SNSC')GOTO12176
      IF(ICASPL.EQ.'QNSC')GOTO12178
C
      IF(ICASPL.EQ.'LPME' .OR. ICASPL.EQ.'LPVA' .OR.
     1   ICASPL.EQ.'LPSD' .OR. ICASPL.EQ.'DLPL' .OR.
     1   ICASPL.EQ.'DLPV' .OR. ICASPL.EQ.'DLPS')THEN
C
        IHP='P   '
        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)
        IF(IERROR.EQ.'YES')THEN
          P=1.5
        ELSE
          P=VALUE(ILOCP)
        ENDIF
C
        IF(ICASPL.EQ.'LPME')GOTO31720
        IF(ICASPL.EQ.'LPVA')GOTO31730
        IF(ICASPL.EQ.'LPSD')GOTO31740
        IF(ICASPL.EQ.'DLPL')GOTO12540
        IF(ICASPL.EQ.'DLPV')GOTO12550
        IF(ICASPL.EQ.'DLPS')GOTO12560
      ENDIF
C
      IF(ICASPL.EQ.'BPRO')GOTO31750
      IF(ICASPL.EQ.'BPLC')GOTO31750
      IF(ICASPL.EQ.'BPUC')GOTO31750
      IF(ICASPL.EQ.'BPRC')GOTO31750
      IF(ICASPL.EQ.'GRUB')GOTO31790
      IF(ICASPL.EQ.'GCDF')GOTO31795
      IF(ICASPL.EQ.'GDIR')GOTO31810
      IF(ICASPL.EQ.'GIND')GOTO31820
      IF(ICASPL.EQ.'DCDF')GOTO31825
      IF(ICASPL.EQ.'DPVA')GOTO31825
      IF(ICASPL.EQ.'DMNI')GOTO31825
      IF(ICASPL.EQ.'DMXI')GOTO31825
      IF(ICASPL.EQ.'DACV')GOTO31825
      IF(ICASPL.EQ.'DAVI')GOTO31825
      IF(ICASPL.EQ.'SOCD')GOTO31828
      IF(ICASPL.EQ.'SOCV')GOTO31828
      IF(ICASPL.EQ.'SOPV')GOTO31828
      IF(ICASPL.EQ.'SOIN')GOTO31828
      IF(ICASPL.EQ.'SOUT')GOTO31828
      IF(ICASPL.EQ.'KOCD')GOTO31829
      IF(ICASPL.EQ.'KOCV')GOTO31829
      IF(ICASPL.EQ.'KOPV')GOTO31829
      IF(ICASPL.EQ.'KOIN')GOTO31829
      IF(ICASPL.EQ.'KOUT')GOTO31829
      IF(ICASPL.EQ.'1TTE')GOTO31830
      IF(ICASPL.EQ.'1TCD')GOTO31830
      IF(ICASPL.EQ.'1T2P')GOTO31830
      IF(ICASPL.EQ.'1TLP')GOTO31830
      IF(ICASPL.EQ.'1TUP')GOTO31830
      IF(ICASPL.EQ.'2TTE')GOTO31840
      IF(ICASPL.EQ.'2TCD')GOTO31840
      IF(ICASPL.EQ.'2T2P')GOTO31840
      IF(ICASPL.EQ.'2TLP')GOTO31840
      IF(ICASPL.EQ.'2TUP')GOTO31840
      IF(ICASPL.EQ.'PTTE')GOTO31845
      IF(ICASPL.EQ.'PTCD')GOTO31845
      IF(ICASPL.EQ.'PT2P')GOTO31845
      IF(ICASPL.EQ.'PTLP')GOTO31845
      IF(ICASPL.EQ.'PTUP')GOTO31845
      IF(ICASPL.EQ.'CSSD')GOTO31850
      IF(ICASPL.EQ.'CCDF')GOTO31850
      IF(ICASPL.EQ.'CS2P')GOTO31850
      IF(ICASPL.EQ.'CSLP')GOTO31850
      IF(ICASPL.EQ.'CSUP')GOTO31850
      IF(ICASPL.EQ.'FRET')GOTO31870
      IF(ICASPL.EQ.'FRCD')GOTO31880
      IF(ICASPL.EQ.'FBLO')GOTO31890
      IF(ICASPL.EQ.'FBCD')GOTO31900
      IF(ICASPL.EQ.'H10L')GOTO31910
      IF(ICASPL.EQ.'H12L')GOTO31920
      IF(ICASPL.EQ.'H15L')GOTO31930
      IF(ICASPL.EQ.'H17L')GOTO31940
      IF(ICASPL.EQ.'H20L')GOTO31950
      IF(ICASPL.EQ.'H10S')GOTO31960
      IF(ICASPL.EQ.'H12S')GOTO31970
      IF(ICASPL.EQ.'H15S')GOTO31980
      IF(ICASPL.EQ.'H17S')GOTO31990
      IF(ICASPL.EQ.'H20S')GOTO32000
      IF(ICASPL.EQ.'TM2S')GOTO32010
      IF(ICASPL.EQ.'TMMN')GOTO32010
      IF(ICASPL.EQ.'TMMX')GOTO32010
      IF(ICASPL.EQ.'ESD ')GOTO32020
      IF(ICASPL.EQ.'DI2S')GOTO32030
      IF(ICASPL.EQ.'DIMN')GOTO32030
      IF(ICASPL.EQ.'DIMX')GOTO32030
      IF(ICASPL.EQ.'1LAC')GOTO32040
      IF(ICASPL.EQ.'1UAC')GOTO32040
      IF(ICASPL.EQ.'2LAC')GOTO32040
      IF(ICASPL.EQ.'2UAC')GOTO32040
      IF(ICASPL.EQ.'1LEB')GOTO32050
      IF(ICASPL.EQ.'1UEB')GOTO32050
      IF(ICASPL.EQ.'2LEB')GOTO32050
      IF(ICASPL.EQ.'2UEB')GOTO32050
      IF(ICASPL.EQ.'ADKS')GOTO32060
      IF(ICASPL.EQ.'ADKC')GOTO32060
      IF(ICASPL.EQ.'KS2S')GOTO33100
      IF(ICASPL.EQ.'KSCV')GOTO33100
      IF(ICASPL.EQ.'CS2S')GOTO33105
      IF(ICASPL.EQ.'CC2S')GOTO33105
      IF(ICASPL.EQ.'CP2S')GOTO33105
      IF(ICASPL.EQ.'WSHA')GOTO33110
      IF(ICASPL.EQ.'WSPV')GOTO33110
      IF(ICASPL.EQ.'CSFT')GOTO33120
      IF(ICASPL.EQ.'CSFP')GOTO33120
      IF(ICASPL.EQ.'CSBT')GOTO33120
      IF(ICASPL.EQ.'CSBP')GOTO33120
      IF(ICASPL.EQ.'1LNT')GOTO33130
      IF(ICASPL.EQ.'1UNT')GOTO33130
      IF(ICASPL.EQ.'1KNT')GOTO33130
      IF(ICASPL.EQ.'2LNT')GOTO33130
      IF(ICASPL.EQ.'2UNT')GOTO33130
      IF(ICASPL.EQ.'2KNT')GOTO33130
      IF(ICASPL.EQ.'FTCD')GOTO33140
      IF(ICASPL.EQ.'FTPV')GOTO33140
      IF(ICASPL.EQ.'FTES')GOTO33140
      IF(ICASPL.EQ.'1STE')GOTO33150
      IF(ICASPL.EQ.'1SCD')GOTO33150
      IF(ICASPL.EQ.'1S2P')GOTO33150
      IF(ICASPL.EQ.'1SLP')GOTO33150
      IF(ICASPL.EQ.'1SUP')GOTO33150
      IF(ICASPL.EQ.'2STE')GOTO33160
      IF(ICASPL.EQ.'2SCD')GOTO33160
      IF(ICASPL.EQ.'2S2P')GOTO33160
      IF(ICASPL.EQ.'2SLP')GOTO33160
      IF(ICASPL.EQ.'2SUP')GOTO33160
      IF(ICASPL.EQ.'2SFR')GOTO33165
      IF(ICASPL.EQ.'2F2P')GOTO33165
      IF(ICASPL.EQ.'2F1P')GOTO33165
      IF(ICASPL.EQ.'WABA')GOTO33170
      IF(ICASPL.EQ.'WBBA')GOTO33170
      IF(ICASPL.EQ.'LABA')GOTO33170
      IF(ICASPL.EQ.'LBBA')GOTO33170
      IF(ICASPL.EQ.'NABA')GOTO33170
      IF(ICASPL.EQ.'NBBA')GOTO33170
      IF(ICASPL.EQ.'ZABA')GOTO33170
      IF(ICASPL.EQ.'ZBBA')GOTO33170
      IF(ICASPL.EQ.'1WTE')GOTO34000
      IF(ICASPL.EQ.'1WCD')GOTO34000
      IF(ICASPL.EQ.'1W2P')GOTO34000
      IF(ICASPL.EQ.'1WLP')GOTO34000
      IF(ICASPL.EQ.'1WUP')GOTO34000
      IF(ICASPL.EQ.'2WTE')GOTO34010
      IF(ICASPL.EQ.'2WCD')GOTO34010
      IF(ICASPL.EQ.'2W2P')GOTO34010
      IF(ICASPL.EQ.'2WLP')GOTO34010
      IF(ICASPL.EQ.'2WUP')GOTO34010
      IF(ICASPL.EQ.'MWTE')GOTO34020
      IF(ICASPL.EQ.'MWCD')GOTO34020
      IF(ICASPL.EQ.'MW2P')GOTO34020
      IF(ICASPL.EQ.'MWLP')GOTO34020
      IF(ICASPL.EQ.'MWUP')GOTO34020
      IF(ICASPL.EQ.'MWUS')GOTO34020
      IF(ICASPL.EQ.'KLTE')GOTO34030
      IF(ICASPL.EQ.'KLCD')GOTO34030
      IF(ICASPL.EQ.'KL2P')GOTO34030
      IF(ICASPL.EQ.'KLLP')GOTO34030
      IF(ICASPL.EQ.'KLUP')GOTO34030
      IF(ICASPL.EQ.'KWTE')GOTO34035
      IF(ICASPL.EQ.'KWCD')GOTO34035
      IF(ICASPL.EQ.'KW2P')GOTO34035
      IF(ICASPL.EQ.'SRTE')GOTO34040
      IF(ICASPL.EQ.'SRCD')GOTO34040
      IF(ICASPL.EQ.'SR2P')GOTO34040
      IF(ICASPL.EQ.'SRLP')GOTO34040
      IF(ICASPL.EQ.'SRUP')GOTO34040
      IF(ICASPL.EQ.'METE')GOTO34050
      IF(ICASPL.EQ.'MECD')GOTO34050
      IF(ICASPL.EQ.'ME2P')GOTO34050
      IF(ICASPL.EQ.'FZTE')GOTO34060
      IF(ICASPL.EQ.'FZCD')GOTO34060
      IF(ICASPL.EQ.'FZ2P')GOTO34060
      IF(ICASPL.EQ.'QUTE')GOTO34070
      IF(ICASPL.EQ.'QUCD')GOTO34070
      IF(ICASPL.EQ.'QU2P')GOTO34070
      IF(ICASPL.EQ.'FMAT')GOTO34080
      IF(ICASPL.EQ.'LMAT')GOTO34080
      IF(ICASPL.EQ.'FNOM')GOTO34080
      IF(ICASPL.EQ.'LNOM')GOTO34080
      IF(ICASPL.EQ.'SHDI')GOTO34090
      IF(ICASPL.EQ.'SHEI')GOTO34090
      IF(ICASPL.EQ.'SINR')GOTO34095
      IF(ICASPL.EQ.'SEIR')GOTO34095
      IF(ICASPL.EQ.'SIDI')GOTO34100
      IF(ICASPL.EQ.'SDIR')GOTO34105
      IF(ICASPL.EQ.'JABE')GOTO34110
      IF(ICASPL.EQ.'JAPV')GOTO34110
      IF(ICASPL.EQ.'JACD')GOTO34110
      IF(ICASPL.EQ.'LCL ')GOTO34120
      IF(ICASPL.EQ.'UCL ')GOTO34120
      IF(ICASPL.EQ.'1LCL')GOTO34120
      IF(ICASPL.EQ.'1UCL')GOTO34120
      IF(ICASPL.EQ.'SLCL')GOTO34120
      IF(ICASPL.EQ.'SUCL')GOTO34120
      IF(ICASPL.EQ.'SLC1')GOTO34120
      IF(ICASPL.EQ.'SUC1')GOTO34120
      IF(ICASPL.EQ.'LPL ')GOTO34130
      IF(ICASPL.EQ.'UPL ')GOTO34130
      IF(ICASPL.EQ.'1LPL')GOTO34130
      IF(ICASPL.EQ.'1UPL')GOTO34130
      IF(ICASPL.EQ.'LPB ')GOTO34130
      IF(ICASPL.EQ.'UPB ')GOTO34130
      IF(ICASPL.EQ.'1LPB')GOTO34130
      IF(ICASPL.EQ.'1UPB')GOTO34130
      IF(ICASPL.EQ.'SLPL')GOTO34130
      IF(ICASPL.EQ.'SUPL')GOTO34130
      IF(ICASPL.EQ.'SLP1')GOTO34130
      IF(ICASPL.EQ.'SUP1')GOTO34130
      IF(ICASPL.EQ.'SLPB')GOTO34130
      IF(ICASPL.EQ.'SUPB')GOTO34130
      IF(ICASPL.EQ.'SLB1')GOTO34130
      IF(ICASPL.EQ.'SUB1')GOTO34130
      IF(ICASPL.EQ.'SUS1')GOTO34130
      IF(ICASPL.EQ.'SLS1')GOTO34130
      IF(ICASPL.EQ.'SUS2')GOTO34130
      IF(ICASPL.EQ.'SLS2')GOTO34130
      IF(ICASPL.EQ.'UPS1')GOTO34130
      IF(ICASPL.EQ.'LPS1')GOTO34130
      IF(ICASPL.EQ.'UPS2')GOTO34130
      IF(ICASPL.EQ.'LPS2')GOTO34130
      IF(ICASPL.EQ.'UCS1')GOTO34140
      IF(ICASPL.EQ.'LCS1')GOTO34140
      IF(ICASPL.EQ.'UCS2')GOTO34140
      IF(ICASPL.EQ.'LCS2')GOTO34140
      IF(ICASPL.EQ.'SLZ1')GOTO34140
      IF(ICASPL.EQ.'SUZ1')GOTO34140
      IF(ICASPL.EQ.'SLZ2')GOTO34140
      IF(ICASPL.EQ.'SUZ2')GOTO34140
      IF(ICASPL.EQ.'BLSD')GOTO34145
      IF(ICASPL.EQ.'BUSD')GOTO34145
      IF(ICASPL.EQ.'MWLT')GOTO34150
      IF(ICASPL.EQ.'MWLC')GOTO34150
      IF(ICASPL.EQ.'MWPV')GOTO34150
      IF(ICASPL.EQ.'MW50')GOTO34150
      IF(ICASPL.EQ.'MW90')GOTO34150
      IF(ICASPL.EQ.'MW95')GOTO34150
      IF(ICASPL.EQ.'PDTE')GOTO34160
      IF(ICASPL.EQ.'PDCD')GOTO34160
      IF(ICASPL.EQ.'PDPV')GOTO34160
      IF(ICASPL.EQ.'GPDT')GOTO34170
      IF(ICASPL.EQ.'GPDC')GOTO34170
      IF(ICASPL.EQ.'GPDP')GOTO34170
      IF(ICASPL.EQ.'BCVM')GOTO34180
      IF(ICASPL.EQ.'BC95')GOTO34180
      IF(ICASPL.EQ.'BC05')GOTO34180
      IF(ICASPL.EQ.'MNNC')GOTO34190
      IF(ICASPL.EQ.'MNND')GOTO34190
      IF(ICASPL.EQ.'MNNP')GOTO34190
      IF(ICASPL.EQ.'PO1P')GOTO34200
      IF(ICASPL.EQ.'PO1C')GOTO34200
      IF(ICASPL.EQ.'POL1')GOTO34200
      IF(ICASPL.EQ.'PO2P')GOTO34200
      IF(ICASPL.EQ.'PO2C')GOTO34200
      IF(ICASPL.EQ.'POL2')GOTO34200
      IF(ICASPL.EQ.'PO3P')GOTO34200
      IF(ICASPL.EQ.'PO3C')GOTO34200
      IF(ICASPL.EQ.'POL3')GOTO34200
      IF(ICASPL.EQ.'PO4P')GOTO34200
      IF(ICASPL.EQ.'PO4C')GOTO34200
      IF(ICASPL.EQ.'POL4')GOTO34200
      IF(ICASPL.EQ.'PO5P')GOTO34200
      IF(ICASPL.EQ.'PO5C')GOTO34200
      IF(ICASPL.EQ.'POL5')GOTO34200
      IF(ICASPL.EQ.'VALC')GOTO34210
      IF(ICASPL.EQ.'VDIS')GOTO34220
      IF(ICASPL.EQ.'RDI ')GOTO34220
      IF(ICASPL.EQ.'UCHS')GOTO34220
      IF(ICASPL.EQ.'WSCD')GOTO34230
      IF(ICASPL.EQ.'WSHP')GOTO34230
      IF(ICASPL.EQ.'WSHT')GOTO34230
      IF(ICASPL.EQ.'WS90')GOTO34230
      IF(ICASPL.EQ.'WS95')GOTO34230
      IF(ICASPL.EQ.'WS99')GOTO34230
      IF(ICASPL.EQ.'KAPR')GOTO34240
      IF(ICASPL.EQ.'KARC')GOTO34240
      IF(ICASPL.EQ.'CVOT')GOTO34260
      IF(ICASPL.EQ.'CV95')GOTO34260
      IF(ICASPL.EQ.'CV99')GOTO34260
      IF(ICASPL.EQ.'CVCD')GOTO34260
      IF(ICASPL.EQ.'CVPV')GOTO34260
      IF(ICASPL.EQ.'CV05')GOTO34260
      IF(ICASPL.EQ.'CV01')GOTO34260
      IF(ICASPL.EQ.'CMVC')GOTO34260
      IF(ICASPL.EQ.'CMVP')GOTO34260
      IF(ICASPL.EQ.'CVMO')GOTO34260
      IF(ICASPL.EQ.'ESCD')GOTO34270
      IF(ICASPL.EQ.'ESCV')GOTO34270
      IF(ICASPL.EQ.'ESPV')GOTO34270
      IF(ICASPL.EQ.'ESP1')GOTO34270
      IF(ICASPL.EQ.'ESLO')GOTO34270
      IF(ICASPL.EQ.'DSLA' .AND. NUMV2.EQ.3)GOTO32100
      IF(ICASPL.EQ.'DHHD' .AND. NUMV2.EQ.3)GOTO32100
      IF(ICASPL.EQ.'DSMM' .AND. NUMV2.EQ.3)GOTO32100
      IF(ICASPL.EQ.'DSSE' .AND. NUMV2.EQ.3)GOTO32100
      IF(ICASPL.EQ.'MPAU' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'MPSE' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'MMPA' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'MMPS' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'VARU' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'VRSE' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'BOB ' .AND. NUMV2.EQ.3)GOTO32300
      IF(ICASPL.EQ.'BOBS' .AND. NUMV2.EQ.3)GOTO32300
      IF(ICASPL.EQ.'GCIN' .AND. NUMV2.EQ.3)GOTO32400
      IF(ICASPL.EQ.'GCIS' .AND. NUMV2.EQ.3)GOTO32400
      IF(ICASPL.EQ.'BCP ' .AND. NUMV2.EQ.3)GOTO32500
      IF(ICASPL.EQ.'BCPS' .AND. NUMV2.EQ.3)GOTO32500
      IF(ICASPL.EQ.'MMEA' .AND. NUMV2.EQ.3)GOTO32600
      IF(ICASPL.EQ.'MMES' .AND. NUMV2.EQ.3)GOTO32600
      IF(ICASPL.EQ.'FAIR' .AND. NUMV2.EQ.3)GOTO32700
      IF(ICASPL.EQ.'FWSE' .AND. NUMV2.EQ.3)GOTO32700
      IF(ICASPL.EQ.'GDEA' .AND. NUMV2.EQ.3)GOTO32800
      IF(ICASPL.EQ.'GDSE' .AND. NUMV2.EQ.3)GOTO32800
      IF(ICASPL.EQ.'GDSN' .AND. NUMV2.EQ.3)GOTO32800
      IF(ICASPL.EQ.'GDZ1' .AND. NUMV2.EQ.3)GOTO32800
      IF(ICASPL.EQ.'GDZ2' .AND. NUMV2.EQ.3)GOTO32800
      IF(ICASPL.EQ.'SCEB' .AND. NUMV2.EQ.3)GOTO32900
      IF(ICASPL.EQ.'SESE' .AND. NUMV2.EQ.3)GOTO32900
      IF(ICASPL.EQ.'DSLA' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'DHHD' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'DSMM' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'DSSE' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MPAU' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MPSE' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MMPA' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MMPS' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'VARU' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'VRSE' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'BOB ' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'BOBS' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GCIN' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GCIS' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'BCP ' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'BCPS' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MMEA' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MMES' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'FAIR' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'FWSE' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GDEA' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GDSE' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GDSN' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GDZ1' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GDZ2' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'SCEB' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'SESE' .AND. NUMV2.EQ.2)GOTO32070
C
      IF(ICASPL.EQ.'DMEA')GOTO12180
      IF(ICASPL.EQ.'HEDG')GOTO12182
      IF(ICASPL.EQ.'BCHG')GOTO12182
      IF(ICASPL.EQ.'HESE')GOTO12182
      IF(ICASPL.EQ.'HELC')GOTO12182
      IF(ICASPL.EQ.'HEUC')GOTO12182
      IF(ICASPL.EQ.'COHD')GOTO12182
      IF(ICASPL.EQ.'GLAS')GOTO12182
      IF(ICASPL.EQ.'DMDM')GOTO12190
      IF(ICASPL.EQ.'DMED')GOTO12200
      IF(ICASPL.EQ.'DGEO')GOTO12230
      IF(ICASPL.EQ.'DHAR')GOTO12240
      IF(ICASPL.EQ.'DHDL')GOTO12250
      IF(ICASPL.EQ.'DBIW')GOTO12260
      IF(ICASPL.EQ.'DSD ')GOTO12270
      IF(ICASPL.EQ.'DRMS ')GOTO12275
      IF(ICASPL.EQ.'DVAR')GOTO12280
      IF(ICASPL.EQ.'DPRE')GOTO12282
      IF(ICASPL.EQ.'DSNR')GOTO12284
      IF(ICASPL.EQ.'DAAD')GOTO12290
      IF(ICASPL.EQ.'DAAM')GOTO12295
      IF(ICASPL.EQ.'DMAD')GOTO12300
      IF(ICASPL.EQ.'DMAN')GOTO12300
      IF(ICASPL.EQ.'DIQR')GOTO12310
      IF(ICASPL.EQ.'DNIQ')GOTO12310
      IF(ICASPL.EQ.'DBIM')GOTO12340
      IF(ICASPL.EQ.'DBIS')GOTO12350
      IF(ICASPL.EQ.'DGSD')GOTO12370
      IF(ICASPL.EQ.'DRAN')GOTO12380
C
      IF(ICASPL.EQ.'EXTR')GOTO11933
      IF(ICASPL.EQ.'AAD ')GOTO11935
      IF(ICASPL.EQ.'MAD ')GOTO11940
      IF(ICASPL.EQ.'MADN')GOTO11940
      IF(ICASPL.EQ.'GEME')GOTO11950
      IF(ICASPL.EQ.'GESD')GOTO11960
      IF(ICASPL.EQ.'HAME')GOTO11970
      IF(ICASPL.EQ.'IQRA')GOTO11980
      IF(ICASPL.EQ.'NIQR')GOTO11980
      IF(ICASPL.EQ.'SIQL')GOTO11980
      IF(ICASPL.EQ.'SIQU')GOTO11980
      IF(ICASPL.EQ.'QCDI')GOTO11981
      IF(ICASPL.EQ.'QQRA')GOTO11982
      IF(ICASPL.EQ.'DQDI')GOTO11983
      IF(ICASPL.EQ.'BILO')GOTO11990
      IF(ICASPL.EQ.'BISC')GOTO12000
      IF(ICASPL.EQ.'BIMV')GOTO12090
      IF(ICASPL.EQ.'BIMC')GOTO12100
C
      IF(ICASPL.EQ.'PBMV' .OR. ICASPL.EQ.'PBCR' .OR.
     1   ICASPL.EQ.'DPBN')THEN
C
        IHP='BETA'
        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)
        IF(IERROR.EQ.'YES')THEN
          BETA=0.1
        ELSE
          BETA=VALUE(ILOCP)
        ENDIF
C
        IF(ICASPL.EQ.'PBMV')GOTO12110
        IF(ICASPL.EQ.'PBCR')GOTO12115
        IF(ICASPL.EQ.'DPBN')GOTO12360
      ENDIF
C
      IF(ICASPL.EQ.'HLEH')GOTO12120
      IF(ICASPL.EQ.'QUAN')GOTO12130
      IF(ICASPL.EQ.'QUSE')GOTO12140
      IF(ICASPL.EQ.'BICR')GOTO12160
      IF(ICASPL.EQ.'CDIG')GOTO12172
      IF(ICASPL.EQ.'NCDI')GOTO12174
      IF(ICASPL.EQ.'SNSC')GOTO12176
      IF(ICASPL.EQ.'QNSC')GOTO12178
C
      IF(ICASPL.EQ.'LPME' .OR. ICASPL.EQ.'LPVA' .OR.
     1   ICASPL.EQ.'LPSD' .OR. ICASPL.EQ.'DLPL' .OR.
     1   ICASPL.EQ.'DLPV' .OR. ICASPL.EQ.'DLPS')THEN
C
        IHP='P   '
        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)
        IF(IERROR.EQ.'YES')THEN
          P=1.5
        ELSE
          P=VALUE(ILOCP)
        ENDIF
C
        IF(ICASPL.EQ.'LPME')GOTO31720
        IF(ICASPL.EQ.'LPVA')GOTO31730
        IF(ICASPL.EQ.'LPSD')GOTO31740
        IF(ICASPL.EQ.'DLPL')GOTO12540
        IF(ICASPL.EQ.'DLPV')GOTO12550
        IF(ICASPL.EQ.'DLPS')GOTO12560
      ENDIF
C
      IF(ICASPL.EQ.'BPRO')GOTO31750
      IF(ICASPL.EQ.'BPLC')GOTO31750
      IF(ICASPL.EQ.'BPUC')GOTO31750
      IF(ICASPL.EQ.'BPRC')GOTO31750
      IF(ICASPL.EQ.'GRUB')GOTO31790
      IF(ICASPL.EQ.'GCDF')GOTO31795
      IF(ICASPL.EQ.'GDIR')GOTO31810
      IF(ICASPL.EQ.'GIND')GOTO31820
      IF(ICASPL.EQ.'1TTE')GOTO31830
      IF(ICASPL.EQ.'1TCD')GOTO31830
      IF(ICASPL.EQ.'1T2P')GOTO31830
      IF(ICASPL.EQ.'1TLP')GOTO31830
      IF(ICASPL.EQ.'1TUP')GOTO31830
      IF(ICASPL.EQ.'2TTE')GOTO31840
      IF(ICASPL.EQ.'2TCD')GOTO31840
      IF(ICASPL.EQ.'2T2P')GOTO31840
      IF(ICASPL.EQ.'2TLP')GOTO31840
      IF(ICASPL.EQ.'2TUP')GOTO31840
      IF(ICASPL.EQ.'PTTE')GOTO31845
      IF(ICASPL.EQ.'PTCD')GOTO31845
      IF(ICASPL.EQ.'PT2P')GOTO31845
      IF(ICASPL.EQ.'PTLP')GOTO31845
      IF(ICASPL.EQ.'PTUP')GOTO31845
      IF(ICASPL.EQ.'CSSD')GOTO31850
      IF(ICASPL.EQ.'CCDF')GOTO31850
      IF(ICASPL.EQ.'CS2P')GOTO31850
      IF(ICASPL.EQ.'CSLP')GOTO31850
      IF(ICASPL.EQ.'CSUP')GOTO31850
      IF(ICASPL.EQ.'FRET')GOTO31870
      IF(ICASPL.EQ.'FRCD')GOTO31880
      IF(ICASPL.EQ.'FBLO')GOTO31890
      IF(ICASPL.EQ.'FBCD')GOTO31900
      IF(ICASPL.EQ.'MSDT')GOTO31905
      IF(ICASPL.EQ.'MSDN')GOTO31905
      IF(ICASPL.EQ.'MSDC')GOTO31905
      IF(ICASPL.EQ.'MSDP')GOTO31905
      IF(ICASPL.EQ.'ADRA')GOTO31905
      IF(ICASPL.EQ.'ADCD')GOTO31905
      IF(ICASPL.EQ.'ADPV')GOTO31905
      IF(ICASPL.EQ.'AD01')GOTO31905
      IF(ICASPL.EQ.'AD05')GOTO31905
      IF(ICASPL.EQ.'AD95')GOTO31905
      IF(ICASPL.EQ.'AD99')GOTO31905
      IF(ICASPL.EQ.'H10L')GOTO31910
      IF(ICASPL.EQ.'H12L')GOTO31920
      IF(ICASPL.EQ.'H15L')GOTO31930
      IF(ICASPL.EQ.'H17L')GOTO31940
      IF(ICASPL.EQ.'H20L')GOTO31950
      IF(ICASPL.EQ.'H10S')GOTO31960
      IF(ICASPL.EQ.'H12S')GOTO31970
      IF(ICASPL.EQ.'H15S')GOTO31980
      IF(ICASPL.EQ.'H17S')GOTO31990
      IF(ICASPL.EQ.'H20S')GOTO32000
      IF(ICASPL.EQ.'TM2S')GOTO32010
      IF(ICASPL.EQ.'TMMN')GOTO32010
      IF(ICASPL.EQ.'TMMX')GOTO32010
      IF(ICASPL.EQ.'ESD ')GOTO32020
      IF(ICASPL.EQ.'DI2S')GOTO32030
      IF(ICASPL.EQ.'DIMN')GOTO32030
      IF(ICASPL.EQ.'DIMX')GOTO32030
      IF(ICASPL.EQ.'1LAC')GOTO32040
      IF(ICASPL.EQ.'1UAC')GOTO32040
      IF(ICASPL.EQ.'2LAC')GOTO32040
      IF(ICASPL.EQ.'2UAC')GOTO32040
      IF(ICASPL.EQ.'1LEB')GOTO32050
      IF(ICASPL.EQ.'1UEB')GOTO32050
      IF(ICASPL.EQ.'2LEB')GOTO32050
      IF(ICASPL.EQ.'2UEB')GOTO32050
      IF(ICASPL.EQ.'ADKS')GOTO32060
      IF(ICASPL.EQ.'ADKC')GOTO32060
      IF(ICASPL.EQ.'KS2S')GOTO33100
      IF(ICASPL.EQ.'KSCV')GOTO33100
      IF(ICASPL.EQ.'CS2S')GOTO33105
      IF(ICASPL.EQ.'CC2S')GOTO33105
      IF(ICASPL.EQ.'CP2S')GOTO33105
      IF(ICASPL.EQ.'WSHA')GOTO33110
      IF(ICASPL.EQ.'WSPV')GOTO33110
      IF(ICASPL.EQ.'CSFT')GOTO33120
      IF(ICASPL.EQ.'CSFP')GOTO33120
      IF(ICASPL.EQ.'CSBT')GOTO33120
      IF(ICASPL.EQ.'CSBP')GOTO33120
      IF(ICASPL.EQ.'1LNT')GOTO33130
      IF(ICASPL.EQ.'1UNT')GOTO33130
      IF(ICASPL.EQ.'1KNT')GOTO33130
      IF(ICASPL.EQ.'2LNT')GOTO33130
      IF(ICASPL.EQ.'2UNT')GOTO33130
      IF(ICASPL.EQ.'2KNT')GOTO33130
      IF(ICASPL.EQ.'FTCD')GOTO33140
      IF(ICASPL.EQ.'FTPV')GOTO33140
      IF(ICASPL.EQ.'FTES')GOTO33140
      IF(ICASPL.EQ.'1STE')GOTO33150
      IF(ICASPL.EQ.'1SCD')GOTO33150
      IF(ICASPL.EQ.'1S2P')GOTO33150
      IF(ICASPL.EQ.'1SLP')GOTO33150
      IF(ICASPL.EQ.'1SUP')GOTO33150
      IF(ICASPL.EQ.'2STE')GOTO33160
      IF(ICASPL.EQ.'2SCD')GOTO33160
      IF(ICASPL.EQ.'2S2P')GOTO33160
      IF(ICASPL.EQ.'2SLP')GOTO33160
      IF(ICASPL.EQ.'2SUP')GOTO33160
      IF(ICASPL.EQ.'2SFR')GOTO33165
      IF(ICASPL.EQ.'2F2P')GOTO33165
      IF(ICASPL.EQ.'2F1P')GOTO33165
      IF(ICASPL.EQ.'WABA')GOTO33170
      IF(ICASPL.EQ.'WBBA')GOTO33170
      IF(ICASPL.EQ.'LABA')GOTO33170
      IF(ICASPL.EQ.'LBBA')GOTO33170
      IF(ICASPL.EQ.'NABA')GOTO33170
      IF(ICASPL.EQ.'NBBA')GOTO33170
      IF(ICASPL.EQ.'ZABA')GOTO33170
      IF(ICASPL.EQ.'ZBBA')GOTO33170
      IF(ICASPL.EQ.'1WTE')GOTO34000
      IF(ICASPL.EQ.'1WCD')GOTO34000
      IF(ICASPL.EQ.'1W2P')GOTO34000
      IF(ICASPL.EQ.'1WLP')GOTO34000
      IF(ICASPL.EQ.'1WUP')GOTO34000
      IF(ICASPL.EQ.'2WTE')GOTO34010
      IF(ICASPL.EQ.'2WCD')GOTO34010
      IF(ICASPL.EQ.'2W2P')GOTO34010
      IF(ICASPL.EQ.'2WLP')GOTO34010
      IF(ICASPL.EQ.'2WUP')GOTO34010
      IF(ICASPL.EQ.'MWTE')GOTO34020
      IF(ICASPL.EQ.'MWCD')GOTO34020
      IF(ICASPL.EQ.'MW2P')GOTO34020
      IF(ICASPL.EQ.'MWLP')GOTO34020
      IF(ICASPL.EQ.'MWUP')GOTO34020
      IF(ICASPL.EQ.'MWUS')GOTO34020
      IF(ICASPL.EQ.'KLTE')GOTO34030
      IF(ICASPL.EQ.'KLCD')GOTO34030
      IF(ICASPL.EQ.'KL2P')GOTO34030
      IF(ICASPL.EQ.'KLLP')GOTO34030
      IF(ICASPL.EQ.'KLUP')GOTO34030
      IF(ICASPL.EQ.'KWTE')GOTO34035
      IF(ICASPL.EQ.'KWCD')GOTO34035
      IF(ICASPL.EQ.'KW2P')GOTO34035
      IF(ICASPL.EQ.'SRTE')GOTO34040
      IF(ICASPL.EQ.'SRCD')GOTO34040
      IF(ICASPL.EQ.'SR2P')GOTO34040
      IF(ICASPL.EQ.'SRLP')GOTO34040
      IF(ICASPL.EQ.'SRUP')GOTO34040
      IF(ICASPL.EQ.'METE')GOTO34050
      IF(ICASPL.EQ.'MECD')GOTO34050
      IF(ICASPL.EQ.'ME2P')GOTO34050
      IF(ICASPL.EQ.'FZTE')GOTO34060
      IF(ICASPL.EQ.'FZCD')GOTO34060
      IF(ICASPL.EQ.'FZ2P')GOTO34060
      IF(ICASPL.EQ.'QUTE')GOTO34070
      IF(ICASPL.EQ.'QUCD')GOTO34070
      IF(ICASPL.EQ.'QU2P')GOTO34070
      IF(ICASPL.EQ.'PATE')GOTO34075
      IF(ICASPL.EQ.'PAT2')GOTO34075
      IF(ICASPL.EQ.'PACD')GOTO34075
      IF(ICASPL.EQ.'PAPV')GOTO34075
      IF(ICASPL.EQ.'FMAT')GOTO34080
      IF(ICASPL.EQ.'LMAT')GOTO34080
      IF(ICASPL.EQ.'FNOM')GOTO34080
      IF(ICASPL.EQ.'LNOM')GOTO34080
      IF(ICASPL.EQ.'SHDI')GOTO34090
      IF(ICASPL.EQ.'SHEI')GOTO34090
      IF(ICASPL.EQ.'SINR')GOTO34095
      IF(ICASPL.EQ.'SEIR')GOTO34095
      IF(ICASPL.EQ.'SIDI')GOTO34100
      IF(ICASPL.EQ.'SDIR')GOTO34105
      IF(ICASPL.EQ.'JABE')GOTO34110
      IF(ICASPL.EQ.'JAPV')GOTO34110
      IF(ICASPL.EQ.'JACD')GOTO34110
      IF(ICASPL.EQ.'LCL ')GOTO34120
      IF(ICASPL.EQ.'UCL ')GOTO34120
      IF(ICASPL.EQ.'1LCL')GOTO34120
      IF(ICASPL.EQ.'1UCL')GOTO34120
      IF(ICASPL.EQ.'LPL ')GOTO34130
      IF(ICASPL.EQ.'UPL ')GOTO34130
      IF(ICASPL.EQ.'1LPL')GOTO34130
      IF(ICASPL.EQ.'1UPL')GOTO34130
      IF(ICASPL.EQ.'LPB ')GOTO34130
      IF(ICASPL.EQ.'UPB ')GOTO34130
      IF(ICASPL.EQ.'1LPB')GOTO34130
      IF(ICASPL.EQ.'1UPB')GOTO34130
      IF(ICASPL.EQ.'DSLA' .AND. NUMV2.EQ.3)GOTO32100
      IF(ICASPL.EQ.'DHHD' .AND. NUMV2.EQ.3)GOTO32100
      IF(ICASPL.EQ.'DSMM' .AND. NUMV2.EQ.3)GOTO32100
      IF(ICASPL.EQ.'DSSE' .AND. NUMV2.EQ.3)GOTO32100
      IF(ICASPL.EQ.'MPAU' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'MPSE' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'MMPA' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'MMPS' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'VARU' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'VRSE' .AND. NUMV2.EQ.3)GOTO32200
      IF(ICASPL.EQ.'BOB ' .AND. NUMV2.EQ.3)GOTO32300
      IF(ICASPL.EQ.'BOBS' .AND. NUMV2.EQ.3)GOTO32300
      IF(ICASPL.EQ.'GCIN' .AND. NUMV2.EQ.3)GOTO32400
      IF(ICASPL.EQ.'GCIS' .AND. NUMV2.EQ.3)GOTO32400
      IF(ICASPL.EQ.'BCP ' .AND. NUMV2.EQ.3)GOTO32500
      IF(ICASPL.EQ.'BCPS' .AND. NUMV2.EQ.3)GOTO32500
      IF(ICASPL.EQ.'MMEA' .AND. NUMV2.EQ.3)GOTO32600
      IF(ICASPL.EQ.'MMES' .AND. NUMV2.EQ.3)GOTO32600
      IF(ICASPL.EQ.'FAIR' .AND. NUMV2.EQ.3)GOTO32700
      IF(ICASPL.EQ.'FWSE' .AND. NUMV2.EQ.3)GOTO32700
      IF(ICASPL.EQ.'GDEA' .AND. NUMV2.EQ.3)GOTO32800
      IF(ICASPL.EQ.'GDSE' .AND. NUMV2.EQ.3)GOTO32800
      IF(ICASPL.EQ.'GDSN' .AND. NUMV2.EQ.3)GOTO32800
      IF(ICASPL.EQ.'GDZ1' .AND. NUMV2.EQ.3)GOTO32800
      IF(ICASPL.EQ.'GDZ2' .AND. NUMV2.EQ.3)GOTO32800
      IF(ICASPL.EQ.'SCEB' .AND. NUMV2.EQ.3)GOTO32900
      IF(ICASPL.EQ.'SESE' .AND. NUMV2.EQ.3)GOTO32900
      IF(ICASPL.EQ.'DSLA' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'DHHD' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'DSMM' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'DSSE' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MPAU' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MPSE' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MMPA' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MMPS' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'VARU' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'VRSE' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'BOB ' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'BOBS' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GCIN' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GCIS' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'BCP ' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'BCPS' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MMEA' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'MMES' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'FAIR' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'FWSE' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GDEA' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GDSE' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GDSN' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GDZ1' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'GDZ2' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'SCEB' .AND. NUMV2.EQ.2)GOTO32070
      IF(ICASPL.EQ.'SESE' .AND. NUMV2.EQ.2)GOTO32070
C
      IF(ICASPL.EQ.'DMEA')GOTO12180
      IF(ICASPL.EQ.'DMDM')GOTO12190
      IF(ICASPL.EQ.'DMED')GOTO12200
      IF(ICASPL.EQ.'DGEO')GOTO12230
      IF(ICASPL.EQ.'DHAR')GOTO12240
      IF(ICASPL.EQ.'DHDL')GOTO12250
      IF(ICASPL.EQ.'DBIW')GOTO12260
      IF(ICASPL.EQ.'DSD ')GOTO12270
      IF(ICASPL.EQ.'DRMS ')GOTO12275
      IF(ICASPL.EQ.'DVAR')GOTO12280
      IF(ICASPL.EQ.'DAAD')GOTO12290
      IF(ICASPL.EQ.'DMAD')GOTO12300
      IF(ICASPL.EQ.'DMAN')GOTO12300
      IF(ICASPL.EQ.'DIQR')GOTO12310
      IF(ICASPL.EQ.'DBIM')GOTO12340
      IF(ICASPL.EQ.'DBIS')GOTO12350
      IF(ICASPL.EQ.'DGSD')GOTO12370
      IF(ICASPL.EQ.'DRAN')GOTO12380
      IF(ICASPL.EQ.'DMDR')GOTO12390
      IF(ICASPL.EQ.'DQSE')GOTO12400
      IF(ICASPL.EQ.'DQUA')GOTO12405
      IF(ICASPL.EQ.'DSKE')GOTO12410
      IF(ICASPL.EQ.'DGSK')GOTO12412
      IF(ICASPL.EQ.'DPSK')GOTO12414
      IF(ICASPL.EQ.'DKUR')GOTO12420
      IF(ICASPL.EQ.'DEKU')GOTO12425
      IF(ICASPL.EQ.'DRSD')GOTO12430
      IF(ICASPL.EQ.'DSDM')GOTO12440
      IF(ICASPL.EQ.'DRVA')GOTO12450
      IF(ICASPL.EQ.'DVAM')GOTO12460
      IF(ICASPL.EQ.'DMIN')GOTO12470
      IF(ICASPL.EQ.'DMAX')GOTO12480
      IF(ICASPL.EQ.'DEXT')GOTO12490
      IF(ICASPL.EQ.'DCVA')GOTO12495
      IF(ICASPL.EQ.'DCOU')GOTO12500
      IF(ICASPL.EQ.'DSUM')GOTO12510
      IF(ICASPL.EQ.'DPRO')GOTO12512
      IF(ICASPL.EQ.'DSN')GOTO12520
      IF(ICASPL.EQ.'DQN')GOTO12530
      IF(ICASPL.EQ.'DBPR')GOTO12570
      IF(ICASPL.EQ.'DBLC')GOTO12570
      IF(ICASPL.EQ.'DBUC')GOTO12570
      IF(ICASPL.EQ.'DPER')GOTO12600
      IF(ICASPL.EQ.'D1DE')GOTO12600
      IF(ICASPL.EQ.'D2DE')GOTO12600
      IF(ICASPL.EQ.'D3DE')GOTO12600
      IF(ICASPL.EQ.'D4DE')GOTO12600
      IF(ICASPL.EQ.'D5DE')GOTO12600
      IF(ICASPL.EQ.'D6DE')GOTO12600
      IF(ICASPL.EQ.'D7DE')GOTO12600
      IF(ICASPL.EQ.'D8DE')GOTO12600
      IF(ICASPL.EQ.'D9DE')GOTO12600
      IF(ICASPL.EQ.'DLHI')GOTO12610
      IF(ICASPL.EQ.'DUHI')GOTO12620
      IF(ICASPL.EQ.'DLQU')GOTO12630
      IF(ICASPL.EQ.'DUQU')GOTO12640
      IF(ICASPL.EQ.'10LD')GOTO12650
      IF(ICASPL.EQ.'12LD')GOTO12660
      IF(ICASPL.EQ.'15LD')GOTO12670
      IF(ICASPL.EQ.'17LD')GOTO12680
      IF(ICASPL.EQ.'20LD')GOTO12690
      IF(ICASPL.EQ.'10SD')GOTO12700
      IF(ICASPL.EQ.'12SD')GOTO12710
      IF(ICASPL.EQ.'15SD')GOTO12720
      IF(ICASPL.EQ.'17SD')GOTO12730
      IF(ICASPL.EQ.'20SD')GOTO12740
      IF(ICASPL.EQ.'RPSD')GOTO12750
      IF(ICASPL.EQ.'RPRA')GOTO12760
C
      IF(ICASPL.EQ.'CVLC')GOTO3185
      IF(ICASPL.EQ.'CVUC')GOTO3185
      IF(ICASPL.EQ.'CVLO')GOTO3185
      IF(ICASPL.EQ.'CVUO')GOTO3185
      IF(ICASPL.EQ.'SCVL')GOTO3185
      IF(ICASPL.EQ.'SCVU')GOTO3185
      IF(ICASPL.EQ.'SCVA')GOTO3185
      IF(ICASPL.EQ.'LCVA')GOTO3185
      IF(ICASPL.EQ.'LLCV')GOTO3185
      IF(ICASPL.EQ.'ULCV')GOTO3185
C
      IF(ICASPL.EQ.'CCVA')GOTO3195
      IF(ICASPL.EQ.'UCCV')GOTO3195
      IF(ICASPL.EQ.'LCCV')GOTO3195
      IF(ICASPL.EQ.'UCC2')GOTO3195
C
      IF(ICASPL.EQ.'1CTE')GOTO34280
      IF(ICASPL.EQ.'1CCD')GOTO34280
      IF(ICASPL.EQ.'1C2P')GOTO34280
      IF(ICASPL.EQ.'1CLP')GOTO34280
      IF(ICASPL.EQ.'1CUP')GOTO34280
      IF(ICASPL.EQ.'S1CT')GOTO34290
      IF(ICASPL.EQ.'S1CC')GOTO34290
      IF(ICASPL.EQ.'S1CP')GOTO34290
      IF(ICASPL.EQ.'2CTE')GOTO34300
      IF(ICASPL.EQ.'2CCD')GOTO34300
      IF(ICASPL.EQ.'2C2P')GOTO34300
      IF(ICASPL.EQ.'2CLP')GOTO34300
      IF(ICASPL.EQ.'2CUP')GOTO34300
      IF(ICASPL.EQ.'PMEA')THEN
        ICASE='MEAN'
        CALL DPEXPY(ICASE,TEMP,TEMPZ,TEMPZ3,NS2,NSZ,NSZ3,
     1              XTEMP1,XTEMP2,XTEMP3,AVAL1,AVAL2,AVAL3,
     1              IBUGG3,ISUBRO,IFOUND,IERROR)
        GOTO79000
      ENDIF
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80001)
80001 FORMAT('***** INTERNAL ERROR IN CMPSTA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80002)
80002 FORMAT('      AT BRANCH POINT 11800--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80003)
80003 FORMAT('      ICASPL NOT EQUAL ONE OF THE ALLOWABLE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80004)
80004 FORMAT('      MEAN, MEDI, SD, RANG, ETC.,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80006)ICASPL
80006 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C     ---------------------------
C
11310 CONTINUE
      CALL SIZE(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11312 CONTINUE
      IHP='LOWL'
      IHP2='IMIT'
      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
        ALOWLM=CPUMIN
      ELSE
        ALOWLM=VALUE(ILOCP)
      ENDIF
      IHP='UPPL'
      IHP2='IMIT'
      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
        AUPPLM=CPUMAX
      ELSE
        AUPPLM=VALUE(ILOCP)
      ENDIF
      CALL INTCNT(TEMP,NS2,ALOWLM,AUPPLM,IWRITE,RIGHT,
     1            ISUBRO,IBUGG3,IERROR)
      GOTO79000
11315 CONTINUE
      CALL DISTIN(TEMP,NS2,IWRITE,XTEMP1,NOUT,IBUGG3,IERROR)
      RIGHT=REAL(NOUT)
      GOTO79000
11320 CONTINUE
      CALL SUMDP(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11330 CONTINUE
      CALL PROD(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11340 CONTINUE
CCCCC CALL INTVEC(TEMP,TEMPZ,NS2,NUMVIN,IWRITE,RIGHT,IBUGG3,IERROR)
      CALL INTVEC(TEMP,TEMPZ,NS2,NUMV2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11350 CONTINUE
      CALL MIDRAN(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11360 CONTINUE
      CALL MEAN(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11370 CONTINUE
      CALL MIDMEA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR)
      GOTO79000
11372 CONTINUE
      CALL SHMIDM(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,
     1            ISUBRO,IBUGG3,IERROR)
      GOTO79000
11373 CONTINUE
      CALL SHMIDM(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,
     1            ISUBRO,IBUGG3,IERROR)
      CALL SHMIDM(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=RIGH1 - RIGH2
      GOTO79000
11374 CONTINUE
      CALL SHMIDR(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,
     1            ISUBRO,IBUGG3,IERROR)
      GOTO79000
11375 CONTINUE
      CALL SHMIDR(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,
     1            ISUBRO,IBUGG3,IERROR)
      CALL SHMIDR(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=RIGH1 - RIGH2
      GOTO79000
11380 CONTINUE
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR)
      GOTO79000
11390 CONTINUE
      CALL SD(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11395 CONTINUE
      CALL RMS(TEMP,NS2,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11396 CONTINUE
      CALL SSQ(TEMP,NS2,XCAP,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11397 CONTINUE
      CALL RSCSUM(TEMP,NS2,XCAP,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11398 CONTINUE
      CALL SSQ(TEMP,NS2,XCAP,IWRITE,RIGH1,IBUGG3,ISUBRO,IERROR)
      CALL SSQ(TEMPZ,NSZ,XCAP,IWRITE,RIGH2,IBUGG3,ISUBRO,IERROR)
      RIGHT=RIGH1 - RIGH2
      GOTO79000
11399 CONTINUE
      CALL SSQMEA(TEMP,NS2,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
19399 CONTINUE
      CALL SSQMEA(TEMP,NS2,IWRITE,RIGH1,IBUGG3,ISUBRO,IERROR)
      CALL SSQMEA(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,ISUBRO,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
11400 CONTINUE
      CALL VAR(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      IF(ICASPL.EQ.'PREC')THEN
         IF(RIGHT.GT.0.0)THEN
           RIGHT=1.0/RIGHT
         ELSE
           RIGHT=0.0
         ENDIF
      ENDIF
      GOTO79000
11401 CONTINUE
      CALL RSCSUM(TEMP,NS2,XCAP,IWRITE,RIGH1,IBUGG3,ISUBRO,IERROR)
      CALL RSCSUM(TEMPZ,NSZ,XCAP,IWRITE,RIGH2,IBUGG3,ISUBRO,IERROR)
      RIGHT=RIGH1 - RIGH2
      GOTO79000
11403 CONTINUE
      DO11404II=1,NS2
        TEMPZ(II)=1.0
11404 CONTINUE
      CALL JSCORE(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,XTEMP3,NTEMP,
     1            IBUGG3,ISUBRO,IERROR)
      RIGHT=XTEMP3(1)
      GOTO79000
11405 CONTINUE
      CALL DISTIN(TEMPZ,NS2,IWRITE,XTEMP1,NOUT,IBUGG3,IERROR)
      ANMAT=REAL(NOUT)
      CALL SSQ(TEMP,NS2,XCAP,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      RIGHT=SQRT(RIGHT/ANMAT)
      GOTO79000
11410 CONTINUE
      CALL RELSD(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11415 CONTINUE
      CALL MEAN(TEMP,NS2,IWRITE,RIGHTM,IBUGG3,IERROR)
      CALL VAR(TEMP,NS2,IWRITE,RIGHTV,IBUGG3,IERROR)
      RIGHT=0.0
CCCCC NOVEMBER 1994.  TO BE CONSISTENT WITH RELATIVE SD PLOT, USE
CCCCC ABS(MEAN) RATHER THAN MEAN.
CCCCC IF(RIGHTM.NE.0.0)RIGHT=100.0*RIGHTV/RIGHTM
      IF(RIGHTM.NE.0.0)RIGHT=100.0*RIGHTV/ABS(RIGHTM)
      GOTO79000
11418 CONTINUE
      CALL SD(TEMP,NS2,IWRITE,RIGHTV,IBUGG3,IERROR)
      CALL MEAN(TEMP,NS2,IWRITE,RIGHTM,IBUGG3,IERROR)
      RIGHT=0.0
      IF(RIGHTM.NE.0.0)RIGHT=RIGHTV/RIGHTM
      IF(ICASPL.EQ.'UCVA')THEN
        AVAL=1.0 + 1.0/(4.0*REAL(NS2))
        RIGHT=AVAL*RIGHT
      ENDIF
      GOTO79000
11419 CONTINUE
      CALL SD(TEMP,NS2,IWRITE,RIGHTV,IBUGG3,IERROR)
      CALL MEAN(TEMP,NS2,IWRITE,RIGHTM,IBUGG3,IERROR)
      RIGHT=0.0
      IF(RIGHTV.NE.0.0)RIGHT=RIGHTM/RIGHTV
      GOTO79000
11420 CONTINUE
      CALL RANGDP(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11421 CONTINUE
C
C     2017/11: USE AAD RATHER THAN MAD TO BE CONSISTENT WITH
C              DEFINITION IN BONETT AND SEIER PAPER.
C
CCCCC CALL MAD(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHTV,
CCCCC1         IBUGG3,IERROR)
      CALL AAD(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHTV,'MEDI',
     1         IBUGG3,IERROR)
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHTM,IBUGG3,IERROR)
      RIGHT=0.0
      IF(RIGHTM.NE.0.0)RIGHT=RIGHTV/RIGHTM
      GOTO79000
11427 CONTINUE
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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
      ELSE
        ALPHA=0.95
      ENDIF
C
      IF(ICASPL.EQ.'LCDL')ICASA3='LOWE'
      IF(ICASPL.EQ.'1LCD')ICASA3='LOWE'
      IF(ICASPL.EQ.'UCDL')ICASA3='UPPE'
      IF(ICASPL.EQ.'1UCD')ICASA3='UPPE'
      ICASA5='TWOS'
      IF(ICASPL.EQ.'1LCD')ICASA5='ONES'
      IF(ICASPL.EQ.'1UCD')ICASA5='ONES'
C
      ALPHAT(1)=ALPHA
      NALPHA=1
C
      CALL DPCDC3(TEMP,NS2,ICASA3,ICASA5,ISEED,MAXNXT,
     1            XTEMP1,ALPHAT,NALPHA,ALOWLV,AUPPLV,
     1            CD,YMED,YAAD,
     1            ISUBRO,IBUGG3,IERROR)
C
      IF(ICASPL.EQ.'LCDL')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'1LCD')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'UCDL')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'1UCD')RIGHT=AUPPLV(1)
      GOTO79000
11428 CONTINUE
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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
      ELSE
        ALPHA=0.95
      ENDIF
C
      IF(ICASPL.EQ.'LCDQ')ICASA3='LOWE'
      IF(ICASPL.EQ.'UCDQ')ICASA3='UPPE'
      ICASA5='TWOS'
C
      ALPHAT(1)=ALPHA
      NALPHA=1
C
      CALL DPCQD3(TEMP,NS2,ICASA3,ICASA5,ISEED,MAXNXT,IQUAME,
     1            XTEMP1,ALPHAT,NALPHA,ALOWLV,AUPPLV,
     1            CQV,Q1,Q3,
     1            ISUBRO,IBUGG3,IERROR)
C
      IF(ICASPL.EQ.'LCDQ')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'UCDQ')RIGHT=AUPPLV(1)
      GOTO79000
11422 CONTINUE
      CALL VAR(TEMP,NS2,IWRITE,RIGHTV,IBUGG3,IERROR)
      CALL MEAN(TEMP,NS2,IWRITE,RIGHTM,IBUGG3,IERROR)
      RIGHT=0.0
      IF(RIGHTM.NE.0.0)RIGHT=RIGHTV/RIGHTM
      GOTO79000
11423 CONTINUE
      CALL MAD(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHV,
     1         IBUGG3,IERROR)
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHTM,IBUGG3,IERROR)
      RIGHT=0.0
      IF(RIGHTM.NE.0.0)RIGHT=RIGHTV/RIGHTM
      GOTO79000
11424 CONTINUE
      CALL MAD(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHTV,
     1         IBUGG3,IERROR)
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHTM,IBUGG3,IERROR)
      RIGH1=0.0
      IF(RIGHTM.NE.0.0)RIGH1=RIGHTV/RIGHTM
      CALL MAD(TEMPZ,NSZ,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHTV,
     1         IBUGG3,IERROR)
      CALL MEDIAN(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGHTM,IBUGG3,IERROR)
      RIGH2=0.0
      IF(RIGHTM.NE.0.0)RIGH2=RIGHTV/RIGHTM
      RIGHT=RIGH1 - RIGH2
      GOTO79000
11425 CONTINUE
      CALL VAR(TEMP,NS2,IWRITE,RIGHTV,IBUGG3,IERROR)
      CALL MEAN(TEMP,NS2,IWRITE,RIGHTM,IBUGG3,IERROR)
      RIGH1=0.0
      IF(RIGHTM.NE.0.0)RIGH1=RIGHTV/RIGHTM
      CALL VAR(TEMPZ,NSZ,IWRITE,RIGHTV,IBUGG3,IERROR)
      CALL MEAN(TEMPZ,NSZ,IWRITE,RIGHTM,IBUGG3,IERROR)
      RIGH2=0.0
      IF(RIGHTM.NE.0.0)RIGH2=RIGHTV/RIGHTM
      RIGHT=RIGH1 - RIGH2
      GOTO79000
11426 CONTINUE
      CALL MAD(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHTV,
     1         IBUGG3,IERROR)
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHTM,IBUGG3,IERROR)
      RIGH1=0.0
      IF(RIGHTM.NE.0.0)RIGH1=RIGHTV/RIGHTM
      CALL MAD(TEMPZ,NSZ,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHTV,
     1         IBUGG3,IERROR)
      CALL MEDIAN(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGHTM,IBUGG3,IERROR)
      RIGH2=0.0
      IF(RIGHTM.NE.0.0)RIGH2=RIGHTV/RIGHTM
      RIGHT=RIGH1 - RIGH2
      GOTO79000
11430 CONTINUE
      CALL MINIM(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11440 CONTINUE
      CALL MAXIM(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11450 CONTINUE
      CALL STMOM3(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11452 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,Q1,IBUGG3,IERROR)
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,Q3,IBUGG3,IERROR)
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,Q2,IBUGG3,IERROR)
      IF(Q1.NE.Q3)THEN
        RIGHT=(Q3 + Q1 - 2.0*Q2)/(Q3 - Q1)
      ELSE
        RIGHT=CPUMIN
      ENDIF
      GOTO79000
11454 CONTINUE
      CALL MEAN(TEMP,NS2,IWRITE,YMEAN,IBUGG3,IERROR)
      CALL SD(TEMP,NS2,IWRITE,YSD,IBUGG3,IERROR)
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,YMED,IBUGG3,IERROR)
      IF(YSD.GT.0.0)THEN
        RIGHT=3.0*(YMEAN-YMED)/YSD
      ELSE
        RIGHT=CPUMIN
      ENDIF
      GOTO79000
11460 CONTINUE
      CALL STMOM4(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11465 CONTINUE
      CALL STMOM4(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      RIGHT=RIGHT-3.0
      GOTO79000
11470 CONTINUE
      CALL AUTOCR(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11480 CONTINUE
      CALL COV(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
31480 CONTINUE
      CALL COMOVE(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11490 CONTINUE
      CALL CORR(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      IF(ICASPL.EQ.'COAB')THEN
        RIGHT=ABS(RIGHT)
      ELSEIF(ICASPL.EQ.'COPV')THEN
        IDF1=1
        IDF2=NS2 - 2
        ANUM=REAL(NS2-2)*RIGHT**2
        DENOM=1.0 - RIGHT**2
        CDF=0.0
        IF(DENOM.NE.0.0D0)THEN
          AVAL=ABS(ANUM/DENOM)
          CALL FCDF(AVAL,IDF1,IDF2,CDF)
        ENDIF
        RIGHT=1.0 - CDF
      ELSEIF(ICASPL.EQ.'COCD')THEN
        IDF1=1
        IDF2=NS2 - 2
        ANUM=REAL(NS2-2)*RIGHT**2
        DENOM=1.0 - RIGHT**2
        CDF=0.0
        IF(DENOM.NE.0.0D0)THEN
          AVAL=ABS(ANUM/DENOM)
          CALL FCDF(AVAL,IDF1,IDF2,CDF)
        ENDIF
        RIGHT=CDF
      ELSEIF(ICASPL.EQ.'PDIS')THEN
        RIGHT=(1.0 - RIGHT)/2.0
      ELSEIF(ICASPL.EQ.'PSIM')THEN
        RIGHT=1.0 - (1.0 - RIGHT)/2.0
      ENDIF
      GOTO79000
11491 CONTINUE
      IHP='P   '
      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)
      IF(IERROR.EQ.'YES')THEN
        P=1.0
      ELSE
        P=VALUE(ILOCP)
      ENDIF
      CALL MNKDIS(TEMP,TEMPZ,NS2,P,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11492 CONTINUE
      CALL CANDIS(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11495 CONTINUE
      CALL CORR(TEMP,TEMPZ,NS2,IWRITE,R12,IBUGG3,IERROR)
      CALL CORR(TEMP,TEMPZ3,NS2,IWRITE,R13,IBUGG3,IERROR)
      CALL CORR(TEMPZ,TEMPZ3,NS2,IWRITE,R23,IBUGG3,IERROR)
      ANUM=R12 - (R13*R23)
      DENOM=SQRT((1.0 - R13**2)*(1.0 - R23**2))
      IF(DENOM.GT.0.0)THEN
        RIGHT=ANUM/DENOM
      ELSE
        RIGHT=PSTAMV
      ENDIF
      IF(RIGHT.EQ.PSTAMV)GOTO79000
      IF(ICASPL.EQ.'PCAB')THEN
        RIGHT=ABS(RIGHT)
      ELSEIF(ICASPL.EQ.'PCPV')THEN
        IDF1=1
        IDF2=NS2 - 3
        ANUM=REAL(NS2-3)*RIGHT**2
        DENOM=1.0 - RIGHT**2
        CDF=0.0
        IF(DENOM.NE.0.0D0)THEN
          AVAL=ABS(ANUM/DENOM)
          CALL FCDF(AVAL,IDF1,IDF2,CDF)
        ENDIF
        RIGHT=1.0 - CDF
      ELSEIF(ICASPL.EQ.'PCCD')THEN
        IDF1=1
        IDF2=NS2
        ANUM=REAL(NS2-3)*RIGHT**2
        DENOM=1.0 - RIGHT**2
        CDF=0.0
        IF(DENOM.NE.0.0D0)THEN
          AVAL=ABS(ANUM/DENOM)
          CALL FCDF(AVAL,IDF1,IDF2,CDF)
        ENDIF
        RIGHT=CDF
      ENDIF
      GOTO79000
11496 CONTINUE
      CALL MANDIS(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11497 CONTINUE
      CALL CHEDI2(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11498 CONTINUE
      CALL COSDIS(TEMP,TEMPZ,NS2,IWRITE,ICASPL,RIGHT,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
11499 CONTINUE
      IF(ICASPL.EQ.'EUCD')ICASE2='VEDI'
      IF(ICASPL.EQ.'EUCL')ICASE2='VELE'
      IF(ICASPL.EQ.'DOTP')ICASE2='VEDP'
      CALL VECARI(TEMP,TEMPZ,NS2,ICASE2,IWRITE,
     1            TEMPZ3,NOUT,RIGHT,ITYP91,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11500 CONTINUE
      CALL RANKCR(TEMP,TEMPZ,NS2,IRCRTA,IWRITE,
     1            XTEMP1,XTEMP2,XTEMP3,MAXNXT,
     1            RIGHT,STATCD,PVAL,PVALLT,PVALUT,
     1            CUTU90,CUTU95,CTU975,CUTU99,CTU995,CTU999,
     1            CUTL90,CUTL95,CTL975,CUTL99,CTL995,CTL999,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'RACA')RIGHT=ABS(RIGHT)
      IF(ICASPL.EQ.'RACC')RIGHT=STATCD
      IF(ICASPL.EQ.'RACP')RIGHT=PVAL
      IF(ICASPL.EQ.'RALP')RIGHT=PVALLT
      IF(ICASPL.EQ.'RAUP')RIGHT=PVALUT
      IF(ICASPL.EQ.'RDIS')RIGHT=(1.0 - RIGHT)/2.0
      IF(ICASPL.EQ.'RSIM')RIGHT=1.0 - (1.0 - RIGHT)/2.0
      GOTO79000
11502 CONTINUE
      CALL HAMDIS(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11505 CONTINUE
      CALL RANKCR(TEMP,TEMPZ,NS2,IRCRTA,IWRITE,
     1            XTEMP1,XTEMP2,XTEMP3,MAXNXT,
     1            R12,STATCD,PVAL,PVALLT,PVALUT,
     1            CUTU90,CUTU95,CTU975,CUTU99,CTU995,CTU999,
     1            CUTL90,CUTL95,CTL975,CUTL99,CTL995,CTL999,
     1            IBUGG3,ISUBRO,IERROR)
      CALL RANKCR(TEMP,TEMPZ3,NS2,IRCRTA,IWRITE,
     1            XTEMP1,XTEMP2,XTEMP3,MAXNXT,
     1            R13,STATCD,PVAL,PVALLT,PVALUT,
     1            CUTU90,CUTU95,CTU975,CUTU99,CTU995,CTU999,
     1            CUTL90,CUTL95,CTL975,CUTL99,CTL995,CTL999,
     1            IBUGG3,ISUBRO,IERROR)
      CALL RANKCR(TEMPZ,TEMPZ3,NS2,IRCRTA,IWRITE,
     1            XTEMP1,XTEMP2,XTEMP3,MAXNXT,
     1            R23,STATCD,PVAL,PVALLT,PVALUT,
     1            CUTU90,CUTU95,CTU975,CUTU99,CTU995,CTU999,
     1            CUTL90,CUTL95,CTL975,CUTL99,CTL995,CTL999,
     1            IBUGG3,ISUBRO,IERROR)
      ANUM=R12 - (R13*R23)
      DENOM=SQRT((1.0 - R13**2)*(1.0 - R23**2))
      IF(DENOM.GT.0.0)THEN
        RIGHT=ANUM/DENOM
      ELSE
        RIGHT=PSTAMV
      ENDIF
      IF(ICASPL.EQ.'RPCA' .AND. RIGHT.NE.PSTAMV)RIGHT=ABS(RIGHT)
      GOTO79000
11509 CONTINUE
      CALL PERDME(TEMP,NS2,TEMPZ,NSZ,IWRITE,RIGHT,
     1            ISUBRO,IBUGG3,IERROR)
      GOTO79000
11510 CONTINUE
      CALL SDMEAN(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11520 CONTINUE
      CALL AUTOCV(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11530 CONTINUE
      CALL RANKCV(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,XTEMP3,
     1MAXNXT,RIGHT,
     1IBUGG3,IERROR)
      GOTO79000
11531 CONTINUE
      CALL PERAGR(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'PEDI' .AND. RIGHT.GE.0.0)RIGHT=100.0 - RIGHT
      GOTO79000
31530 CONTINUE
      CALL RANKCM(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,XTEMP3,
     1MAXNXT,RIGHT,
     1IBUGG3,IERROR)
      GOTO79000
31540 CONTINUE
      ICASZZ='TWOS'
      CALL KENTAU(TEMP,TEMPZ,NS2,ICASZZ,IKTATA,IWRITE,
     1            XTEMP1,XTEMP2,MAXNXT,
     1            RIGHT,AKTAUA,AKTAUB,AKTAUC,
     1            STATCD,PVAL,PVALLT,PVALUT,
     1            CUTU90,CUTU95,CTU975,CUTU99,CTU995,
     1            CUTL90,CUTL95,CTL975,CUTL99,CTL995,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'TAUA')RIGHT=AKTAUA
      IF(ICASPL.EQ.'KTAB')RIGHT=AKTAUB
      IF(ICASPL.EQ.'KTAC')RIGHT=AKTAUC
      IF(ICASPL.EQ.'KTAA')RIGHT=ABS(RIGHT)
      IF(ICASPL.EQ.'KTCD')RIGHT=STATCD
      IF(ICASPL.EQ.'KTPV')RIGHT=PVAL
      IF(ICASPL.EQ.'KTPL')RIGHT=PVALLT
      IF(ICASPL.EQ.'KTPU')RIGHT=PVALUT
      IF(ICASPL.EQ.'KDIS')RIGHT=(1.0 - RIGHT)/2.0
      IF(ICASPL.EQ.'KSIM')RIGHT=1.0 - (1.0 - RIGHT)/2.0
      GOTO79000
31545 CONTINUE
      ICASZZ='TWOS'
      CALL KENTAU(TEMP,TEMPZ,NS2,ICASZZ,IKTATA,IWRITE,
     1            XTEMP1,XTEMP2,MAXNXT,
     1            R12,AKTAUA,AKTAUB,AKTAUC,
     1            STATCD,PVAL,PVALLT,PVALUT,
     1            CUTU90,CUTU95,CTU975,CUTU99,CTU995,
     1            CUTL90,CUTL95,CTL975,CUTL99,CTL995,
     1            IBUGG3,ISUBRO,IERROR)
      CALL KENTAU(TEMP,TEMPZ3,NS2,ICASZZ,IKTATA,IWRITE,
     1            XTEMP1,XTEMP2,MAXNXT,
     1            R13,AKTAUA,AKTAUB,AKTAUC,
     1            STATCD,PVAL,PVALLT,PVALUT,
     1            CUTU90,CUTU95,CTU975,CUTU99,CTU995,
     1            CUTL90,CUTL95,CTL975,CUTL99,CTL995,
     1            IBUGG3,ISUBRO,IERROR)
      CALL KENTAU(TEMPZ,TEMPZ3,NS2,ICASZZ,IKTATA,IWRITE,
     1            XTEMP1,XTEMP2,MAXNXT,
     1            R23,AKTAUA,AKTAUB,AKTAUC,
     1            STATCD,PVAL,PVALLT,PVALUT,
     1            CUTU90,CUTU95,CTU975,CUTU99,CTU995,
     1            CUTL90,CUTL95,CTL975,CUTL99,CTL995,
     1            IBUGG3,ISUBRO,IERROR)
      ANUM=R12 - (R13*R23)
      DENOM=SQRT((1.0 - R13**2)*(1.0 - R23**2))
      IF(DENOM.GT.0.0)THEN
        RIGHT=ANUM/DENOM
      ELSE
        RIGHT=PSTAMV
      ENDIF
      IF(ICASPL.EQ.'PKAB' .AND. RIGHT.NE.PSTAMV)RIGHT=ABS(RIGHT)
      GOTO79000
31550 CONTINUE
      CALL SUMDP(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL SUMDP(TEMPZ,NS2,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=0.0
      IF(RIGH2.NE.0.0)RIGHT=RIGH1/RIGH2
      GOTO79000
C
C     BINOMIAL RATIO - FOR CASE WHERE BINOMIAL PROBABILITIES GIVEN
C                      AS NUMBER OF SUCCESSES AND NUMBER OF TRIALS
C                      RATHER THAN A SERIES OF 0/1 VALUES (I.E., DATA
C                      PREVIOUSLY AGGREGATED).  SLIGHTLY DIFFERENT
C                      FROM "RATIO" IN THAT WE NEED TO CHECK THAT
C                      VALUE FOR SECOND VARIABLE ALWAYS > VALUE
C                      FOR FIRST VARIABLE.  ALSO, OMIT ROW IF EITHER
C                      VALUE IS EQUAL TO THE MISSING VALUE.
C
31551 CONTINUE
      RIGHT=PSTAMV
      NTEMP=0
      DO31552I=1,NS2
        IVAL1=INT(TEMP(I)+0.1)
        IVAL2=INT(TEMPZ(I)+0.1)
        IF(TEMP(I).EQ.PSTAMV .OR. TEMPZ(I).EQ.PSTAMV)THEN
          GOTO31552
        ELSEIF(IVAL1.GT.IVAL2)THEN
          IERROR='YES'
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,31553)
31553     FORMAT('***** ERROR IN CMPSTA')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,31554)
31554     FORMAT('      FOR BINOMIAL RATIO, NUMBER OF SUCCESSES IS ')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,31555)
31555     FORMAT('      GREATER THAN THE NUMBER OF TRIALS.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,31556)IVAL1
31556     FORMAT('      THE NUMBER OF SUCCESSES = ',I8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,31557)IVAL2
31557     FORMAT('      THE NUMBER OF TRIALS    = ',I8)
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ELSE
          NTEMP=NTEMP+1
          IF(IVAL1.LT.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,31553)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,31558)IVAL1
31558       FORMAT('      THE NUMBER OF SUCCESSES, ',I8,
     1             ' IS NEGATIVE.')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
          IF(IVAL2.LT.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,31553)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,31559)IVAL2
31559       FORMAT('      THE NUMBER OF TRIALS, ',I8,
     1             ' IS NEGATIVE.')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
          TEMP(NTEMP)=IVAL1
          TEMPZ(NTEMP)=IVAL2
        ENDIF
31552 CONTINUE
      IF(NTEMP.LE.0)GOTO79000
      CALL SUMDP(TEMP,NTEMP,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL SUMDP(TEMPZ,NTEMP,IWRITE,RIGH2,IBUGG3,IERROR)
      IF(RIGH2.NE.0.0)RIGHT=RIGH1/RIGH2
      ITEMP1(1)=INT(RIGH2+0.1)
      GOTO79000
C
31565 CONTINUE
      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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
      ELSE
        ALPHA=0.95
      ENDIF
C
      ALPHAT(1)=ALPHA
      NALPHA=1
      IF(IRATME.EQ.'FIEL')THEN
        CALL DPMRC3(TEMP,TEMPZ,NS2,ALPHAT,NALPHA,
     1              RATIO,ALOWLV,AUPPLV,
     1              YBAR,XBAR,YVAR,XVAR,
     1              ISUBRO,IBUGG3,IERROR)
      ELSEIF(IRATME.EQ.'LSAM')THEN
        CALL DPMRC4(TEMP,TEMPZ,NS2,ALPHAT,NALPHA,
     1              RATIO,ALOWLV,AUPPLV,
     1              YBAR,XBAR,YVAR,XVAR,XYCOV,
     1              ISUBRO,IBUGG3,IERROR)
      ELSEIF(IRATME.EQ.'LRAT')THEN
        CALL DPMRC5(TEMP,TEMPZ,NS2,ALPHAT,NALPHA,
     1              RATIO,ALOWLV,AUPPLV,
     1              YBAR,XBAR,YVAR,XVAR,XYCOV,
     1              ISUBRO,IBUGG3,IERROR)
      ENDIF
      IF(ICASPL.EQ.'RMEA')THEN
        RIGHT=RATIO
      ELSEIF(ICASPL.EQ.'RMLL')THEN
        RIGHT=ALOWLV(1)
      ELSEIF(ICASPL.EQ.'RMUL')THEN
        RIGHT=AUPPLV(1)
      ENDIF
      GOTO79000
C
31560 CONTINUE
      CALL ODDRAT(TEMP,NS2,TEMPZ,NSZ,PSTAMV,IWRITE,XTEMP1,RIGHT,
     1            IBUGG3,IERROR)
      GOTO79000
31570 CONTINUE
      CALL ODDRSE(TEMP,NS2,TEMPZ,NS2,PSTAMV,IWRITE,XTEMP1,RIGHT,
     1            IBUGG3,IERROR)
      GOTO79000
31580 CONTINUE
      CALL RELRSK(TEMP,NS2,TEMPZ,NSZ,PSTAMV,IWRITE,XTEMP1,RIGHT,
     1            IBUGG3,IERROR)
      GOTO79000
31590 CONTINUE
      CALL CRAMER(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,XTEMP3,
     1            RIGHT,IBUGG3,IERROR)
      GOTO79000
31600 CONTINUE
      CALL PEARCC(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,XTEMP3,
     1            RIGHT,IBUGG3,IERROR)
      GOTO79000
31610 CONTINUE
      CALL FALPOS(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,RIGHT,IBUGG3,IERROR)
      GOTO79000
31620 CONTINUE
      CALL FALNEG(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,RIGHT,IBUGG3,IERROR)
      GOTO79000
31630 CONTINUE
      CALL TRUPOS(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,RIGHT,IBUGG3,IERROR)
      GOTO79000
31640 CONTINUE
      CALL TRUNEG(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,RIGHT,IBUGG3,IERROR)
      GOTO79000
31650 CONTINUE
      CALL SENSIT(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,RIGHT,IBUGG3,IERROR)
      GOTO79000
31660 CONTINUE
      CALL SPECIF(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,RIGHT,IBUGG3,IERROR)
      GOTO79000
31670 CONTINUE
      CALL PPV(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,RIGHT,IBUGG3,IERROR)
      GOTO79000
31680 CONTINUE
      CALL NPV(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,RIGHT,IBUGG3,IERROR)
      GOTO79000
31685 CONTINUE
      CALL BINMAT(TEMP,TEMPZ,NS2,ICASPL,IWRITE,XTEMP1,RIGHT,
     1            ISUBRO,IBUGG3,IERROR)
      GOTO79000
31688 CONTINUE
      CALL GJACC(TEMP,TEMPZ,NS2,ICASPL,IWRITE,RIGHT,DIST,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'GJDI')RIGHT=DIST
      GOTO79000
31690 CONTINUE
      CALL LOGIT(TEMP,NS2,TEMPZ,NSZ,PSTAMV,IWRITE,XTEMP1,RIGHT,
     1           IBUGG3,IERROR)
      GOTO79000
31700 CONTINUE
      CALL LOGISE(TEMP,NS2,TEMPZ,NSZ,PSTAMV,IWRITE,XTEMP1,RIGHT,
     1            IBUGG3,IERROR)
      GOTO79000
C
31710 CONTINUE
      CALL TRIMSD(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,MAXNXT,
     1            XTEMP1,RIGHT,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
31715 CONTINUE
      CALL CORRAT(TEMP,TEMPZ,NS2,ICASPL,IWRITE,XTEMP1,ETA,
     1            IBUGG3,ISUBRO,IERROR)
      RIGHT=ETA
      IF(ICASPL.EQ.'ICCR')RIGHT=ETA**2
      GOTO79000
C
11540 CONTINUE
      CALL LOWHIN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR)
      GOTO79000
11550 CONTINUE
      CALL UPPHIN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR)
      GOTO79000
11560 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR)
      GOTO79000
11570 CONTINUE
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR)
      GOTO79000
11575 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      RIGHT=(RIGH2 + RIGH1)/2.0
      GOTO79000
11576 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      RIGH3=(RIGH2 + RIGH1)/2.0
      CALL LOWQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH4,IBUGG3,IERROR)
      CALL UPPQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH5,IBUGG3,IERROR)
      RIGH6=(RIGH4 + RIGH5)/2.0
      RIGHT=RIGH3 - RIGH6
      GOTO79000
11578 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH3,IBUGG3,IERROR)
      RIGH4=(RIGH2 + RIGH1)/2.0
      RIGHT=(RIGH4 + RIGH3)/2.0
      GOTO79000
11579 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH3,IBUGG3,IERROR)
      RIGH4=(RIGH2 + RIGH1)/2.0
      RIGH5=(RIGH4 + RIGH3)/2.0
      CALL LOWQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH6,IBUGG3,IERROR)
      CALL UPPQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH7,IBUGG3,IERROR)
      CALL MEDIAN(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH8,IBUGG3,IERROR)
      RIGH9=(RIGH7 + RIGH6)/2.0
      RIGH10=(RIGH9 + RIGH8)/2.0
      RIGHT=RIGH5-RIGH10
      GOTO79000
C
11580 CONTINUE
      CALL TRIMME(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,XTEMP1,
     1            MAXNXT,RIGHT,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
11590 CONTINUE
      CALL WINDME(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,XTEMP1,
     1            MAXNXT,RIGHT,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
11610 CONTINUE
      IF(ICASPL.EQ.'MIDQ')P100=50.0
      IF(ICASPL.EQ.'1DEC')P100=10.0
      IF(ICASPL.EQ.'2DEC')P100=20.0
      IF(ICASPL.EQ.'3DEC')P100=30.0
      IF(ICASPL.EQ.'4DEC')P100=40.0
      IF(ICASPL.EQ.'5DEC')P100=50.0
      IF(ICASPL.EQ.'6DEC')P100=60.0
      IF(ICASPL.EQ.'7DEC')P100=70.0
      IF(ICASPL.EQ.'8DEC')P100=80.0
      IF(ICASPL.EQ.'9DEC')P100=90.0
      CALL PERCEN(P100,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,
     1RIGHT,IBUGG3,IERROR)
      GOTO79000
C
11615 CONTINUE
      IF(APVAL.GE.0.0 .AND. APVAL.LE.100.0)THEN
        P100=APVAL
      ELSEIF(IPNAM1.NE.'    ')THEN
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IPNAM1,IPNAM2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        P100=VALUE(ILOCP)
      ELSE
        IHP='P100'
        IHP2='    '
        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
        P100=VALUE(ILOCP)
      ENDIF
C
      CALL PERCEN(P100,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,
     1RIGHT,IBUGG3,IERROR)
      GOTO79000
C
11620 CONTINUE
      CALL WEMEAN(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11625 CONTINUE
      CALL WEOSME(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11630 CONTINUE
      CALL WEMEDI(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11640 CONTINUE
      CALL WESD(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11650 CONTINUE
      CALL WEVARI(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11655 CONTINUE
      CALL WESKEW(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,ISUBRO,IERROR)
      GOTO79000
11660 CONTINUE
C
      CALL WETRME(TEMP,TEMPZ,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,XTEMP2,
     1            MAXNXT,RIGHT,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
11670 CONTINUE
      IF(ICASPL.EQ.'WSUM')THEN
        IFLAGW=1
      ELSEIF(ICASPL.EQ.'WSSQ')THEN
        IFLAGW=2
      ELSEIF(ICASPL.EQ.'WSAB')THEN
        IFLAGW=3
      ELSEIF(ICASPL.EQ.'WAAB')THEN
        IFLAGW=4
      ELSEIF(ICASPL.EQ.'WSDV')THEN
        IFLAGW=5
      ELSEIF(ICASPL.EQ.'WSSD')THEN
        IFLAGW=6
      ENDIF
      CALL WESUM(TEMP,TEMPZ,NS2,IFLAGW,IWRITE,RIGHT,
     1           IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
11680 CONTINUE
      CALL WECOVA(TEMP,TEMPZ,TEMPZ3,NS2,ICASPL,IWRITE,RIGH1,RIGH2,
     1           IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'WCOV')RIGHT=RIGH1
      IF(ICASPL.EQ.'WCOR')RIGHT=RIGH2
      GOTO79000
C
11685 CONTINUE
      CALL GRPCOR(TEMP,TEMPZ,TEMPZ3,NS2,IWRITE,RIGHT,
     1            XTEMP1,XTEMP2,MAXOBV,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
11690 CONTINUE
      CALL WECODI(TEMP,TEMPZ,TEMPZ3,NS2,ICASPL,IWRITE,RIGH1,RIGH2,
     1           IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'WCDI')RIGHT=RIGH1
      IF(ICASPL.EQ.'WCSI')RIGHT=RIGH2
      GOTO79000
C
11700 CONTINUE
      CALL SDMEAN(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      RIGHT=RIGHT**2
      GOTO79000
C
11710 CONTINUE
      CALL SINFIT(TEMP,XTEMP2,NS2,IWRITE,XSINFR,XSINAM,XRESSD,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=XSINFR
      GOTO79000
C
11720 CONTINUE
      CALL SINFIT(TEMP,XTEMP2,NS2,IWRITE,XSINFR,XSINAM,XRESSD,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=XSINAM
      GOTO79000
C
11730 CONTINUE
      CALL LINFIT(TEMP,TEMPZ,NS2,
     1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=ALPHA
      GOTO79000
C
11735 CONTINUE
      CALL LINFIT(TEMP,TEMPZ,NS2,
     1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=SDALPH
      GOTO79000
C
11740 CONTINUE
      CALL LINFIT(TEMP,TEMPZ,NS2,
     1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=BETA
      GOTO79000
C
11745 CONTINUE
      CALL LINFIT(TEMP,TEMPZ,NS2,
     1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=SDBETA
      GOTO79000
C
11750 CONTINUE
      CALL LINFIT(TEMP,TEMPZ,NS2,
     1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=XRESSD
      GOTO79000
C
11760 CONTINUE
      CALL LINFIT(TEMP,TEMPZ,NS2,
     1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=CCXY
      GOTO79000
C
11770 CONTINUE
      CALL REPEAZ(TEMP,TEMPZ,XTEMP1,XTEMP2,NS2,IWRITE,XREP,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=XREP
      GOTO79000
C
11780 CONTINUE
      CALL REPROD(TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,NS2,IWRITE,XREP,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=XREP
      GOTO79000
C
11790 CONTINUE
      CALL MEAN(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
C
11795 CONTINUE
      CALL SD(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
C
11810 CONTINUE
      CALL TAGUCH(TEMP,NS2,ICASPL,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
C
11900 CONTINUE
      IHP='LSL '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ENGLSL=VALUE(ILOCP)
C
      IHP='USL '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ENGUSL=VALUE(ILOCP)
C
      IF(ICASPL.EQ.'CP')THEN
         CALL CP(TEMP,NS2,ENGLSL,ENGUSL,IWRITE,
     1           RIGHT,XLCL,XUCL,IBUGG3,IERROR)
         GOTO79000
      ELSEIF(ICASPL.EQ.'CPK')THEN
         CALL CPK(TEMP,NS2,ENGLSL,ENGUSL,IWRITE,
     1            RIGHT,XLCL,XUCL,IBUGG3,IERROR)
         GOTO79000
      ELSEIF(ICASPL.EQ.'CPL')THEN
         CALL CPL(TEMP,NS2,ENGLSL,ENGUSL,IWRITE,
     1            RIGHT,XLCL,XUCL,IBUGG3,IERROR)
         GOTO79000
      ELSEIF(ICASPL.EQ.'CPU')THEN
         CALL CPU(TEMP,NS2,ENGLSL,ENGUSL,IWRITE,
     1            RIGHT,XLCL,XUCL,IBUGG3,IERROR)
         GOTO79000
      ELSEIF(ICASPL.EQ.'CNP')THEN
         CALL CNP(TEMP,NS2,XTEMP1,MAXNXT,ENGLSL,ENGUSL,IWRITE,ICNPKD,
     1            RIGHT,IBUGG3,IERROR)
         GOTO79000
      ELSEIF(ICASPL.EQ.'CNPK')THEN
         CALL CNPK(TEMP,NS2,XTEMP1,MAXNXT,ENGLSL,ENGUSL,IWRITE,ICNPKD,
     1             RIGHT,IBUGG3,IERROR)
         GOTO79000
      ENDIF
C
      IF(ICASPL.EQ.'PEDE')THEN
         IFLAG='ACTU'
         CALL PERDEF(TEMP,NS2,ENGLSL,ENGUSL,IWRITE,
     1               RIGHT,RIJUNK,
     1               YACTL,YTHEL,YACTU,YTHEU,
     1               IFLAG,IBUGG3,IERROR)
         GOTO79000
      ENDIF
C
      IF(ICASPL.EQ.'EXLO')THEN
         IHP='USLC'
         IHP2='OST '
         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
         COSUSL=VALUE(ILOCP)
C
         CALL EXPLOS(TEMP,NS2,ENGLSL,ENGUSL,COSUSL,IWRITE,
     1               RIGHT,IBUGG3,IERROR)
         GOTO79000
      ENDIF
C
      IHP='TARG'
      IHP2='ET  '
      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
      TARGET=VALUE(ILOCP)
C
      IF(ICASPL.EQ.'CPM')THEN
         CALL CPM(TEMP,NS2,ENGLSL,ENGUSL,TARGET,IWRITE,
     1            RIGHT,XLCL,XUCL,IBUGG3,IERROR)
         GOTO79000
      ELSEIF(ICASPL.EQ.'CPMK')THEN
         CALL CPMK(TEMP,NS2,ENGLSL,ENGUSL,TARGET,IWRITE,
     1             RIGHT,XLCL,XUCL,IBUGG3,IERROR)
         GOTO79000
      ELSEIF(ICASPL.EQ.'CC')THEN
         CALL CC(TEMP,NS2,ENGLSL,ENGUSL,TARGET,IWRITE,
     1           RIGHT,IBUGG3,IERROR)
         GOTO79000
      ELSEIF(ICASPL.EQ.'CNPM')THEN
         CALL CNPM(TEMP,NS2,XTEMP1,MAXNXT,ENGLSL,ENGUSL,TARGET,
     1             IWRITE,ICNPKD,
     1             RIGHT,IBUGG3,IERROR)
         GOTO79000
      ELSEIF(ICASPL.EQ.'NPMK')THEN
         CALL CNPMK(TEMP,NS2,XTEMP1,MAXNXT,ENGLSL,ENGUSL,TARGET,
     1              IWRITE,ICNPKD,
     1              RIGHT,IBUGG3,IERROR)
         GOTO79000
      ENDIF
C
11910 CONTINUE
      SHAPE=0.0
      IF(ICASPL.EQ.'TLPP' .OR. ICASPL.EQ.'TLSH' .OR.
     1   ICASPL.EQ.'TLLO' .OR. ICASPL.EQ.'TLSC')THEN
        IHP='LAMB'
        IHP2='DA  '
        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
          SHAPE=CPUMIN
        ELSE
          SHAPE=VALUE(ILOCP)
        ENDIF
      ELSEIF(ICASPL.EQ.'LNPP' .OR. ICASPL.EQ.'LNSH' .OR.
     1       ICASPL.EQ.'LNLO' .OR. ICASPL.EQ.'LNSC')THEN
        IHP='SIGM'
        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)
        IF(IERROR.EQ.'YES')THEN
          SHAPE=CPUMIN
        ELSE
          SHAPE=VALUE(ILOCP)
        ENDIF
      ELSEIF(ICASPL.EQ.'GHPP' .OR. ICASPL.EQ.'GHSH' .OR.
     1       ICASPL.EQ.'GHS2' .OR. ICASPL.EQ.'GHLO' .OR.
     1       ICASPL.EQ.'GHSC')THEN
        IHP='G   '
        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)
        IF(IERROR.EQ.'YES')THEN
          SHAPE=CPUMIN
        ELSE
          SHAPE=VALUE(ILOCP)
        ENDIF
        IHP='H   '
        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)
        IF(IERROR.EQ.'YES')THEN
          SHAPE2=CPUMIN
        ELSE
          SHAPE2=VALUE(ILOCP)
        ENDIF
      ELSEIF(ICASPL.EQ.'GPPC' .OR. ICASPL.EQ.'GSHA' .OR.
     1       ICASPL.EQ.'GSCA' .OR. ICASPL.EQ.'GLOC')THEN
        IHP='G   '
        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)
        IF(IERROR.EQ.'YES')THEN
          SHAPE=CPUMIN
        ELSE
          SHAPE=VALUE(ILOCP)
        ENDIF
      ELSEIF(ICASPL.EQ.'WEPP' .OR. ICASPL.EQ.'WESH' .OR.
     1       ICASPL.EQ.'WELO' .OR. ICASPL.EQ.'WESC' .OR.
     1       ICASPL.EQ.'W2PP' .OR. ICASPL.EQ.'WESC' .OR.
     1       ICASPL.EQ.'W2SH' .OR.
     1       ICASPL.EQ.'GPPP' .OR. ICASPL.EQ.'GPSH' .OR.
     1       ICASPL.EQ.'GPLO' .OR. ICASPL.EQ.'GPSC' .OR.
     1       ICASPL.EQ.'FLPP' .OR. ICASPL.EQ.'FLSH' .OR.
     1       ICASPL.EQ.'FLLO' .OR. ICASPL.EQ.'FLSC' .OR.
     1       ICASPL.EQ.'GAPP' .OR. ICASPL.EQ.'GASH' .OR.
     1       ICASPL.EQ.'GALO' .OR. ICASPL.EQ.'GASC' .OR.
     1       ICASPL.EQ.'IWPP' .OR. ICASPL.EQ.'IWSH' .OR.
     1       ICASPL.EQ.'IWLO' .OR. ICASPL.EQ.'IWSC' .OR.
     1       ICASPL.EQ.'WAPP' .OR. ICASPL.EQ.'WASH' .OR.
     1       ICASPL.EQ.'WALO' .OR. ICASPL.EQ.'WASC')THEN
        IHP='GAMM'
        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)
        IF(IERROR.EQ.'YES')THEN
          SHAPE=CPUMIN
        ELSE
          SHAPE=VALUE(ILOCP)
          IF(SHAPE.LE.0.0)SHAPE=CPUMIN
        ENDIF
      ENDIF
      CALL NORPPC(TEMP,NS2,IDIST,SHAPE,SHAPE2,
     1            IWRITE,XTEMP1,XTEMP2,XTEMP3,DTEMP1,MAXNXT,
     1            MINMAX,IGEPDF,
     1            RIGHT,SHAPE3,SHAPE4,ALOC,SCALE,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'WESH' .OR. ICASPL.EQ.'TLSH' .OR.
     1   ICASPL.EQ.'LNSH' .OR. ICASPL.EQ.'GPSH' .OR.
     1   ICASPL.EQ.'FLSH' .OR. ICASPL.EQ.'IWSH' .OR.
     1   ICASPL.EQ.'GASH' .OR. ICASPL.EQ.'GSHA' .OR.
     1   ICASPL.EQ.'W2SH' .OR.
     1   ICASPL.EQ.'GHSH' .OR. ICASPL.EQ.'WASH')RIGHT=SHAPE3
      IF(ICASPL.EQ.'GHS2')RIGHT=SHAPE4
      IF(ICASPL.EQ.'WELO' .OR. ICASPL.EQ.'TLLO' .OR.
     1   ICASPL.EQ.'NOLO' .OR. ICASPL.EQ.'UNLO' .OR.
     1   ICASPL.EQ.'CALO' .OR. ICASPL.EQ.'LOLO' .OR.
     1   ICASPL.EQ.'DELO' .OR. ICASPL.EQ.'COLO' .OR.
     1   ICASPL.EQ.'ANLO' .OR. ICASPL.EQ.'ARLO' .OR.
     1   ICASPL.EQ.'EXLO' .OR. ICASPL.EQ.'HSLO' .OR.
     1   ICASPL.EQ.'SLLO' .OR. ICASPL.EQ.'MXLO' .OR.
     1   ICASPL.EQ.'RALO' .OR. ICASPL.EQ.'HNLO' .OR.
     1   ICASPL.EQ.'HCLO' .OR. ICASPL.EQ.'SCLO' .OR.
     1   ICASPL.EQ.'LNLO' .OR. ICASPL.EQ.'GPLO' .OR.
     1   ICASPL.EQ.'GHLO' .OR. ICASPL.EQ.'WALO' .OR.
     1   ICASPL.EQ.'FLLO' .OR. ICASPL.EQ.'GALO' .OR.
     1   ICASPL.EQ.'IWLO' .OR. ICASPL.EQ.'SILO' .OR.
     1   ICASPL.EQ.'GLOC' .OR.
     1   ICASPL.EQ.'G1LO' .OR. ICASPL.EQ.'G2LO'
     1)RIGHT=ALOC
      IF(ICASPL.EQ.'WESC' .OR. ICASPL.EQ.'TLSC' .OR.
     1   ICASPL.EQ.'NOSC' .OR. ICASPL.EQ.'UNSC' .OR.
     1   ICASPL.EQ.'W2SC' .OR.
     1   ICASPL.EQ.'CASC' .OR. ICASPL.EQ.'LOSC' .OR.
     1   ICASPL.EQ.'DESC' .OR. ICASPL.EQ.'COSC' .OR.
     1   ICASPL.EQ.'ANSC' .OR. ICASPL.EQ.'ARSC' .OR.
     1   ICASPL.EQ.'EXSC' .OR. ICASPL.EQ.'HSSC' .OR.
     1   ICASPL.EQ.'SLSC' .OR. ICASPL.EQ.'MXSC' .OR.
     1   ICASPL.EQ.'RASC' .OR. ICASPL.EQ.'HNSC' .OR.
     1   ICASPL.EQ.'HCSC' .OR. ICASPL.EQ.'SCSC' .OR.
     1   ICASPL.EQ.'LNSC' .OR. ICASPL.EQ.'GPSC' .OR.
     1   ICASPL.EQ.'GHSC' .OR. ICASPL.EQ.'WASC' .OR.
     1   ICASPL.EQ.'GASC' .OR. ICASPL.EQ.'FLSC' .OR.
     1   ICASPL.EQ.'IWSC' .OR. ICASPL.EQ.'SISC' .OR.
     1   ICASPL.EQ.'GSCA' .OR.
     1   ICASPL.EQ.'G1SC' .OR. ICASPL.EQ.'G2SC'
     1)RIGHT=SCALE
      GOTO79000
C
11915 CONTINUE
C
C     FOR WEIBULL CASE WHEN GAUGE LENGTH OPTION IS ON, CHECK FOR
C     L PARAMETER
C
      IF(IDIST.EQ.'WEIB' .AND. IWEIGL.EQ.'ON')THEN
        IHP='L   '
        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)
        IF(IERROR.EQ.'YES')THEN
          AL=0.0
        ELSE
          AL=VALUE(ILOCP)
          IF(AL.LE.0.0)AL=0.0
        ENDIF
      ELSE
        AL=0.0
      ENDIF
      CALL NORADA(TEMP,NS2,IDIST,IWRITE,MAXNXT,
     1            TEMPZ,TEMPZ3,XTEMP1,XTEMP2,XTEMP3,
     1            DTEMP1,DTEMP2,DTEMP3,ITEMP1,
     1            MINMAX,IGEPDF,IDFTTY,IWEIGL,AL,
     1            STATVA,SHAPE1,SHAPE2,ALOC,SCALE,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'NOAD' .OR. ICASPL.EQ.'EXAD' .OR.
     1   ICASPL.EQ.'DXAD' .OR. ICASPL.EQ.'GUAD' .OR.
     1   ICASPL.EQ.'GAAD' .OR. ICASPL.EQ.'WEAD' .OR.
     1   ICASPL.EQ.'LNAD' .OR. ICASPL.EQ.'LOAD' .OR.
     1   ICASPL.EQ.'UNAD' .OR. ICASPL.EQ.'MXAD' .OR.
     1   ICASPL.EQ.'RAAD' .OR. ICASPL.EQ.'FLAD' .OR.
     1   ICASPL.EQ.'FRAD' .OR. ICASPL.EQ.'LXAD' .OR.
     1   ICASPL.EQ.'IGAD' .OR. ICASPL.EQ.'B1AD' .OR.
     1   ICASPL.EQ.'GEAD'
     1  )RIGHT=STATVA
      IF(ICASPL.EQ.'NADL' .OR. ICASPL.EQ.'EADL' .OR.
     1   ICASPL.EQ.'DXAL' .OR. ICASPL.EQ.'GUAL' .OR.
     1   ICASPL.EQ.'LOAL' .OR. ICASPL.EQ.'UNAL' .OR.
     1   ICASPL.EQ.'MXAL' .OR. ICASPL.EQ.'RAAL'
     1   )RIGHT=ALOC
      IF(ICASPL.EQ.'GAAZ' .OR. ICASPL.EQ.'WEAZ' .OR.
     1   ICASPL.EQ.'LNAZ' .OR. ICASPL.EQ.'FLAZ' .OR.
     1   ICASPL.EQ.'FRAZ' .OR. ICASPL.EQ.'LXAZ' .OR.
     1   ICASPL.EQ.'IGAZ' .OR. ICASPL.EQ.'B1AZ' .OR.
     1   ICASPL.EQ.'GEAZ'
     1  )RIGHT=SHAPE1
      IF(ICASPL.EQ.'NADS' .OR. ICASPL.EQ.'EADS' .OR.
     1   ICASPL.EQ.'DXAS' .OR. ICASPL.EQ.'GUAS' .OR.
     1   ICASPL.EQ.'LOAS' .OR. ICASPL.EQ.'UNAS' .OR.
     1   ICASPL.EQ.'MXAS' .OR. ICASPL.EQ.'RAAS' .OR.
     1   ICASPL.EQ.'GAAS' .OR. ICASPL.EQ.'WEAS' .OR.
     1   ICASPL.EQ.'FLAS' .OR. ICASPL.EQ.'FRAS' .OR.
     1   ICASPL.EQ.'LXAS' .OR. ICASPL.EQ.'IGAS' .OR.
     1   ICASPL.EQ.'B1AS' .OR. ICASPL.EQ.'GEAS' .OR.
     1   ICASPL.EQ.'LNAS'
     1  )RIGHT=SCALE
      GOTO79000
C
11920 CONTINUE
      CALL BCNORM(TEMP,NS2,XTEMP1,XTEMP2,XTEMP3,
     1            PPCC,ALAMBA,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'BCPP')RIGHT=PPCC
      IF(ICASPL.EQ.'BCLA')RIGHT=ALAMBA
      GOTO79000
C
11933 CONTINUE
      CALL MINIM(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL MAXIM(TEMP,NS2,IWRITE,RIGH2,IBUGG3,IERROR)
      IF(RIGH1.GE.0.0)THEN
        ASIGN1=1.0
      ELSE
        ASIGN1=-1.0
      ENDIF
      IF(RIGH2.GE.0.0)THEN
        ASIGN2=1.0
      ELSE
        ASIGN2=-1.0
      ENDIF
      RIGH1=ABS(RIGH1)
      RIGH2=ABS(RIGH2)
      IF(RIGH2.GT.RIGH1)THEN
        RIGHT=RIGH2
        RIGHT=ASIGN2*RIGHT
      ELSE
        RIGHT=RIGH1
        RIGHT=ASIGN1*RIGHT
      ENDIF
      GOTO79000
11935 CONTINUE
      ICASE2='MEAN'
      CALL AAD(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,ICASE2,IBUGG3,IERROR)
      GOTO79000
11938 CONTINUE
      ICASE2='MEDI'
      CALL AAD(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,ICASE2,IBUGG3,IERROR)
      GOTO79000
11940 CONTINUE
      CALL MAD(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT,IBUGG3,IERROR)
      IF(ICASPL.EQ.'MADN')RIGHT=RIGHT/0.67449
      GOTO79000
C
11950 CONTINUE
      CALL GEOMEA(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11960 CONTINUE
      CALL GEOSD(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11970 CONTINUE
      CALL HARMEA(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11980 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH2-RIGH1
      IF(ICASPL.EQ.'SIQU' .OR. ICASPL.EQ.'SIQL')THEN
        CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH3,IBUGG3,IERROR)
      ENDIF
      RIGHT=RIGH2-RIGH1
      IF(ICASPL.EQ.'NIQR')THEN
        RIGHT=0.7413*RIGHT
      ELSEIF(ICASPL.EQ.'SIQU')THEN
        RIGHT=RIGH2-RIGH3
      ELSEIF(ICASPL.EQ.'SIQL')THEN
        RIGHT=RIGH3-RIGH1
      ENDIF
      GOTO79000
11981 CONTINUE
CCCCC 2017/12: ALLOW QUANTILE METHOD TO BE SPECIFIED
CCCCC CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RQ1,IBUGG3,IERROR)
CCCCC CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RQ3,IBUGG3,IERROR)
      QNT=0.25
      CALL QUANT(QNT,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,IQUAME,RQ1,
     1           IBUGG3,IERROR)
      QNT=0.75
      CALL QUANT(QNT,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,IQUAME,RQ3,
     1           IBUGG3,IERROR)
      RIGHT=(RQ3 - RQ1)/(RQ1 + RQ3)
      GOTO79000
C
11982 CONTINUE
C
      IHP='QUAN'
      IHP2='T   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      XQUANT=VALUE(ILOCP)
C
      CALL QQRANG(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,XQUANT,RIGHT,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
11983 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RQ1,IBUGG3,IERROR)
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RQ3,IBUGG3,IERROR)
      RIGH1=(RQ3 - RQ1)/(RQ1 + RQ3)
      CALL LOWQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RQ1,IBUGG3,IERROR)
      CALL UPPQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RQ3,IBUGG3,IERROR)
      RIGH2=(RQ3 - RQ1)/(RQ1 + RQ3)
      RIGHT=RIGH1 - RIGH2
      GOTO79000
C
11990 CONTINUE
      CALL BIWLOC(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT,
     1IBUGG3,IERROR)
      GOTO79000
C
12000 CONTINUE
      CALL BIWSCA(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT,
     1IBUGG3,IERROR)
      GOTO79000
C
12010 CONTINUE
      CALL WINSOR(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,XTEMP2,
     1            IBUGG3,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      CALL VAR(XTEMP2,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
C
12030 CONTINUE
      CALL WINSOR(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,XTEMP2,
     1            IBUGG3,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      CALL SD(XTEMP2,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
C
12050 CONTINUE
      CALL WINSOR(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,XTEMP2,
     1            IBUGG3,ISUBRO,IERROR)
      DO12052I=1,NS2
        TEMP(I)=XTEMP2(I)
12052 CONTINUE
      CALL WINSOR(TEMPZ,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,XTEMP2,
     1            IBUGG3,ISUBRO,IERROR)
      DO12054I=1,NS2
        TEMPZ(I)=XTEMP2(I)
12054 CONTINUE
      CALL COV(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
C
12070 CONTINUE
      CALL WINSOR(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,XTEMP2,
     1            IBUGG3,ISUBRO,IERROR)
      DO12072I=1,NS2
        TEMP(I)=XTEMP2(I)
12072 CONTINUE
      CALL WINSOR(TEMPZ,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,XTEMP2,
     1            IBUGG3,ISUBRO,IERROR)
      DO12074I=1,NS2
        TEMPZ(I)=XTEMP2(I)
12074 CONTINUE
      CALL CORR(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
C
12090 CONTINUE
      CALL BIWMDV(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT,
     1IBUGG3,IERROR)
      GOTO79000
C
12100 CONTINUE
      CALL BIWMCV(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT,
     1IBUGG3,IERROR)
      GOTO79000
C
12110 CONTINUE
      CALL PBNMDV(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,BETA,
     1            IBUGG3,IERROR)
      GOTO79000
C
12115 CONTINUE
      CALL PBNCOR(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,
     1            RIGHT,BETA,
     1            IBUGG3,IERROR)
      GOTO79000
C
12120 CONTINUE
      DO12122I=1,NS2
        ITEMP1(I)=0
        ITEMP2(I)=0
        ITEMP3(I)=0
12122 CONTINUE
      CALL HLQEST(TEMP,NS2,XTEMP1,ITEMP1,ITEMP2,ITEMP3,ISEED,RIGHT)
      GOTO79000
C
12130 CONTINUE
C
      IF(APVAL.GE.0.0 .AND. APVAL.LE.1.0)THEN
        XQ=APVAL
      ELSEIF(IPNAM1.NE.'    ')THEN
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IPNAM1,IPNAM2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        XQ=VALUE(ILOCP)
      ELSE
        IHP='XQ  '
        IHP2='    '
        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
        XQ=VALUE(ILOCP)
      ENDIF
C
      CALL QUANT(XQ,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,
     1IQUAME,
     1RIGHT,IBUGG3,IERROR)
      GOTO79000
C
12135 CONTINUE
C
      IHP='XQNU'
      IHP2='M   '
      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
        XQNUM=0.9
      ELSE
        XQNUM=VALUE(ILOCP)
        IF(XQNUM.GT.1.0 .AND. XQNUM.LE.100.0)XQNUM=XQNUM/100.0
        IF(XQNUM.LT.0.0 .OR. XQNUM.GT.100.0)XQNUM=0.9
      ENDIF
C
      IHP='XQDE'
      IHP2='NOM '
      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
        XQDEN=0.4
      ELSE
        XQDEN=VALUE(ILOCP)
        IF(XQDEN.GT.1.0 .AND. XQDEN.LE.100.0)XQDEN=XQDEN/100.0
        IF(XQDEN.LT.0.0 .OR. XQDEN.GT.100.0)XQDEN=0.4
      ENDIF
C
      CALL DECRAT(TEMP,NS2,IWRITE,XQNUM,XQDEN,
     1            RIGHT,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
12140 CONTINUE
C
      IF(APVAL.GE.0.0 .AND. APVAL.LE.1.0)THEN
        XQ=APVAL
      ELSEIF(IPNAM1.NE.'    ')THEN
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IPNAM1,IPNAM2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        XQ=VALUE(ILOCP)
      ELSE
        IHP='XQ  '
        IHP2='    '
        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
        XQ=VALUE(ILOCP)
      ENDIF
C
      CALL QUANSE(XQ,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,
     1IQUASE,
     1RIGHT,IBUGG3,IERROR)
      GOTO79000
C
12150 CONTINUE
      CALL TRIMSE(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,XTEMP2,MAXNXT,RIGHT,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
12160 CONTINUE
      CALL BIWMDV(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH1,
     1IBUGG3,IERROR)
      CALL BIWMDV(TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH2,
     1IBUGG3,IERROR)
      CALL BIWMCV(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH3,
     1IBUGG3,IERROR)
      RIGH4=RIGH1*RIGH2
      IF(RIGH4.GT.0.0)THEN
        RIGHT=RIGH3/SQRT(RIGH4)
      ELSE
        RIGHT=0.0
      ENDIF
      GOTO79000
C
12172 CONTINUE
      CALL COMDIG(TEMP,NS2,IWRITE,RIGHT,NRIGH,IBUGG3,IERROR)
      GOTO79000
C
12174 CONTINUE
      CALL COMDIG(TEMP,NS2,IWRITE,RIGHT,NRIGH,IBUGG3,IERROR)
      RIGHT=REAL(NRIGH)
      GOTO79000
C
12176 CONTINUE
      RIGHT=SN(TEMP,NS2,XTEMP1,XTEMP2,XTEMP3)
      GOTO79000
C
12178 CONTINUE
      RIGHT=QN(TEMP,NS2,XTEMP1,XTEMP2,XTEMP3,
     1        ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6)
      GOTO79000
C
12180 CONTINUE
      CALL MEAN(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL MEAN(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12182 CONTINUE
      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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
      ELSE
        ALPHA=0.95
      ENDIF
C
      CALL HEDGEG(TEMP,TEMPZ,NS2,NSZ,IWRITE,STATVA,STATBC,STATSE,
     1            ALPHA,ALCL,AUCL,
     1            YMEAN1,YSD1,YMEAN2,YSD2,SPOOL,
     1            ICASPL,ISUBRO,IBUGG3,IERROR)
      RIGHT=STATVA
      IF(ICASPL.EQ.'BCHG')THEN
        RIGHT=STATBC
      ELSEIF(ICASPL.EQ.'BCHG')THEN
        RIGHT=STATBC
      ELSEIF(ICASPL.EQ.'HESE')THEN
        RIGHT=STATSE
      ELSEIF(ICASPL.EQ.'HELC')THEN
        RIGHT=ALCL
      ELSEIF(ICASPL.EQ.'HEUC')THEN
        RIGHT=AUCL
      ENDIF
      GOTO79000
C
12190 CONTINUE
      CALL MIDMEA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL MIDMEA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12200 CONTINUE
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL MEDIAN(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12210 CONTINUE
      CALL TRIMME(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,RIGH1,
     1            IBUGG3,ISUBRO,IERROR)
      CALL TRIMME(TEMPZ,NSZ,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,RIGH2,
     1            IBUGG3,ISUBRO,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12220 CONTINUE
      CALL WINDME(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,RIGH1,
     1            IBUGG3,ISUBRO,IERROR)
      CALL WINDME(TEMPZ,NSZ,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,RIGH2,
     1            IBUGG3,ISUBRO,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12230 CONTINUE
      CALL GEOMEA(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL GEOMEA(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12240 CONTINUE
      CALL HARMEA(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL HARMEA(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12250 CONTINUE
      DO12252I=1,NS2
        ITEMP1(I)=0
        ITEMP2(I)=0
        ITEMP3(I)=0
12252 CONTINUE
      CALL HLQEST(TEMP,NS2,XTEMP1,ITEMP1,ITEMP2,ITEMP3,ISEED,RIGH1)
      DO12254I=1,NSZ
        ITEMP1(I)=0
        ITEMP2(I)=0
        ITEMP3(I)=0
12254 CONTINUE
      CALL HLQEST(TEMPZ,NSZ,XTEMP1,ITEMP1,ITEMP2,ITEMP3,ISEED,RIGH2)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12260 CONTINUE
      CALL BIWLOC(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH1,
     1IBUGG3,IERROR)
      CALL BIWLOC(TEMPZ,NSZ,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH2,
     1IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12270 CONTINUE
      CALL SD(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL SD(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12275 CONTINUE
      CALL RMS(TEMP,NS2,IWRITE,RIGH1,IBUGG3,ISUBRO,IERROR)
      CALL RMS(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,ISUBRO,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12280 CONTINUE
      CALL VAR(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL VAR(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12282 CONTINUE
      CALL VAR(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL VAR(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      IF(RIGH1.GT.0.0)THEN
        RIGH1=1.0/RIGH1
      ELSE
        RIGH1=0.0
        IERROR='YES'
      ENDIF
      IF(RIGH2.GT.0.0)THEN
        RIGH2=1.0/RIGH2
      ELSE
        RIGH2=0.0
        IERROR='YES'
      ENDIF
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12284 CONTINUE
      CALL SD(TEMP,NS2,IWRITE,RIGHTV,IBUGG3,IERROR)
      CALL MEAN(TEMP,NS2,IWRITE,RIGHTM,IBUGG3,IERROR)
      RIGH1=0.0
      IF(RIGHTV.NE.0.0)RIGH1=RIGHTM/RIGHTV
      CALL SD(TEMPZ,NSZ,IWRITE,RIGHTV,IBUGG3,IERROR)
      CALL MEAN(TEMPZ,NSZ,IWRITE,RIGHTM,IBUGG3,IERROR)
      RIGH2=0.0
      IF(RIGHTV.NE.0.0)RIGH2=RIGHTM/RIGHTV
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12290 CONTINUE
      ICASE2='MEAN'
      CALL AAD(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,ICASE2,IBUGG3,IERROR)
      CALL AAD(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,ICASE2,
     1         IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12295 CONTINUE
      ICASE2='MEDI'
      CALL AAD(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,ICASE2,IBUGG3,IERROR)
      CALL AAD(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,ICASE2,
     1         IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12300 CONTINUE
      CALL MAD(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH1,
     1         IBUGG3,IERROR)
      IF(ICASPL.EQ.'DMAN')RIGH1=RIGH1/0.67449
      CALL MAD(TEMPZ,NSZ,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH2,
     1         IBUGG3,IERROR)
      IF(ICASPL.EQ.'DMAN')RIGH2=RIGH2/0.67449
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12310 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH3,IBUGG3,IERROR)
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH4,IBUGG3,IERROR)
      RIGH1=RIGH4-RIGH3
      IF(ICASPL.EQ.'DNIQ')RIGH1=0.7413*(RIGH4-RIGH3)
      CALL LOWQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH5,IBUGG3,IERROR)
      CALL UPPQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH6,IBUGG3,IERROR)
      RIGH2=RIGH6-RIGH5
      IF(ICASPL.EQ.'DNIQ')RIGH2=0.7413*(RIGH6-RIGH5)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12320 CONTINUE
      CALL WINSOR(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,XTEMP2,
     1            IBUGG3,ISUBRO,IERROR)
      CALL SD(XTEMP2,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL WINSOR(TEMPZ,NSZ,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,XTEMP2,
     1            IBUGG3,ISUBRO,IERROR)
      CALL SD(XTEMP2,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12330 CONTINUE
      CALL WINSOR(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,XTEMP2,
     1            IBUGG3,ISUBRO,IERROR)
      CALL VAR(XTEMP2,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL WINSOR(TEMPZ,NSZ,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
     1            XTEMP1,MAXNXT,XTEMP2,
     1            IBUGG3,ISUBRO,IERROR)
      CALL VAR(XTEMP2,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12340 CONTINUE
      CALL BIWMDV(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH1,
     1IBUGG3,IERROR)
      CALL BIWMDV(TEMPZ,NSZ,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH2,
     1IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12350 CONTINUE
      CALL BIWSCA(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH1,
     1IBUGG3,IERROR)
      CALL BIWSCA(TEMPZ,NSZ,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGH2,
     1IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12360 CONTINUE
      CALL PBNMDV(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,BETA,
     1            IBUGG3,IERROR)
      CALL PBNMDV(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,BETA,
     1            IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12370 CONTINUE
      CALL GEOSD(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL GEOSD(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12380 CONTINUE
      CALL RANGDP(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL RANGDP(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12390 CONTINUE
      CALL MIDRAN(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL MIDRAN(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12400 CONTINUE
C
      IF(APVAL.GE.0.0 .AND. APVAL.LE.1.0)THEN
        XQ=APVAL
      ELSEIF(IPNAM1.NE.'    ')THEN
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IPNAM1,IPNAM2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        XQ=VALUE(ILOCP)
      ELSE
        IHP='XQ  '
        IHP2='    '
        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
        XQ=VALUE(ILOCP)
      ENDIF
C
      CALL QUANSE(XQ,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,
     1IQUASE,
     1RIGH1,IBUGG3,IERROR)
      CALL QUANSE(XQ,TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,
     1IQUASE,
     1RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12405 CONTINUE
C
      IF(APVAL.GE.0.0 .AND. APVAL.LE.1.0)THEN
        XQ=APVAL
      ELSEIF(IPNAM1.NE.'    ')THEN
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IPNAM1,IPNAM2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        XQ=VALUE(ILOCP)
      ELSE
        IHP='XQ  '
        IHP2='    '
        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
        XQ=VALUE(ILOCP)
      ENDIF
C
      CALL QUANT(XQ,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,
     1IQUAME,
     1RIGH1,IBUGG3,IERROR)
      CALL QUANT(XQ,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,
     1IQUAME,
     1RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12410 CONTINUE
      CALL STMOM3(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL STMOM3(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12412 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,Q1,IBUGG3,IERROR)
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,Q3,IBUGG3,IERROR)
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,Q2,IBUGG3,IERROR)
      IF(Q1.NE.Q3)THEN
        RIGH1=(Q3 + Q1 - 2.0*Q2)/(Q3 - Q1)
      ELSE
        RIGH1=CPUMIN
      ENDIF
C
      CALL LOWQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,Q1,IBUGG3,IERROR)
      CALL UPPQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,Q3,IBUGG3,IERROR)
      CALL MEDIAN(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,Q2,IBUGG3,IERROR)
      IF(Q1.NE.Q3)THEN
        RIGH2=(Q3 + Q1 - 2.0*Q2)/(Q3 - Q1)
      ELSE
        RIGH2=CPUMIN
      ENDIF
C
      IF(RIGH1.EQ.CPUMIN .OR. RIGH2.EQ.CPUMIN)THEN
        RIGHT=CPUMIN
      ELSE
        RIGHT=RIGH1-RIGH2
      ENDIF
      GOTO79000
C
12414 CONTINUE
      CALL MEAN(TEMP,NS2,IWRITE,YMEAN,IBUGG3,IERROR)
      CALL SD(TEMP,NS2,IWRITE,YSD,IBUGG3,IERROR)
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,YMED,IBUGG3,IERROR)
      IF(YSD.GT.0.0)THEN
        RIGHT=3.0*(YMEAN-YMED)/YSD
      ELSE
        RIGHT=CPUMIN
      ENDIF
C
      CALL MEAN(TEMPZ,NSZ,IWRITE,YMEAN,IBUGG3,IERROR)
      CALL SD(TEMPZ,NSZ,IWRITE,YSD,IBUGG3,IERROR)
      CALL MEDIAN(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,YMED,IBUGG3,IERROR)
      IF(YSD.GT.0.0)THEN
        RIGH2=3.0*(YMEAN-YMED)/YSD
      ELSE
        RIGH2=CPUMIN
      ENDIF
C
      IF(RIGH1.EQ.CPUMIN .OR. RIGH2.EQ.CPUMIN)THEN
        RIGHT=CPUMIN
      ELSE
        RIGHT=RIGH1-RIGH2
      ENDIF
      GOTO79000
C
12420 CONTINUE
      CALL STMOM4(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL STMOM4(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12425 CONTINUE
      CALL STMOM4(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      RIGH1=RIGH1-3.0
      CALL STMOM4(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGH2=RIGH2-3.0
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12430 CONTINUE
      CALL RELSD(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL RELSD(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12440 CONTINUE
      CALL SDMEAN(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL SDMEAN(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12450 CONTINUE
      CALL MEAN(TEMP,NS2,IWRITE,RIGHTM,IBUGG3,IERROR)
      CALL VAR(TEMP,NS2,IWRITE,RIGHTV,IBUGG3,IERROR)
      RIGH1=0.0
      IF(RIGHTM.NE.0.0)RIGH1=100.0*RIGHTV/ABS(RIGHTM)
      CALL MEAN(TEMPZ,NSZ,IWRITE,RIGHTM,IBUGG3,IERROR)
      CALL VAR(TEMPZ,NSZ,IWRITE,RIGHTV,IBUGG3,IERROR)
      RIGH2=0.0
      IF(RIGHTM.NE.0.0)RIGH2=100.0*RIGHTV/ABS(RIGHTM)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12460 CONTINUE
      CALL SDMEAN(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      RIGH1=RIGH1**2
      CALL SDMEAN(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGH2=RIGH2**2
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12470 CONTINUE
      CALL MINIM(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL MINIM(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12480 CONTINUE
      CALL MAXIM(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL MAXIM(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12490 CONTINUE
      CALL MINIM(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL MAXIM(TEMP,NS2,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGH1=ABS(RIGH1)
      RIGH2=ABS(RIGH2)
      RIGH3=RIGH1
      IF(RIGH2.GT.RIGH1)RIGH3=RIGH2
C
      CALL MINIM(TEMPZ,NSZ,IWRITE,RIGH4,IBUGG3,IERROR)
      CALL MAXIM(TEMPZ,NSZ,IWRITE,RIGH5,IBUGG3,IERROR)
      RIGH4=ABS(RIGH4)
      RIGH5=ABS(RIGH5)
      RIGH6=RIGH4
      IF(RIGH5.GT.RIGH4)RIGH6=RIGH5
      RIGHT=RIGH3-RIGH6
      GOTO79000
C
12495 CONTINUE
      CALL SD(TEMP,NS2,IWRITE,RIGHTV,IBUGG3,IERROR)
      CALL MEAN(TEMP,NS2,IWRITE,RIGHTM,IBUGG3,IERROR)
      RIGH1=0.0
      IF(RIGHTM.NE.0.0)RIGH1=RIGHTV/RIGHTM
      CALL SD(TEMPZ,NSZ,IWRITE,RIGHTV,IBUGG3,IERROR)
      CALL MEAN(TEMPZ,NSZ,IWRITE,RIGHTM,IBUGG3,IERROR)
      RIGH2=0.0
      IF(RIGHTM.NE.0.0)RIGH2=RIGHTV/RIGHTM
      RIGHT=RIGH1-RIGH2
      GOTO79000
12500 CONTINUE
      CALL SIZE(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL SIZE(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12510 CONTINUE
      CALL SUMDP(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL SUMDP(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12512 CONTINUE
      CALL PROD(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL PROD(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12520 CONTINUE
      RIGH1=SN(TEMP,NS2,XTEMP1,XTEMP2,XTEMP3)
      RIGH2=SN(TEMPZ,NSZ,XTEMP1,XTEMP2,XTEMP3)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12530 CONTINUE
      RIGH1=QN(TEMP,NS2,XTEMP1,XTEMP2,XTEMP3,
     1         ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6)
      RIGH2=QN(TEMPZ,NSZ,XTEMP1,XTEMP2,XTEMP3,
     1         ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12540 CONTINUE
      CALL LPLOC(TEMP,NS2,P,IWRITE,XTEMP1,DTEMP1,MAXNXT,RIGH1,
     1           IBUGG3,IERROR)
      CALL LPLOC(TEMPZ,NSZ,P,IWRITE,XTEMP1,DTEMP1,MAXNXT,RIGH2,
     1           IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12550 CONTINUE
      CALL LPVARI(TEMP,NS2,P,IWRITE,XTEMP1,DTEMP1,MAXNXT,RIGH1,
     1           IQUASE,IBUGG3,IERROR)
      CALL LPVARI(TEMPZ,NSZ,P,IWRITE,XTEMP1,DTEMP1,MAXNXT,RIGH2,
     1           IQUASE,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12560 CONTINUE
      CALL LPVARI(TEMP,NS2,P,IWRITE,XTEMP1,DTEMP1,MAXNXT,RIGH1,
     1           IQUASE,IBUGG3,IERROR)
      RIGH1=SQRT(RIGH1)
      CALL LPVARI(TEMPZ,NSZ,P,IWRITE,XTEMP1,DTEMP1,MAXNXT,RIGH2,
     1           IQUASE,IBUGG3,IERROR)
      RIGH2=SQRT(RIGH2)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12570 CONTINUE
      IHP='ALPH'
      IHP2='A   '
      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
        ALPHA=0.05
      ELSE
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.GT.1.0 .AND. ALPHA.LT.100.0)THEN
          ALPHA=ALPHA/100.0
        ELSEIF(ALPHA.GT.0.0 .AND. ALPHA.LT.1.0)THEN
          CONTINUE
        ELSE
          ALPHA=0.05
        ENDIF
      ENDIF
C
      CALL DPPRC4(TEMP,NS2,TEMPZ,NSZ,ALPHA,PSTAMV,IBI2ME,XTEMP1,
     1            YDIFF,ALOWLM,AUPPLM,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=YDIFF
      IF(ICASPL.EQ.'DBLC')RIGHT=ALOWLM
      IF(ICASPL.EQ.'DBUC')RIGHT=AUPPLM
      GOTO79000
C
12590 CONTINUE
      CALL TRIMSD(TEMP,NS2,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,MAXNXT,
     1            XTEMP1,RIGH1,
     1            IBUGG3,ISUBRO,IERROR)
      CALL TRIMSD(TEMPZ,NSZ,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,MAXNXT,
     1            XTEMP1,RIGH2,
     1            IBUGG3,ISUBRO,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12600 CONTINUE
      IF(ICASPL.EQ.'MIDQ')P100=50.0
      IF(ICASPL.EQ.'1DEC')P100=10.0
      IF(ICASPL.EQ.'2DEC')P100=20.0
      IF(ICASPL.EQ.'3DEC')P100=30.0
      IF(ICASPL.EQ.'4DEC')P100=40.0
      IF(ICASPL.EQ.'5DEC')P100=50.0
      IF(ICASPL.EQ.'6DEC')P100=60.0
      IF(ICASPL.EQ.'7DEC')P100=70.0
      IF(ICASPL.EQ.'8DEC')P100=80.0
      IF(ICASPL.EQ.'9DEC')P100=90.0
      CALL PERCEN(P100,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,
     1RIGH1,IBUGG3,IERROR)
      CALL PERCEN(P100,TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,
     1RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12610 CONTINUE
      CALL LOWHIN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL LOWHIN(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
12620 CONTINUE
      CALL UPPHIN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL UPPHIN(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
12630 CONTINUE
      CALL LOWQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL LOWQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
12640 CONTINUE
      CALL UPPQUA(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL UPPQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12650 CONTINUE
      NCUT=0
      C=1.0
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH1=AH15
      CALL H15(TEMPZ,NSZ,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH2=AH15
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12660 CONTINUE
      NCUT=0
      C=1.2
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP1,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH1=AH15
      CALL H15(TEMPZ,NSZ,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH2=AH15
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12670 CONTINUE
      NCUT=0
      C=1.5
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH1=AH15
      CALL H15(TEMPZ,NSZ,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH2=AH15
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12680 CONTINUE
      NCUT=0
      C=1.7
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH1=AH15
      CALL H15(TEMPZ,NSZ,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH2=AH15
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12690 CONTINUE
      NCUT=0
      C=2.0
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH1=AH15
      CALL H15(TEMPZ,NSZ,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH2=AH15
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12700 CONTINUE
      NCUT=0
      C=1.0
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH1=XSC
      CALL H15(TEMPZ,NSZ,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH2=XSC
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12710 CONTINUE
      NCUT=0
      C=1.2
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH1=XSC
      CALL H15(TEMPZ,NSZ,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH2=XSC
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12720 CONTINUE
      NCUT=0
      C=1.5
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH1=XSC
      CALL H15(TEMPZ,NSZ,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH2=XSC
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12730 CONTINUE
      NCUT=0
      C=1.7
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH1=XSC
      CALL H15(TEMPZ,NSZ,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH2=XSC
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12740 CONTINUE
      NCUT=0
      C=2.0
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH1=XSC
      CALL H15(TEMPZ,NSZ,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGH2=XSC
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12750 CONTINUE
C
      IHP='NREP'
      IHP2='L   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      NREPL=INT(VALUE(ILOCP)+0.5)
C
      ICASE='SD'
      CALL ROBPSD(TEMP,NS2,NREPL,XTEMP1,ICASE,IWRITE,MAXNXT,
     1            RIGHT,IERROR,ISUBRO,IBUGG3)
      GOTO79000
C
12760 CONTINUE
      NREPL=1
      ICASE='RANG'
      CALL ROBPSD(TEMP,NS2,NREPL,XTEMP1,ICASE,IWRITE,MAXNXT,
     1            RIGHT,IERROR,ISUBRO,IBUGG3)
      GOTO79000
C
31720 CONTINUE
      CALL LPLOC(TEMP,NS2,P,IWRITE,XTEMP1,DTEMP1,MAXNXT,RIGHT,
     1           IBUGG3,IERROR)
      GOTO79000
C
31730 CONTINUE
      CALL LPVARI(TEMP,NS2,P,IWRITE,XTEMP1,DTEMP1,MAXNXT,RIGHT,
     1           IQUASE,IBUGG3,IERROR)
      GOTO79000
C
31740 CONTINUE
      CALL LPVARI(TEMP,NS2,P,IWRITE,XTEMP1,DTEMP1,MAXNXT,RIGHT,
     1           IQUASE,IBUGG3,IERROR)
      RIGHT=SQRT(RIGHT)
      GOTO79000
C
31750 CONTINUE
      IHP='ALPH'
      IHP2='A   '
      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
        ALPHA=0.05
      ELSE
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.GT.1.0 .AND. ALPHA.LT.100.0)THEN
          ALPHA=ALPHA/100.0
        ELSEIF(ALPHA.GT.0.0 .AND. ALPHA.LT.1.0)THEN
          CONTINUE
        ELSE
          ALPHA=0.05
        ENDIF
      ENDIF
C
      CALL DPPRC3(TEMP,NS2,ALPHA,PSTAMV,IBINME,XTEMP1,
     1            RIGHT,ALOWLM,AUPPLM,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'BPLC')RIGHT=ALOWLM
      IF(ICASPL.EQ.'BPUC')RIGHT=AUPPLM
      GOTO79000
C
31760 CONTINUE
      CALL MININD(TEMP,NS2,IWRITE,PSTAMV,RIGHT,ISUBRO,IBUGG3,IERROR)
      GOTO79000
C
31770 CONTINUE
      CALL MAXIND(TEMP,NS2,IWRITE,PSTAMV,RIGHT,ISUBRO,IBUGG3,IERROR)
      GOTO79000
C
31780 CONTINUE
      CALL EXTIND(TEMP,NS2,IWRITE,PSTAMV,RIGHT,ISUBRO,IBUGG3,IERROR)
      GOTO79000
C
31790 CONTINUE
      CALL DPGRU3(TEMP,NS2,IWRITE,PSTAMV,XGRUB,XCDF,XDIR,XIND,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=XGRUB
      GOTO79000
C
31795 CONTINUE
      CALL DPGRU3(TEMP,NS2,IWRITE,PSTAMV,XGRUB,XCDF,XDIR,XIND,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=XCDF
      GOTO79000
C
31810 CONTINUE
      CALL DPGRU3(TEMP,NS2,IWRITE,PSTAMV,XGRUB,XCDF,XDIR,XIND,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=XDIR
      GOTO79000
C
31820 CONTINUE
      CALL DPGRU3(TEMP,NS2,IWRITE,PSTAMV,XGRUB,XCDF,XDIR,XIND,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=XIND
      GOTO79000
C
31825 CONTINUE
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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
      ELSE
        ALPHA=0.95
      ENDIF
C
      ALPHAT(1)=ALPHA
      NALPHA=1
      IDAVT2=IDAVTA
      IF(ICASPL.EQ.'DCDF' .OR. ICASPL.EQ.'DPVA')IDAVTA='SIMU'
C
      CALL DPDAV3(TEMP,NS2,XTEMP1,XTEMP2,IWRITE,PSTAMV,
     1            MAXNXT,IDAVTA,ISEED,
     1            ALPHAT,CV,NALPHA,
     1            STATVA,XMEAN,XSD,XRANGE,
     1            PVAL,CDF,XINDMN,XINDMX,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'DAVI')RIGHT=STATVA
      IF(ICASPL.EQ.'DCDF')RIGHT=CDF
      IF(ICASPL.EQ.'DPVA')RIGHT=PVAL
      IF(ICASPL.EQ.'DMNI')RIGHT=XINDMN
      IF(ICASPL.EQ.'DMXI')RIGHT=XINDMX
      IF(ICASPL.EQ.'DACV')RIGHT=CV(1)
      IDAVTA=IDAVT2
      GOTO79000
C
31828 CONTINUE
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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
      ELSE
        ALPHA=0.95
      ENDIF
C
      ALPHAT(1)=ALPHA
      NALPHA=1
      ISKOT2=ISKOTA
      IF(ICASPL.EQ.'SKCD' .OR. ICASPL.EQ.'SKPV')ISKOTA='SIMU'
C
      CALL DPSKO3(TEMP,NS2,XTEMP1,XTEMP2,IWRITE,PSTAMV,
     1            MAXNXT,ISKOTA,ISEED,
     1            ALPHAT,CV,NALPHA,
     1            STATVA,XMEAN,XSD,XMIN,XMAX,XSKEW,
     1            PVAL,STATCD,XINDX,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'SOUT')RIGHT=STATVA
      IF(ICASPL.EQ.'SOCD')RIGHT=STATCD
      IF(ICASPL.EQ.'SOPV')RIGHT=PVAL
      IF(ICASPL.EQ.'SOIN')RIGHT=XINDX
      IF(ICASPL.EQ.'SOCV')RIGHT=CV(1)
      ISKOTA=ISKOT2
      GOTO79000
C
31829 CONTINUE
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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
      ELSE
        ALPHA=0.95
      ENDIF
C
      ALPHAT(1)=ALPHA
      NALPHA=1
      IKUOT2=IKUOTA
      IF(ICASPL.EQ.'KOCD' .OR. ICASPL.EQ.'KOPV')IKUOTA='SIMU'
C
      CALL DPKUO3(TEMP,NS2,XTEMP1,XTEMP2,IWRITE,PSTAMV,
     1            MAXNXT,IKUOTA,ISEED,
     1            ALPHAT,CV,NALPHA,
     1            STATVA,XMEAN,XSD,XMIN,XMAX,XKURT,
     1            PVAL,STATCD,XINDX,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'KOUT')RIGHT=STATVA
      IF(ICASPL.EQ.'KOCD')RIGHT=STATCD
      IF(ICASPL.EQ.'KOPV')RIGHT=PVAL
      IF(ICASPL.EQ.'KOIN')RIGHT=XINDX
      IF(ICASPL.EQ.'KOCV')RIGHT=CV(1)
      IKUOTA=IKUOT2
      GOTO79000
C
31830 CONTINUE
      IHP='MU  '
      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
        AMU=0.0
      ELSE
        AMU=VALUE(ILOCP)
      ENDIF
C
      CALL DPTTE3(TEMP,NS2,AMU,IWRITE,STATVA,STATCD,STATNU,
     1            XMEAN,XSD,XSDM,DEL,
     1            PVAL2T,PVALLT,PVALUT,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'1TTE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'1TCD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'1T2P')THEN
        RIGHT=PVAL2T
      ELSEIF(ICASPL.EQ.'1TLP')THEN
        RIGHT=PVALLT
      ELSEIF(ICASPL.EQ.'1TUP')THEN
        RIGHT=PVALUT
      ENDIF
      GOTO79000
C
31840 CONTINUE
      CALL DPTTE4(TEMP,NS2,TEMPZ,NSZ,IWRITE,
     1            STATVA,STATCD,STATNU,
     1            STATV2,STATC2,STATN2,
     1            Y1MEAN,Y1SD,Y1SDM,
     1            Y2MEAN,Y2SD,Y2SDM,
     1            DEL,POOLSD,DELSD,DELSD2,CDFBAR,
     1            PVAL2T,PVALLT,PVALUT,
     1            ISUBRO,IBUGG3,IERROR)
C
C     FOR NOW, JUST RETURN THE "UNEQUAL VARIANCES" CASE.  MAY
C     ADD "EQUAL VARIANCES" CASE LATER (NEED TO ADD "ITTEVA"
C     TO THE CALL LIST.
C
      IF(ICASPL.EQ.'2TTE')THEN
        RIGHT=STATV2
      ELSEIF(ICASPL.EQ.'2TCD')THEN
        RIGHT=STATC2
      ELSEIF(ICASPL.EQ.'2T2P')THEN
        RIGHT=PVAL2T
      ELSEIF(ICASPL.EQ.'2TLP')THEN
        RIGHT=PVALLT
      ELSEIF(ICASPL.EQ.'2TUP')THEN
        RIGHT=PVALUT
      ENDIF
      GOTO79000
C
31845 CONTINUE
      CALL DPTTE6(TEMP,NS2,TEMPZ,NSZ,XTEMP1,IWRITE,
     1            STATVA,STATCD,STATNU,
     1            Y1MEAN,Y1SD,Y1SDM,
     1            Y2MEAN,Y2SD,Y2SDM,
     1            YDMEAN,YDSD,YDSDM,
     1            PVAL2T,PVALLT,PVALUT,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'PTTE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'PTCD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'PT2P')THEN
        RIGHT=PVAL2T
      ELSEIF(ICASPL.EQ.'PTLP')THEN
        RIGHT=PVALLT
      ELSEIF(ICASPL.EQ.'PTUP')THEN
        RIGHT=PVALUT
      ENDIF
      GOTO79000
C
31850 CONTINUE
      IHP='SIGM'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      SIGMA0=VALUE(ILOCP)
C
      CALL DPCST3(TEMP,NS2,SIGMA0,IWRITE,
     1            STATVA,STATCD,STATNU,
     1            YMEAN,YSD,RATIO,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'CSSD')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'CCDF')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'CSLP')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'CSUP')THEN
        RIGHT=1.0 - STATCD
      ELSEIF(ICASPL.EQ.'CS2P')THEN
        IF(YSD.LE.SIGMA0)THEN
          RIGHT=2.0*STATCD
        ELSE
          RIGHT=2.0*(1.0 - STATCD)
        ENDIF
      ENDIF
      GOTO79000
C
31870 CONTINUE
      CALL DPFRT3(TEMP,NS2,IWRITE,XTEMP1,STATVA,STATCD,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=STATVA
      GOTO79000
C
31880 CONTINUE
      CALL DPFRT3(TEMP,NS2,IWRITE,XTEMP1,STATVA,STATCD,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=STATCD
      GOTO79000
C
31905 CONTINUE
C
      IHP='ALPH'
      IHP2='A   '
      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
        ALPHA=0.95
      ELSE
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.GT.1.0 .AND. ALPHA.LT.100.0)THEN
          ALPHA=ALPHA/100.0
        ELSEIF(ALPHA.GT.0.0 .AND. ALPHA.LT.1.0)THEN
          CONTINUE
        ELSE
          ALPHA=0.95
        ENDIF
      ENDIF
      CALL DPMSD3(TEMP,NS2,IWRITE,ALPHA,
     1            STATVA,STATV2,STATCD,PVAL,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=STATVA
      IF(ICASPL.EQ.'MSDN')RIGHT=STATV2
      IF(ICASPL.EQ.'MSDC')RIGHT=STATCD
      IF(ICASPL.EQ.'MSDP')RIGHT=PVAL
      IF(ICASPL.EQ.'ADCD')RIGHT=STATCD
      IF(ICASPL.EQ.'ADPV')RIGHT=PVAL
CCCCC IF(ICASPL.EQ.'AD01')GOTO31905
CCCCC IF(ICASPL.EQ.'AD05')GOTO31905
CCCCC IF(ICASPL.EQ.'AD95')GOTO31905
CCCCC IF(ICASPL.EQ.'AD99')GOTO31905
      GOTO79000
C
31890 CONTINUE
      IHP='M   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AM=VALUE(ILOCP)
      M=INT(AM+0.5)
C
      CALL DPFRT4(TEMP,NS2,M,IWRITE,XTEMP1,STATVA,STATCD,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=STATVA
      GOTO79000
C
31900 CONTINUE
      IHP='M   '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AM=VALUE(ILOCP)
      M=INT(AM+0.5)
C
      CALL DPFRT4(TEMP,NS2,M,IWRITE,XTEMP1,STATVA,STATCD,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=STATCD
      GOTO79000
C
31910 CONTINUE
      NCUT=0
      C=1.0
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGHT=AH15
      GOTO79000
C
31920 CONTINUE
      NCUT=0
      C=1.2
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGHT=AH15
      GOTO79000
C
31930 CONTINUE
      NCUT=0
      C=1.5
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGHT=AH15
      GOTO79000
C
31940 CONTINUE
      NCUT=0
      C=1.7
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGHT=AH15
      GOTO79000
C
31950 CONTINUE
      NCUT=0
      C=2.0
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGHT=AH15
      GOTO79000
C
31960 CONTINUE
      NCUT=0
      C=1.0
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGHT=XSC
      GOTO79000
C
31970 CONTINUE
      NCUT=0
      C=1.2
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP1,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGHT=XSC
      GOTO79000
C
31980 CONTINUE
      NCUT=0
      C=1.5
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGHT=XSC
      GOTO79000
C
31990 CONTINUE
      NCUT=0
      C=1.7
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGHT=XSC
      GOTO79000
C
32000 CONTINUE
      NCUT=0
      C=2.0
      CALL H15(TEMP,NS2,C,NCUT,AH15,XSC,XTEMP1,XTEMP2,MAXNXT,
     1         ISUBRO,IBUGG3)
      RIGHT=XSC
      GOTO79000
C
32010 CONTINUE
C
      IHP='NOUT'
      IHP2='LIER'
      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
        IR=1
      ELSE
        AVAL=VALUE(ILOCP)
        IR=INT(AVAL+0.1)
        IF(IR.LT.1)IR=1
        IF(IR.GT.NS2/2)IR=NS2/2
      ENDIF
C
      IF(ICASPL.EQ.'TM2S')THEN
        ICASAN='TWOS'
      ELSEIF(ICASPL.EQ.'TMMN')THEN
        ICASAN='MINI'
      ELSEIF(ICASPL.EQ.'TMMX')THEN
        ICASAN='MAXI'
      ENDIF
C
      CALL DPTIE3(TEMP,NS2,ICASAN,IR,
     1            XTEMP1,XTEMP2,XTEMP3,ITEMP1,ITEMP2,
     1            RIGHT,YMEAN,YSD,YMIN,YMAX,
     1            ISUBRO,IBUGG3,IERROR)
      GOTO79000
C
32020 CONTINUE
C
      IHP='NOUT'
      IHP2='LIER'
      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
        IR=1
      ELSE
        AVAL=VALUE(ILOCP)
        IR=INT(AVAL+0.1)
        IF(IR.LT.1)IR=1
        IF(IR.GT.NS2/2)IR=NS2/2
      ENDIF
C
      CALL DPGES3(TEMP,NS2,IR,
     1            XTEMP1,XTEMP2,ITEMP1,ITEMP2,
     1            RIGHT,
     1            ISUBRO,IBUGG3,IERROR)
      GOTO79000
C
 3185 CONTINUE
C
      IF(NUMV2.EQ.1)THEN
        YMEAN=CPUMIN
        YSD=CPUMIN
        IF(ICASPL.EQ.'SCVA')THEN
          CALL MEAN(TEMP,NS2,IWRITE,YMEAN,IBUGG3,IERROR)
          CALL SD(TEMP,NS2,IWRITE,YSD,IBUGG3,IERROR)
          IF(YMEAN.NE.0.0)THEN
            RIGHT=YSD/YMEAN
          ELSE
            RIGHT=CPUMAX
          ENDIF
          GOTO79000
        ENDIF
      ELSE
        YMEAN=TEMP(1)
        YSD=TEMPZ(1)
        IF(ICASPL.EQ.'SCVA')THEN
          IF(YMEAN.NE.0.0)THEN
            RIGHT=YSD/YMEAN
          ELSE
            RIGHT=CPUMAX
          ENDIF
          GOTO79000
        ENDIF
        NS2=INT(TEMPZ3(1)+0.1)
      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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.GT.1.0 .AND. ALPHA.LT.100.0)THEN
          ALPHA=ALPHA/100.0
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSEIF(ALPHA.GT.0.0 .AND. ALPHA.LT.1.0)THEN
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSE
          ALPHA=0.95
        ENDIF
      ELSE
        ALPHA=0.95
      ENDIF
C
      ICASA2='CVLI'
      ICASA3='UPPE'
      ICASA4='RAW'
      ICASA5='TWOS'
C
      IF(ICASPL(1:1).EQ.'S')ICASA4='SUMM'
C
      IF(ICASPL.EQ.'CVLC')ICASA3='LOWE'
      IF(ICASPL.EQ.'CVLO')ICASA3='LOWE'
      IF(ICASPL.EQ.'CVUC')ICASA3='UPPE'
      IF(ICASPL.EQ.'CVUO')ICASA3='UPPE'
      IF(ICASPL.EQ.'SCVL')ICASA3='LOWE'
      IF(ICASPL.EQ.'SCVU')ICASA3='UPPE'
C
      IF(ICASPL.EQ.'CVLO')ICASA5='ONES'
      IF(ICASPL.EQ.'CVUO')ICASA5='ONES'
C
      IDIST2='NORM'
      IF(ICASPL.EQ.'LLCV')IDIST2='LOGN'
      IF(ICASPL.EQ.'LLCV')ICASA3='LOWE'
      IF(ICASPL.EQ.'ULCV')IDIST2='LOGN'
      IF(ICASPL.EQ.'LCVA')IDIST2='LOGN'
C
      ALPHAT(1)=ALPHA
      NALPHA=1
      CALL DPCVC3(TEMP,NS2,YMEAN,YSD,
     1            ICASA2,ICASA3,ICASA4,ICASA5,
     1            ISEED,MAXNXT,IDIST2,
     1            XTEMP1,XTEMP2,
     1            ICVACI,ALPHAT,NALPHA,ALOWLV,AUPPLV,CVAR,
     1            ISUBRO,IBUGG3,IERROR)
C
      IF(ICASPL.EQ.'CVLC')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'CVLO')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'SCVL')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'CVUC')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'CVUO')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'SCVU')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'LCVA')RIGHT=CVAR
      IF(ICASPL.EQ.'LLCV')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'ULCV')RIGHT=AUPPLV(1)
C
      GOTO79000
C
 3195 CONTINUE
C
      IF(NUMV2.EQ.2)THEN
        ICASA4='RAW'
        DO3196II=1,NS2
          ITEMP1(II)=0
 3196   CONTINUE
      ELSEIF(NUMV2.EQ.3)THEN
        ICASA4='SUMM'
        DO3197II=1,NS2
          ITEMP1(II)=INT(TEMPZ3(II)+0.1)
 3197   CONTINUE
      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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.GT.1.0 .AND. ALPHA.LT.100.0)THEN
          ALPHA=ALPHA/100.0
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSEIF(ALPHA.GT.0.0 .AND. ALPHA.LT.1.0)THEN
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSE
          ALPHA=0.95
        ENDIF
      ELSE
        ALPHA=0.95
      ENDIF
C
      ICASA2='CVLI'
      ICASA3='UPPE'
      ICASA5='TWOS'
      ALPHAT(1)=ALPHA
      NALPHA=1
C
      CALL DPCVC4(TEMP,TEMPZ,NS2,ITEMP1,XTEMP1,XTEMP2,
     1            ICASA2,ICASA3,ICASA4,ICASA5,
     1            ALPHAT,NALPHA,ALOWLV,AUPPLV,
     1            AVAL1,AVAL2,NDIST,NGROUP,
     1            ISUBRO,IBUGG3,IERROR)
C
      IF(ICASPL.EQ.'CCVA')RIGHT=AVAL1
      IF(ICASPL.EQ.'UCCV')RIGHT=AVAL2
      IF(ICASPL.EQ.'LCCV')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'UCC2')RIGHT=AUPPLV(1)
C
      GOTO79000
32030 CONTINUE
C
      IF(ICASPL.EQ.'DI2S')THEN
        ICASAN='TWOS'
      ELSEIF(ICASPL.EQ.'DIMN')THEN
        ICASAN='MINI'
      ELSEIF(ICASPL.EQ.'DIMX')THEN
        ICASAN='MAXI'
      ENDIF
C
      CALL DPDIX3(TEMP,XTEMP1,NS2,XTEMP2,IWRITE,ICASAN,
     1            RIGHT,
     1            ISUBRO,IBUGG3,IERROR)
      GOTO79000
C
32040 CONTINUE
      EPS=0.1E-05
      XTEMP1(1)=PSTAMV
      XTEMP1(2)=PSTAMV
      CALL DISTIN(TEMP,NS2,IWRITE,XTEMP1,NDIST,IBUGG3,IERROR)
      IF(NDIST.GT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32041)
32041   FORMAT('***** ERROR FROM CMPSTA (AGRESTI-COUL BINOMIAL ',
     1         'LIMITS)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32042)
32042   FORMAT('      FOR AGRESTI-COUL LIMITS CASE, MORE THAN ',
     1         'TWO DISTINCT VALUES DETECTED.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32043)NDIST
32043   FORMAT('      NUMBER OF DISTINCT VALUES = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
C
C       IF ALL VALUES ARE EQUAL TO THE "MISSING VALUE",
C       THEN SET VALUE OF STATISTIC TO MISSING VALUE.
C
      ELSEIF(NDIST.EQ.1 .AND. XTEMP1(1).EQ.PSTAMV)THEN
        RIGHT=PSTAMV
        GOTO79000
      ENDIF
C
      HOLD1=XTEMP1(1)
      HOLD2=XTEMP1(2)
      IF(NDIST.EQ.1)THEN
        IF(XTEMP1(1).GE.0.5)THEN
          XMAX=XTEMP1(1)
          XMIN=CPUMIN
        ELSE
          XMIN=XTEMP1(1)
          XMAX=CPUMAX
        ENDIF
      ELSEIF(NDIST.EQ.2)THEN
        IF(HOLD1.LT.HOLD2)THEN
          XMIN=HOLD1
          XMAX=HOLD2
        ELSE
          XMAX=HOLD1
          XMIN=HOLD2
        ENDIF
      ENDIF
C
      DO32045I=1,NS2
        IF(TEMP(I).EQ.XMAX)THEN
          TEMP(I)=1.0
        ELSE
          TEMP(I)=0.0
        ENDIF
32045 CONTINUE
C
      XSUM=0.0
      DO32048I=1,NS2
        XSUM=XSUM + TEMP(I)
32048 CONTINUE
      P=XSUM/REAL(NS2)
C
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(ICASPL.EQ.'1LAC')THEN
        IDIR='LOWE'
        CALL DPAGC1(P,NS2,ALPHA,IDIR,IWRITE,RIGHT,IBUGG3,IERROR)
      ELSEIF(ICASPL.EQ.'1UAC')THEN
        IDIR='UPPE'
        CALL DPAGC1(P,NS2,ALPHA,IDIR,IWRITE,RIGHT,IBUGG3,IERROR)
      ELSEIF(ICASPL.EQ.'2LAC')THEN
        CALL DPAGCO(P,NS2,ALPHA,IWRITE,ALOWLM,AUPPLM,IBUGG3,IERROR)
        RIGHT=ALOWLM
      ELSEIF(ICASPL.EQ.'2UAC')THEN
        CALL DPAGCO(P,NS2,ALPHA,IWRITE,ALOWLM,AUPPLM,IBUGG3,IERROR)
        RIGHT=AUPPLM
      ENDIF
C
      GOTO79000
32050 CONTINUE
      EPS=0.1E-05
      XTEMP1(1)=PSTAMV
      XTEMP1(2)=PSTAMV
      CALL DISTIN(TEMP,NS2,IWRITE,XTEMP1,NDIST,IBUGG3,IERROR)
      IF(NDIST.GT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32051)
32051   FORMAT('***** ERROR FROM CMPSTA (EXACT BINOMIAL LIMITS)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32052)
32052   FORMAT('      FOR EXACT BINOMIAL LIMITS CASE, MORE THAN ',
     1         'TWO DISTINCT VALUES DETECTED.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32053)NDIST
32053   FORMAT('      NUMBER OF DISTINCT VALUES = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
C
C       IF ALL VALUES ARE EQUAL TO THE "MISSING VALUE",
C       THEN SET VALUE OF STATISTIC TO MISSING VALUE.
C
      ELSEIF(NDIST.EQ.1 .AND. XTEMP1(1).EQ.PSTAMV)THEN
        RIGHT=PSTAMV
        GOTO79000
      ENDIF
C
      HOLD1=XTEMP1(1)
      HOLD2=XTEMP1(2)
      IF(HOLD1.LT.HOLD2)THEN
        XMIN=HOLD1
        XMAX=HOLD2
      ELSE
        XMAX=HOLD1
        XMIN=HOLD2
      ENDIF
C
      DO32055I=1,NS2
        IF(TEMP(I).EQ.XMAX)THEN
          TEMP(I)=1.0
        ELSE
          TEMP(I)=0.0
        ENDIF
32055 CONTINUE
C
      XSUM=0.0
      DO32058I=1,NS2
        XSUM=XSUM + TEMP(I)
32058 CONTINUE
      P=XSUM/REAL(NS2)
C
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
C
      IF(ICASPL.EQ.'1LEB')THEN
        CALL DPEBLL(P,NS2,ALPHA,IWRITE,RIGHT,'ONES',IBUGG3,IERROR)
      ELSEIF(ICASPL.EQ.'1UEB')THEN
        CALL DPEBUL(P,NS2,ALPHA,IWRITE,RIGHT,'ONES',IBUGG3,IERROR)
      ELSEIF(ICASPL.EQ.'2LEB')THEN
        CALL DPEBLL(P,NS2,ALPHA,IWRITE,RIGHT,'TWOS',IBUGG3,IERROR)
      ELSEIF(ICASPL.EQ.'2UEB')THEN
        CALL DPEBUL(P,NS2,ALPHA,IWRITE,RIGHT,'TWOS',IBUGG3,IERROR)
      ENDIF
      GOTO79000
C
32060 CONTINUE
C
      IHP='ALPH'
      IHP2='A   '
      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
        ALPHA=0.95
      ELSE
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.LE.0.0)THEN
          ALPHA=0.95
        ELSEIF(ALPHA.GE.1.0 .OR. ALPHA.LE.100.0)THEN
          ALPHA=ALPHA/100.0
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSEIF(ALPHA.LT.0.5)THEN
          ALPHA=1.0 - ALPHA
        ENDIF
      ENDIF
C
      ALPHAT(1)=100.0*ALPHA
      NUMALP=1
      CALL DPADK3(TEMP,TEMPZ,NS2,ALPHAT,NUMALP,
     1            XTEMP1,XTEMP2,DTEMP1,DTEMP2,DTEMP3,ITEMP1,ITEMP2,
     1            ITEMP3,ITEMP4,
     1            ADKSTA,ADC,DSD,IFLGZZ,NBCH,MINSIZ,MAXSIZ,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'ADKS')RIGHT=ADKSTA
      IF(ICASPL.EQ.'ADKC')RIGHT=ADC(1)
      GOTO79000
C
32070 CONTINUE
C
C     FOR VARIOUS CONSENSUS MEANS COMMANDS, IF WE HAVE RAW DATA
C     WE FIRST NEED TO CONVERT TO SUMMARY DATA (I.E., MEAN, SD's,
C     AND SAMPLE SIZES) BEFORE CALLING APPROPRIATE METHOD.
C
      CALL DISTIN(TEMPZ,NS2,IWRITE,XTEMP1,NLAB,IBUGG3,IERROR)
C
      DO32075I=1,NLAB
        ATEMP=XTEMP1(I)
        NTEMP=0
        DO32079J=1,NS2
          IF(TEMPZ(J).EQ.ATEMP)THEN
            NTEMP=NTEMP+1
            TEMPZ3(NTEMP)=TEMP(J)
          ENDIF
32079   CONTINUE
        ITEMP1(I)=NTEMP
C
        CALL MEAN(TEMPZ3,NTEMP,IWRITE,AMEAN,IBUGG3,IERROR)
        CALL SD(TEMPZ3,NTEMP,IWRITE,ASD,IBUGG3,IERROR)
        XTEMP2(I)=AMEAN
        XTEMP3(I)=ASD
C
32075 CONTINUE
C
      DO32080I=1,NLAB
        TEMP(I)=XTEMP2(I)
        TEMPZ(I)=XTEMP3(I)
        TEMPZ3(I)=REAL(ITEMP1(I))
32080 CONTINUE
      NS2=NLAB
C
      IF(ICASPL.EQ.'DSLA')GOTO32100
      IF(ICASPL.EQ.'DHHD')GOTO32100
      IF(ICASPL.EQ.'DSMM')GOTO32100
      IF(ICASPL.EQ.'DSSE')GOTO32100
      IF(ICASPL.EQ.'MPAU')GOTO32200
      IF(ICASPL.EQ.'MPSE')GOTO32200
      IF(ICASPL.EQ.'MMPA')GOTO32200
      IF(ICASPL.EQ.'MMPS')GOTO32200
      IF(ICASPL.EQ.'VARU')GOTO32200
      IF(ICASPL.EQ.'VRSE')GOTO32200
      IF(ICASPL.EQ.'BOB ')GOTO32300
      IF(ICASPL.EQ.'BOBS')GOTO32300
      IF(ICASPL.EQ.'GCIN')GOTO32400
      IF(ICASPL.EQ.'GCIS')GOTO32400
      IF(ICASPL.EQ.'BCP ')GOTO32500
      IF(ICASPL.EQ.'BCPS')GOTO32500
      IF(ICASPL.EQ.'MMEA')GOTO32600
      IF(ICASPL.EQ.'MMES')GOTO32600
      IF(ICASPL.EQ.'FAIR')GOTO32700
      IF(ICASPL.EQ.'FWSE')GOTO32700
      IF(ICASPL.EQ.'GDEA')GOTO32800
      IF(ICASPL.EQ.'GDSE')GOTO32800
      IF(ICASPL.EQ.'GDSN')GOTO32800
      IF(ICASPL.EQ.'GDZ1')GOTO32800
      IF(ICASPL.EQ.'GDZ2')GOTO32800
      IF(ICASPL.EQ.'SCEB')GOTO32900
      IF(ICASPL.EQ.'SESE')GOTO32900
C
32100 CONTINUE
C
C     CHECK FOR LABS WITH LESS THAN 2 OBSERVATIONS OR WITH
C     NON-POSITIVE STANDARD DEVIATION.
C
      IPRINT='OFF'
      NLAB=NS2
      NPTS=0
      IF(NLAB.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32101)
32101   FORMAT('***** ERROR FROM CMPSTA (DERSIMONIAN-LAIRD ',
     1         'ESTIMATION)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32103)
32103   FORMAT('      THE NUMBER OF LABS IS LESS THAN TWO.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      DO32111I=1,NLAB
        ITEMP9=INT(TEMPZ3(I)+0.1)
        IF(TEMPZ(I).LE.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32101)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32113)I,TEMPZ(I)
32113     FORMAT('      LAB ',I6,' HAS NON-POSITIVE STANDARD ',
     1           'DEVIATION (= ',G15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSEIF(ITEMP9.LE.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32101)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32118)I
32118     FORMAT('      LAB ',I6,' HAS LESS THAN 2 OBSERVATIONS.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
        ITEMP1(I)=ITEMP9
        NPTS=NPTS+ITEMP9
32111 CONTINUE
C
      ICAPSW='XXXX'
      ICAPTY='XXXX'
      NUMDIG=-99
      IWRITE='OFF'
CCCCC IOUNI5=-99
CCCCC CALL DPDERS(NPTS,NLAB,
CCCCC1            TEMP,TEMPZ,ITEMP1,
CCCCC1            XTEMP3(1),XTEMP3(MAXNXT/2),ITEMP2,
CCCCC1            XTEMP1,XTEMP2,DTEMP1,
CCCCC1            DTEMP2,DTEMP2(5001),DTEMP3,
CCCCC1            XDL,XDLS2,YDL,SEDLK1,SEDLK2,DLOWDL,DHIGDL,
CCCCC1            SERUK1,SERUK2,DLOWD2,DHIGD2,
CCCCC1            SEHDK1,SEHDK2,DLOWD3,DHIGD3,
CCCCC1            SEBOK1,SEBOK2,DLOWD4,DHIGD4,
CCCCC1            DLOWD5,DHIGD5,DLOWD6,DHIGD6,
CCCCC1            AK2,AK3,
CCCCC1            IWRITE,IOUNI5,
CCCCC1            ICAPSW,ICAPTY,NUMDIG,ISEED,
CCCCC1            ISUBRO,IBUGG3,IERROR)
CCCCC IF(ICASPL.EQ.'DSLA')RIGHT=XDL
CCCCC IF(ICASPL.EQ.'DHHD')RIGHT=SEHDK1
CCCCC IF(ICASPL.EQ.'DSMM')RIGHT=SERUK1
CCCCC IF(ICASPL.EQ.'DSSE')RIGHT=SEDLK1
CCCCC IF(ICASPL.EQ.'DSBO')RIGHT=SEBOK1
      RIGHT=CPUMIN
      GOTO79000
C
32200 CONTINUE
C
C     CHECK FOR LABS WITH LESS THAN 2 OBSERVATIONS OR WITH
C     NON-POSITIVE STANDARD DEVIATION.
C
      IPRINT='OFF'
      NLAB=NS2
      NPTS=0
      IF(NLAB.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32201)
32201   FORMAT('***** ERROR FROM CMPSTA (MANDEL-PAULE ',
     1         'ESTIMATION)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32203)
32203   FORMAT('      THE NUMBER OF LABS IS LESS THAN TWO.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      DO32211I=1,NLAB
        ITEMP9=INT(TEMPZ3(I)+0.1)
        IF(TEMPZ(I).LE.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32201)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32213)I,TEMPZ(I)
32213     FORMAT('      LAB ',I6,' HAS NON-POSITIVE STANDARD ',
     1           'DEVIATION (= ',G15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSEIF(ITEMP9.LE.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32201)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32218)I
32218     FORMAT('      LAB ',I6,' HAS LESS THAN 2 OBSERVATIONS.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
        ITEMP1(I)=ITEMP9
        NPTS=NPTS+ITEMP9
32211 CONTINUE
C
      T0=10000000.D0
      T1=-T0
C
      AMNX=CPUMAX
      AMXX=CPUMIN
      AMNSD=CPUMAX
      AMXSD=CPUMIN
C
      DO32250I=1,NLAB
C
        DTEMP1(I)=DBLE(TEMP(I))
        IF(DTEMP1(I).LT.T0) T0=DTEMP1(I)
        IF(DTEMP1(I).GT.T1) T1=DTEMP1(I)
        IF(TEMP(I).GT.AMXX)AMXX=TEMP(I)
        IF(TEMP(I).LT.AMNX)AMNX=TEMP(I)
C
        DTEMP2(I)=DBLE(TEMPZ(I))**2/DBLE(ITEMP1(I))
        IF(TEMPZ(I).GT.0.0)THEN
          IF(TEMPZ(I).LT.AMNSD)AMNSD=TEMPZ(I)
          IF(TEMPZ(I).GT.AMXSD)AMXSD=TEMPZ(I)
        ENDIF
C
32250 CONTINUE
C
      EPS=0.00001
      T0=AMNX - EPS
      T1=AMXX
      DO32270I=1,NS2
        DTEMP1(I)=(DTEMP1(I)-T0)/(T1-T0)
        DTEMP2(I)=DTEMP2(I)/((T1-T0)**2)
32270 CONTINUE
C
      ICAPSW='XXXX'
      ICAPTY='XXXX'
      NUMDIG=-99
      IWRITE='OFF'
C
      IF(ICASPL.EQ.'MPAU' .OR. ICASPL.EQ.'MPSE' .OR.
     1   ICASPL.EQ.'VARU' .OR. ICASPL.EQ.'VRSE')THEN
        CALL DPMNPL(TEMP,TEMPZ,TEMPZ3,NPTS,NLAB,
     1              DTEMP1,DTEMP2,ITEMP1,
     1              XMPS,S2BMPS,SEMP,SEMPK1,SEMPK2,
     1              DLOWMP,DHIGMP,STXMU,STS2B,
     1              IWRITE,
     1              ICAPSW,ICAPTY,NUMDIG,
     1              ISUBRO,IBUGG3,IERROR)
      ELSEIF(ICASPL.EQ.'MMPA' .OR. ICASPL.EQ.'MMPS')THEN
        CALL DPMMPL(TEMP,TEMPZ,TEMPZ3,NPTS,NLAB,
     1              DTEMP1,DTEMP2,ITEMP1,
     1              XMMPS,S2BMMP,SEMMP,SEMMP1,SEMMP2,
     1              DLOWMM,DHIGMM,
     1              IWRITE,
     1              ICAPSW,ICAPTY,NUMDIG,
     1              ISUBRO,IBUGG3,IERROR)
      ENDIF
C
      IF(ICASPL.EQ.'VARU' .OR. ICASPL.EQ.'VRSE')THEN
        CALL DPVRML(NPTS,NLAB,
     1              TEMP,TEMPZ,ITEMP1,
     1              XTEMP3(1),XTEMP3(MAXNXT/2),ITEMP2,XTEMP1,XTEMP2,
     1              DTEMP1,DTEMP2,DTEMP3,
     1              DTEMP2(MAXNXT/2),DTEMP3(MAXNXT/2),
     1              XMLS,S2BMLS,SEML,SEMLK1,SEMLK2,
     1              DLOWML,DHIGML,STXMU,STS2B,
     1              SEMLBO,DLOWM2,DHIGM2,
     1              IWRITE,
     1              ICAPSW,ICAPTY,IOUNI5,NUMDIG,ISEED,
     1              ISUBRO,IBUGG3,IERROR)
      ENDIF
C
      IF(ICASPL.EQ.'MPAU')RIGHT=XMPS
      IF(ICASPL.EQ.'MPSE')RIGHT=SEMP
      IF(ICASPL.EQ.'VARU')RIGHT=XMLS
      IF(ICASPL.EQ.'VRSE')RIGHT=SEML
      IF(ICASPL.EQ.'MMPA')RIGHT=XMMPS
      IF(ICASPL.EQ.'MMPS')RIGHT=SEMMP
      GOTO79000
C
32300 CONTINUE
C
C     CHECK FOR LABS WITH LESS THAN 2 OBSERVATIONS OR WITH
C     NON-POSITIVE STANDARD DEVIATION.
C
      IPRINT='OFF'
      NLAB=NS2
      NPTS=0
      IF(NLAB.LT.2 .OR. NLAB.GT.5)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32301)
32301   FORMAT('***** ERROR FROM CMPSTA (BOB ESTIMATION)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32303)
32303   FORMAT('      THE NUMBER OF LABS IS LESS THAN TWO OR ',
     1         'GREATER THAN FIVE.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      DO32311I=1,NLAB
        ITEMP9=INT(TEMPZ3(I)+0.1)
        IF(TEMPZ(I).LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32301)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32313)I,TEMPZ(I)
32313     FORMAT('      LAB ',I6,' HAS NEGATIVE STANDARD ',
     1           'DEVIATION (= ',G15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSEIF(ITEMP9.LE.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32301)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32318)I
32318     FORMAT('      LAB ',I6,' HAS LESS THAN 1 OBSERVATION.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
        ITEMP1(I)=ITEMP9
        NPTS=NPTS+ITEMP9
32311 CONTINUE
C
      AMNX=CPUMAX
      AMXX=CPUMIN
C
      DSUM1=0.0D0
      DO32350I=1,NLAB
        IF(TEMP(I).GT.AMXX)AMXX=TEMP(I)
        IF(TEMP(I).LT.AMNX)AMNX=TEMP(I)
        DSUM1=DSUM1 + DBLE(TEMPZ(I))**2/DBLE(ITEMP1(I))
32350 CONTINUE
      SW=REAL(DSQRT(DSUM1)/DBLE(NLAB))
C
      ICAPSW='XXXX'
      ICAPTY='XXXX'
      NUMDIG=-99
      IWRITE='OFF'
      CALL DPBOB(NPTS,NLAB,
     1           TEMP,TEMPZ,AMNX,AMXX,SW,
     1           ASM,ASB,AKU,AKUK1,AKUK2,
     1           DLOWBO,DHIGBO,
     1           IWRITE,
     1           ICAPSW,ICAPTY,NUMDIG,
     1           ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'BOB ')RIGHT=ASM
      IF(ICASPL.EQ.'BOBS')RIGHT=AKUK1
      GOTO79000
C
32400 CONTINUE
C
C     CHECK FOR LABS WITH LESS THAN 2 OBSERVATIONS OR WITH
C     NON-POSITIVE STANDARD DEVIATION.
C

      IPRINT='OFF'
      NLAB=NS2
      NPTS=0
      IF(NLAB.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32401)
32401   FORMAT('***** ERROR FROM CMPSTA (GENERALIZED CONFIDENCE ',
     1         'INTERVAL ESTIMATION)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32403)
32403   FORMAT('      THE NUMBER OF LABS IS LESS THAN TWO.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      DO32411I=1,NLAB
        ITEMP9=INT(TEMPZ3(I)+0.1)
        IF(TEMPZ(I).LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32401)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32413)I,TEMPZ(I)
32413     FORMAT('      LAB ',I6,' HAS NEGATIVE STANDARD ',
     1           'DEVIATION (= ',G15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSEIF(ITEMP9.LT.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32401)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32418)I
32418     FORMAT('      LAB ',I6,' HAS LESS THAN 1 OBSERVATION.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
        ITEMP1(I)=ITEMP9
        NPTS=NPTS+ITEMP9
32411 CONTINUE
C
      ICAPSW='XXXX'
      ICAPTY='XXXX'
      NUMDIG=-99
      IWRITE='OFF'
      CALL DPGCI(NPTS,NLAB,
     1           TEMP,TEMPZ,ITEMP1,
     1           DTEMP1,DTEMP2,
     1           XGCI,SEGCI,
     1           DLOWGC,DHIGGC,
     1           IWRITE,IOUNI5,
     1           ICAPSW,ICAPTY,NUMDIG,
     1           ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'GCIN')RIGHT=XGCI
      IF(ICASPL.EQ.'GCIS')RIGHT=SEGCI
      GOTO79000
C
32500 CONTINUE
C
C     CHECK FOR LABS WITH LESS THAN 2 OBSERVATIONS OR WITH
C     NON-POSITIVE STANDARD DEVIATION.
C
      IPRINT='OFF'
      NLAB=NS2
      NPTS=0
      IF(NLAB.LT.2 .OR. NLAB.GT.6)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32501)
32501   FORMAT('***** ERROR FROM CMPSTA (BCP ESTIMATION)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32503)
32503   FORMAT('      THE NUMBER OF LABS IS LESS THAN TWO OR ',
     1         'GREATER THAN SIX.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      DO32511I=1,NLAB
        ITEMP9=INT(TEMPZ3(I)+0.1)
        IF(TEMPZ(I).LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32501)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32513)I,TEMPZ(I)
32513     FORMAT('      LAB ',I6,' HAS NEGATIVE STANDARD ',
     1           'DEVIATION (= ',G15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSEIF(ITEMP9.LE.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32501)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32518)I
32518     FORMAT('      LAB ',I6,' HAS LESS THAN 1 OBSERVATION.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
        ITEMP1(I)=ITEMP9
        NPTS=NPTS+ITEMP9
32511 CONTINUE
C
      AMNX=CPUMAX
      AMXX=CPUMIN
C
      DO32550I=1,NLAB
        IF(TEMP(I).GT.AMXX)AMXX=TEMP(I)
        IF(TEMP(I).LT.AMNX)AMNX=TEMP(I)
32550 CONTINUE
C
      ICAPSW='XXXX'
      ICAPTY='XXXX'
      NUMDIG=-99
      IWRITE='OFF'
      CALL DPBCP(NPTS,NLAB,
     1           TEMP,TEMPZ,ITEMP1,AMNX,AMXX,
     1           XBCP,XBCPSE,XBCPK1,SBCPK2,
     1           DLOWBC,DHIGBC,
     1           IWRITE,
     1           ICAPSW,ICAPTY,NUMDIG,
     1           ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'BCP ')RIGHT=XBCP
      IF(ICASPL.EQ.'BCPS')RIGHT=XBCPSE
      GOTO79000
C
32600 CONTINUE
C
C     CHECK FOR LABS WITH LESS THAN 2 OBSERVATIONS OR WITH
C     NON-POSITIVE STANDARD DEVIATION.
C

      IPRINT='OFF'
      NLAB=NS2
      IF(NLAB.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32601)
32601   FORMAT('***** ERROR FROM CMPSTA (MEAN OF MEANS ESTIMATION)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32603)
32603   FORMAT('      THE NUMBER OF LABS IS LESS THAN TWO.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      CALL MEAN(TEMP,NLAB,IWRITE,ASM,IBUGG3,IERROR)
      CALL SD(TEMP,NLAB,IWRITE,ASD,IBUGG3,IERROR)
      IF(ICASPL.EQ.'MMEA')RIGHT=ASM
      IF(ICASPL.EQ.'MMES')RIGHT=ASD/SQRT(REAL(NLAB))
      GOTO79000
C
32700 CONTINUE
C
C     CHECK FOR LABS WITH LESS THAN 2 OBSERVATIONS OR WITH
C     NON-POSITIVE STANDARD DEVIATION.
C

      IPRINT='OFF'
      NLAB=NS2
      NPTS=0
      IF(NLAB.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32701)
32701   FORMAT('***** ERROR FROM CMPSTA (FAIRWEATHER ESTIMATION)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32703)
32703   FORMAT('      THE NUMBER OF LABS IS LESS THAN TWO.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      DO32711I=1,NLAB
        ITEMP9=INT(TEMPZ3(I)+0.1)
        IF(TEMPZ(I).LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32701)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32713)I,TEMPZ(I)
32713     FORMAT('      LAB ',I6,' HAS NEGATIVE STANDARD ',
     1           'DEVIATION (= ',G15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSEIF(ITEMP9.LT.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32701)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32718)I
32718     FORMAT('      LAB ',I6,' HAS LESS THAN 1 OBSERVATION.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
        ITEMP1(I)=ITEMP9
        NPTS=NPTS+ITEMP9
32711 CONTINUE
C
      ICAPSW='XXXX'
      ICAPTY='XXXX'
      NUMDIG=-99
      IWRITE='OFF'
      CALL DPFAIR(NPTS,NLAB,
     1            TEMP,TEMPZ,ITEMP1,
     1            XFW,XFWS2,SEFWK1,SEFWK2,
     1            DLOWFW,DHIGFW,DLOWF2,DHIGF2,DLOWF3,DHIGF3,
     1            IWRITE,
     1            ICAPSW,ICAPTY,IFLAG9,NUMDIG,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=CPUMIN
      IF(IFLAG9)THEN
        IF(ICASPL.EQ.'FAIR')RIGHT=XFW
        IF(ICASPL.EQ.'FWSE')RIGHT=SEFWK1
      ENDIF
      GOTO79000
C
32800 CONTINUE
C
C     CHECK FOR LABS WITH LESS THAN 2 OBSERVATIONS OR WITH
C     NON-POSITIVE STANDARD DEVIATION.
C
      IPRINT='OFF'
      NLAB=NS2
      NPTS=0
      IF(NLAB.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32801)
32801   FORMAT('***** ERROR FROM CMPSTA (GRAYBILL-DEAL ESTIMATION)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32803)
32803   FORMAT('      THE NUMBER OF LABS IS LESS THAN TWO.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      DO32811I=1,NLAB
        ITEMP9=INT(TEMPZ3(I)+0.1)
        IF(TEMPZ(I).LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32801)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32813)I,TEMPZ(I)
32813     FORMAT('      LAB ',I6,' HAS NEGATIVE STANDARD ',
     1           'DEVIATION (= ',G15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSEIF(ITEMP9.LT.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32801)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32818)I
32818     FORMAT('      LAB ',I6,' HAS LESS THAN 1 OBSERVATION.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
        ITEMP1(I)=ITEMP9
        NPTS=NPTS+ITEMP9
32811 CONTINUE
C
      ICAPSW='XXXX'
      ICAPTY='XXXX'
      NUMDIG=-99
      IWRITE='OFF'
      IOUNI5=-99
      CALL DPGRAY(NPTS,NLAB,
     1            TEMP,TEMPZ,ITEMP1,
     1            XGD,XGDS2,SEGDK1,SEGDK2,
     1            XGDS20,XGDSZ1,XGDSZ2,
     1            DLOWGD,DHIGGD,
     1            IWRITE,IOUNI5,
     1            ICAPSW,ICAPTY,NUMDIG,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'GDEA')RIGHT=XGD
      IF(ICASPL.EQ.'GDSE')RIGHT=SEGDK1
      IF(ICASPL.EQ.'GDSN')RIGHT=SQRT(XGDS20)
      IF(ICASPL.EQ.'GDZ1')RIGHT=SQRT(XGDSZ1)
      IF(ICASPL.EQ.'GDZ2')RIGHT=SQRT(XGDSZ2)
      GOTO79000
C
32900 CONTINUE
C
C     CHECK FOR LABS WITH LESS THAN 2 OBSERVATIONS OR WITH
C     NON-POSITIVE STANDARD DEVIATION.
C
      IPRINT='OFF'
      NLAB=NS2
      NPTS=0
      IF(NLAB.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32901)
32901   FORMAT('***** ERROR FROM CMPSTA (SCHILLER-EBERHARDT ',
     1         'ESTIMATION)--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,32903)
32903   FORMAT('      THE NUMBER OF LABS IS LESS THAN TWO.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
      DO32911I=1,NLAB
        ITEMP9=INT(TEMPZ3(I)+0.1)
        IF(TEMPZ(I).LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32901)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32913)I,TEMPZ(I)
32913     FORMAT('      LAB ',I6,' HAS NEGATIVE STANDARD ',
     1           'DEVIATION (= ',G15.7)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSEIF(ITEMP9.LT.2)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32901)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,32918)I
32918     FORMAT('      LAB ',I6,' HAS LESS THAN 2 OBSERVATIONS.')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
        ITEMP1(I)=ITEMP9
        NPTS=NPTS+ITEMP9
32911 CONTINUE
C
      IHP='SIGM'
      IHP2='AH  '
      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
        SIGMAH=0.0
      ELSE
        SIGMAH=VALUE(ILOCP)
        IF(SIGMAH.LT.0.0)SIGMAH=0.0
      ENDIF
      IHP='DFH '
      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
        IDFH=1
      ELSE
        IDFH=INT(VALUE(ILOCP)+ 0.5)
      ENDIF
      IF(IDFH.LE.0)IDFH=1
C
C     SCHILLER-EBERHARDT NEEDS TO CALL MANDEL-PAULE TO
C     OBTAIN "S2BMPS" VALUE.
C
      T0=10000000.D0
      T1=-T0
C
      AMNX=CPUMAX
      AMXX=CPUMIN
      AMNSD=CPUMAX
      AMXSD=CPUMIN
C
      DO32950I=1,NLAB
C
        DTEMP1(I)=DBLE(TEMP(I))
        IF(DTEMP1(I).LT.T0) T0=DTEMP1(I)
        IF(DTEMP1(I).GT.T1) T1=DTEMP1(I)
        IF(TEMP(I).GT.AMXX)AMXX=TEMP(I)
        IF(TEMP(I).LT.AMNX)AMNX=TEMP(I)
C
        DTEMP2(I)=DBLE(TEMPZ(I))**2/DBLE(ITEMP1(I))
        IF(TEMPZ(I).GT.0.0)THEN
          IF(TEMPZ(I).LT.AMNSD)AMNSD=TEMPZ(I)
          IF(TEMPZ(I).GT.AMXSD)AMXSD=TEMPZ(I)
        ENDIF
C
32950 CONTINUE
C
      EPS=0.00001
      T0=AMNX - EPS
      T1=AMXX
      DO32970I=1,NS2
        DTEMP1(I)=(DTEMP1(I)-T0)/(T1-T0)
        DTEMP2(I)=DTEMP2(I)/((T1-T0)**2)
32970 CONTINUE
C
      ICAPSW='XXXX'
      ICAPTY='XXXX'
      NUMDIG=-99
      IWRITE='OFF'
C
      CALL DPMNPL(TEMP,TEMPZ,TEMPZ3,NPTS,NLAB,
     1            DTEMP1,DTEMP2,ITEMP1,
     1            XMPS,S2BMPS,SEMP,SEMPK1,SEMPK2,
     1            DLOWMP,DHIGMP,STXMU,STS2B,
     1            IWRITE,
     1            ICAPSW,ICAPTY,NUMDIG,
     1            ISUBRO,IBUGG3,IERROR)
      CALL DPSCEB(NPTS,NLAB,
     1            DTEMP1,ITEMP1,
     1            TEMP,TEMPZ,S2BMPS,
     1            XSE,XSES2,IDFH,SIGMAH,
     1            SESUK1,SESUK2,
     1            DLOWSE,DHIGSE,
     1            IWRITE,
     1            ICAPSW,ICAPTY,NUMDIG,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'SCEB')RIGHT=XSE
      IF(ICASPL.EQ.'SESE')RIGHT=SESUK1
      GOTO79000
C
33100 CONTINUE
C
      IHP='ALPH'
      IHP2='A   '
      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
        ALPHA=0.95
      ELSE
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.EQ.90.0 .OR. ALPHA.EQ.0.90)THEN
          ALPHA=0.90
        ELSEIF(ALPHA.EQ.10.0 .OR. ALPHA.EQ.0.10)THEN
          ALPHA=0.90
        ELSEIF(ALPHA.EQ.99.0 .OR. ALPHA.EQ.0.99)THEN
          ALPHA=0.99
        ELSEIF(ALPHA.EQ.1.0 .OR. ALPHA.EQ.0.01)THEN
          ALPHA=0.99
        ELSEIF(ALPHA.EQ.95.0 .OR. ALPHA.EQ.0.95)THEN
          ALPHA=0.95
        ELSEIF(ALPHA.EQ.5.0 .OR. ALPHA.EQ.0.05)THEN
          ALPHA=0.95
        ELSE
          ALPHA=0.95
        ENDIF
      ENDIF
C
      CALL DP2KS3(TEMP,TEMPZ,NS2,NSZ,
     1            XTEMP1,
     1            STATVA,STATCD,CUTU90,CUTU95,CUTU99,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'KS2S')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'KSCV')THEN
        IF(ALPHA.EQ.0.90)THEN
          RIGHT=CUTU90
        ELSEIF(ALPHA.EQ.0.99)THEN
          RIGHT=CUTU99
        ELSE
          RIGHT=CUTU95
        ENDIF
      ENDIF
      GOTO79000
C
33105 CONTINUE
      IDATSW='RAW'
      CLWID=CLWIDT(1)
      XSTART=CLLIMI(1)
      XSTOP=CLLIMI(2)
      MAXOB2=MAXOBV/2
      IINDX=(MAXOBV/2) + 1
      CALL DP2CH3(TEMP,TEMPZ,TEMPZ3,NS2,NSZ,NSZ3,
     1            IDATSW,IRHSTG,
     1            CLWID,XSTART,XSTOP,
     1            CLWID2,DXSTAR,DXSTOP,
     1            XTEMP1,IHSTCW,IHSTOU,MAXOBV,MAXOB2,
     1            STATVA,STATCD,STATNU,NCELLS,
     1            Y1MEAN,Y1SD,Y1MIN,Y1MAX,
     1            Y2MEAN,Y2SD,Y2MIN,Y2MAX,
     1            XTEMP2,XTEMP3,XTEMP2(IINDX),XTEMP3(IINDX),M2,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'CS2S')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'CC2S')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'CP2S')THEN
        RIGHT=1.0 - STATCD
      ENDIF
      GOTO79000
C
33110 CONTINUE
C
      CALL DPWSH3(TEMP,NS2,
     1            XTEMP1,MAXNXT,
     1            STATVA,PVAL,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'WSHA')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'WSPV')THEN
        RIGHT=PVAL
      ENDIF
      GOTO79000
C
33120 CONTINUE
C
      CALL DPCUS3(TEMP,NS2,
     1            STATVA,STATV2,STATCD,STATC2,PVAL1,PVAL2,
     1            XTEMP2,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'CSFT')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'CSFP')THEN
        RIGHT=PVAL1
      ELSEIF(ICASPL.EQ.'CSBT')THEN
        RIGHT=STATV2
      ELSEIF(ICASPL.EQ.'CSBP')THEN
        RIGHT=PVAL2
      ENDIF
      GOTO79000
C
33130 CONTINUE
C
      IF(NUMV2.EQ.1)THEN
        XMEAN=CPUMIN
        XSD=CPUMIN
        AN=CPUMIN
      ELSE
        XMEAN=TEMP(1)
        XSD=TEMPZ(1)
        AN=TEMPZ3(1)
      ENDIF
C
      IHP='ALPH'
      IHP2='A   '
      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
        ALPHA=0.95
      ELSE
        ALPHA=VALUE(ILOCP)
      ENDIF
C
      IHP='GAMM'
      IHP2='A   '
      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
        GAMMA=0.95
      ELSE
        GAMMA=VALUE(ILOCP)
      ENDIF
C
      CALL DPTOL3(TEMP,NS2,XMEAN,XSD,AN,PTOLDF,
     1            ICASPL,ALPHA,GAMMA,ITOLGC,ITOLM2,
     1            AK,ALOWLM,AUPPLM,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'1LNT' .OR. ICASPL.EQ.'2LNT')THEN
        RIGHT=ALOWLM
      ELSEIF(ICASPL.EQ.'1UNT' .OR. ICASPL.EQ.'2UNT')THEN
        RIGHT=AUPPLM
      ELSEIF(ICASPL.EQ.'1KNT' .OR. ICASPL.EQ.'2KNT')THEN
        RIGHT=AK
      ENDIF
      GOTO79000
C
33140 CONTINUE
C
      CALL DPFTE3(TEMP,NS2,TEMPZ,NSZ,MAXNXT,
     1            Y1MEAN,Y1SD,Y2MEAN,Y2SD,
     1            SDNUM,SDDEN,IDFNUM,IDFDEN,
     1            STATVA,STANU1,STANU2,POOLSD,STATCD,PVAL,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'FTES')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'FTPV')THEN
        RIGHT=PVAL
      ELSEIF(ICASPL.EQ.'FTCD')THEN
        RIGHT=STATCD
      ENDIF
      GOTO79000
C
33150 CONTINUE
      IHP='MU  '
      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
        AMU=0.0
      ELSE
        AMU=VALUE(ILOCP)
      ENDIF
C
      CALL DPSIG3(TEMP,NS2,AMU,IWRITE,
     1            XTEMP1,XTEMP2,MAXNXT,
     1            XMEAN,XMED,XSD,XMAD,
     1            STATV1,STATC1,STATV2,STATC2,RTIES,NTEMP,
     1            PVAL2T,PVALLT,PVALUT,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'1STE')THEN
        RIGHT=STATV1
      ELSEIF(ICASPL.EQ.'1SCD')THEN
        RIGHT=STATC1
      ELSEIF(ICASPL.EQ.'1S2P')THEN
        RIGHT=PVAL2T
      ELSEIF(ICASPL.EQ.'1SLP')THEN
        RIGHT=PVALLT
      ELSEIF(ICASPL.EQ.'1SUP')THEN
        RIGHT=PVALUT
      ENDIF
      GOTO79000
C
33160 CONTINUE
      IHP='D0  '
      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
        D0=0.0
      ELSE
        D0=VALUE(ILOCP)
      ENDIF
C
      CALL DPSIG4(TEMP,NS2,TEMPZ,NSZ,D0,IWRITE,
     1            XTEMP1,XTEMP2,MAXNXT,
     1            X1MEAN,X1MED,X1SD,X1MAD,
     1            X2MEAN,X2MED,X2SD,X2MAD,
     1            STATV1,STATC1,STATV2,STATC2,RTIES,NTEMP,
     1            PVAL2T,PVALLT,PVALUT,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'2STE')THEN
        RIGHT=STATV1
      ELSEIF(ICASPL.EQ.'2SCD')THEN
        RIGHT=STATC1
      ELSEIF(ICASPL.EQ.'2S2P')THEN
        RIGHT=PVAL2T
      ELSEIF(ICASPL.EQ.'2SLP')THEN
        RIGHT=PVALLT
      ELSEIF(ICASPL.EQ.'2SUP')THEN
        RIGHT=PVALUT
      ENDIF
      GOTO79000
C
33165 CONTINUE
      IF(MAXNXT.GE.1000000)THEN
        MAXSAM=22
      ELSE
        MAXSAM=20
      ENDIF
      SUMX=CPUMIN
      PTEMP=CPUMIN
      CALL FISHER(TEMP,NS2,TEMPZ,NSZ,ITOTAL,POSSIB,PTEMP,
     1            SUMX,SUMY,XMEAN,YMEAN,
     1            XTEMP1,XTEMP2,ITEMP1,MAXSAM,MAXNXT,
     1            IFAULT,IBUGG3)
      IF(IFAULT.GT.0)THEN
        RIGHT=CPUMIN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,33166)
33166   FORMAT('****** ERROR IN FISHER TWO-SAMPLE RANDOMIZATION TEST--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,33167)
33167   FORMAT('       MAXIMUM STORAGE SPACE EXCEEDED.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,33168)NS2
33168   FORMAT('       NUMBER OF OBSERVATIONS FOR SAMPLE ONE  = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,33169)NSZ
33169   FORMAT('       NUMBER OF OBSERVATIONS FOR SAMPLE TWO  = ',I8)
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICASPL.EQ.'2FRT')THEN
        RIGHT=SUMX
      ELSEIF(ICASPL.EQ.'2F2P' .AND. NS2.EQ.NSZ)THEN
        RIGHT=2.0*PTEMP
      ELSEIF(ICASPL.EQ.'2F2P' .AND. NS2.NE.NSZ)THEN
        RIGHT=2.0*PTEMP
      ELSEIF(ICASPL.EQ.'2F1P')THEN
        RIGHT=PTEMP
      ENDIF
      GOTO79000
C
33170 CONTINUE
      IF(ICASPL.EQ.'WABA')THEN
        ICASAN='ABAS'
        ICASDI='WEIB'
      ELSEIF(ICASPL.EQ.'WBBA')THEN
        ICASAN='BBAS'
        ICASDI='WEIB'
      ELSEIF(ICASPL.EQ.'LABA')THEN
        ICASAN='ABAS'
        ICASDI='LOGN'
      ELSEIF(ICASPL.EQ.'LBBA')THEN
        ICASAN='BBAS'
        ICASDI='LOGN'
      ELSEIF(ICASPL.EQ.'NABA')THEN
        ICASAN='ABAS'
        ICASDI='NORM'
      ELSEIF(ICASPL.EQ.'NBBA')THEN
        ICASAN='BBAS'
        ICASDI='NORM'
      ELSEIF(ICASPL.EQ.'ZABA')THEN
        ICASAN='ABAS'
        ICASDI='NONP'
      ELSEIF(ICASPL.EQ.'ZBBA')THEN
        ICASAN='BBAS'
        ICASDI='NONP'
      ENDIF
      CALL DPABA3(TEMP,NS2,
     1            XTEMP1,MAXNXT,
     1            ICASAN,ICASDI,
     1            T10,V10,NDF,GAMMA,ALPHA,YMEAN,YSD,YMIN,YMAX,
     1            ABASIS,BBASIS,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'WABA')RIGHT=ABASIS
      IF(ICASPL.EQ.'WBBA')RIGHT=BBASIS
      IF(ICASPL.EQ.'LABA')RIGHT=ABASIS
      IF(ICASPL.EQ.'LBBA')RIGHT=BBASIS
      IF(ICASPL.EQ.'NABA')RIGHT=ABASIS
      IF(ICASPL.EQ.'NBBA')RIGHT=BBASIS
      IF(ICASPL.EQ.'ZABA')RIGHT=ABASIS
      IF(ICASPL.EQ.'ZBBA')RIGHT=BBASIS
      GOTO79000
C
34000 CONTINUE
      IHP='D0  '
      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
        D0=0.0
      ELSE
        D0=VALUE(ILOCP)
      ENDIF
C
      ICASAN='ONES'
      IF(ICASPL.EQ.'1WLP')THEN
        ICASA2='LOWE'
      ELSEIF(ICASPL.EQ.'1WUP')THEN
        ICASA2='UPPE'
      ELSE
        ICASA2='TWOT'
      ENDIF
      CALL DPWIL3(TEMP,TEMPZ,NS2,D0,ICASAN,ICASA2,
     1            XTEMP1,XTEMP2,XTEMP3,MAXNXT,
     1            STATVA,STATV2,STATCD,
     1            PVAL2T,PVALLT,PVALUT,
     1            NTEMP,NPLUS,NMINUS,NTIES,
     1            TPLUS,TMINUS,RSUM,RSUMSQ,
     1            IBUGG3,ISUBRO,IERROR)
C
C     NOTE: RETURN THE "NORMAL APPROXIMATION" TEST STATISTIC
C
      IF(ICASPL.EQ.'1WTE')THEN
        RIGHT=STATV2
      ELSEIF(ICASPL.EQ.'1WCD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'1W2P')THEN
        RIGHT=PVAL2T
      ELSEIF(ICASPL.EQ.'1WLP')THEN
        RIGHT=PVALLT
      ELSEIF(ICASPL.EQ.'1WUP')THEN
        RIGHT=PVALUT
      ENDIF
      GOTO79000
C
34010 CONTINUE
      IHP='D0  '
      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
        D0=0.0
      ELSE
        D0=VALUE(ILOCP)
      ENDIF
C
      ICASAN='TWOS'
      IF(ICASPL.EQ.'1WLP')THEN
        ICASA2='LOWE'
      ELSEIF(ICASPL.EQ.'1WUP')THEN
        ICASA2='UPPE'
      ELSE
        ICASA2='TWOT'
      ENDIF
      CALL DPWIL3(TEMP,TEMPZ,NS2,D0,ICASAN,ICASA2,
     1            XTEMP1,XTEMP2,XTEMP3,MAXNXT,
     1            STATVA,STATV2,STATCD,
     1            PVAL2T,PVALLT,PVALUT,
     1            NTEMP,NPLUS,NMINUS,NTIES,
     1            TPLUS,TMINUS,RSUM,RSUMSQ,
     1            IBUGG3,ISUBRO,IERROR)
C
C     NOTE: RETURN THE "NORMAL APPROXIMATION" TEST STATISTIC
C
      IF(ICASPL.EQ.'2WTE')THEN
        RIGHT=STATV2
      ELSEIF(ICASPL.EQ.'2WCD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'2W2P')THEN
        RIGHT=PVAL2T
      ELSEIF(ICASPL.EQ.'2WLP')THEN
        RIGHT=PVALLT
      ELSEIF(ICASPL.EQ.'2WUP')THEN
        RIGHT=PVALUT
      ENDIF
      GOTO79000
C
34020 CONTINUE
      CALL DPMNN3(TEMP,NS2,TEMPZ,NSZ,
     1            XTEMP1,XTEMP2,XTEMP3,MAXNXT,
     1            STATVA,STATV1,STATV2,STATV3,STATCD,NTIES,
     1            PVAL2T,PVALLT,PVALUT,
     1            IBUGG3,ISUBRO,IERROR)
C
      IF(ICASPL.EQ.'MWTE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'MWCD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'MW2P')THEN
        RIGHT=PVAL2T
      ELSEIF(ICASPL.EQ.'MWLP')THEN
        RIGHT=PVALLT
      ELSEIF(ICASPL.EQ.'MWUP')THEN
        RIGHT=PVALUT
      ELSEIF(ICASPL.EQ.'MWUS')THEN
        RIGHT=STATV3
      ENDIF
      GOTO79000
C
34030 CONTINUE
      CALL DPKLO3(TEMP,NS2,TEMPZ,NSZ,
     1            XTEMP1,XTEMP2,XTEMP3,MAXNXT,
     1            STATVA,STATCD,PVAL2T,PVALLT,PVALUT,
     1            IBUGG3,ISUBRO,IERROR)
C
      IF(ICASPL.EQ.'KLTE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'KLCD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'KL2P')THEN
        RIGHT=PVAL2T
      ELSEIF(ICASPL.EQ.'KLLP')THEN
        RIGHT=PVALLT
      ELSEIF(ICASPL.EQ.'KLUP')THEN
        RIGHT=PVALUT
      ENDIF
      GOTO79000
C
34035 CONTINUE
      IKRUGS='OFF'
      CALL DPKRU3(TEMP,TEMPZ,NS2,
     1            TEMPZ3,XTEMP1,ITEMP1,MAXOBV,
     1            XTEMP2,XTEMP3,XTEMP3,XTEMP3,XTEMP3,XTEMP3,
     1            STATVA,STATCD,PVAL2T,NUMDF,NUMDIS,S2,
     1            IKRUGS,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'KWTE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'KWCD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'KW2P')THEN
        RIGHT=PVAL2T
      ENDIF
      GOTO79000
C
34040 CONTINUE
      CALL DPSQR3(TEMP,TEMPZ,NS2,
     1            XTEMP1,XTEMP2,XTEMP3,TEMPZ3,MAXNXT,
     1            DTEMP1,DTEMP2,
     1            STATVA,STATCD,PVAL2T,PVALLT,PVALUT,
     1            IDF,NDIST,D2,
     1            IBUGG3,ISUBRO,IERROR)
C
      IF(ICASPL.EQ.'SRTE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'SRCD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'SR2P')THEN
        RIGHT=PVAL2T
      ELSEIF(ICASPL.EQ.'SRLP')THEN
        RIGHT=PVALLT
      ELSEIF(ICASPL.EQ.'SRUP')THEN
        RIGHT=PVALUT
      ENDIF
      GOTO79000
C
34050 CONTINUE
      IHP='XQ  '
      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)
      IF(IERROR.EQ.'YES')THEN
        PMTEQU=0.5
      ELSE
        PMTEQU=VALUE(ILOCP)
        IF(PMTEQU.LE.0.0 .OR. PMTEQU.GE.1.0)PMTEQU=0.5
      ENDIF
      CALL DPMET3(TEMP,TEMPZ,NS2,
     1            XTEMP1,XTEMP2,XTEMP3,PMTEQU,IQUAME,MAXNXT,
     1            XMED,XA,XB,IDF,NDIST,
     1            STATVA,STATCD,PVAL2T,
     1            IBUGG3,ISUBRO,IERROR)
C
      IF(ICASPL.EQ.'METE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'MECD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'ME2P')THEN
        RIGHT=PVAL2T
      ENDIF
      GOTO79000
C
34060 CONTINUE
      MAXOB2=MAXOBV/2
      IINDX=MAXOB2+1
      CALL DPFRI3(TEMP,TEMPZ,TEMPZ3,NS2,
     1            XTEMP1,XTEMP1(IINDX),XTEMP2,XTEMP3,XTEMP3(IINDX),
     1            DTEMP1,
     1            MAXOBV,MAXOB2,
     1            STATVA,STATCD,PVAL2T,
     1            NBLOCK,NTREAT,NUMDF1,NUMDF2,AT1,AT2,A1,C1,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'FZTE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'FZCD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'FZ2P')THEN
        RIGHT=PVAL2T
      ENDIF
      GOTO79000
C
34070 CONTINUE
      MAXOB2=MAXOBV/2
      IINDX=MAXOB2+1
      CALL DPQUT3(TEMP,TEMPZ,TEMPZ3,NS2,
     1            XTEMP1,XTEMP1(IINDX),XTEMP2,XTEMP2(IINDX),
     1            XTEMP3,XTEMP3(IINDX),
     1            DTEMP1,
     1            MAXOBV,MAXOB2,
     1            STATVA,STATCD,PVAL2T,
     1            NBLOCK,NTREAT,NUMDF1,NUMDF2,
     1            AT1,AT2,A1,C1,SSTR,SSTO,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'QUTE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'QUCD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'QU2P')THEN
        RIGHT=PVAL2T
      ENDIF
      GOTO79000
C
34075 CONTINUE
      MAXOB2=MAXOBV/2
      IINDX=MAXOB2+1
      CALL DPPAG3(TEMP,TEMPZ,TEMPZ3,NS2,
     1            XTEMP1,XTEMP1(IINDX),XTEMP2,XTEMP3,XTEMP3(IINDX),
     1            DTEMP1,
     1            MAXOBV,MAXOB2,
     1            STATVA,STATV2,STATCD,PVAL,
     1            NBLOCK,NTREAT,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'PATE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'PAT2')THEN
        RIGHT=STATV2
      ELSEIF(ICASPL.EQ.'PACD')THEN
        RIGHT=STATCD
      ELSEIF(ICASPL.EQ.'PAPV')THEN
        RIGHT=PVAL
      ENDIF
      GOTO79000
C
34080 CONTINUE
      CALL DPINDM(TEMP,NS2,TEMPZ,NSZ,ICASPL,
     1            RIGHT,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
34090 CONTINUE
      ICASE='SUMM'
      ICASE2='DIVE'
      IF(ICASPL.EQ.'SHEI')ICASE2='EQUI'
      CALL SHANDI(TEMP,NS2,IWRITE,RIGHT,XTEMP1,XTEMP2,ICASE,ICASE2,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
34095 CONTINUE
      ICASE='RAW'
      ICASE2='DIVE'
      IF(ICASPL.EQ.'SEII')ICASE2='EQUI'
      CALL SHANDI(TEMP,NS2,IWRITE,RIGHT,XTEMP1,XTEMP2,ICASE,ICASE2,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
34100 CONTINUE
      ICASE='SUMM'
      CALL SIMPDI(TEMP,NS2,IWRITE,RIGHT,XTEMP1,XTEMP2,ICASE,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
34105 CONTINUE
      ICASE='SUMM'
      CALL SIMPDI(TEMP,NS2,IWRITE,RIGHT,XTEMP1,XTEMP2,ICASE,
     1            IBUGG3,ISUBRO,IERROR)
      GOTO79000
C
34110 CONTINUE
      CALL DPJAB3(TEMP,NS2,ISEED,IRANAL,MAXNXT,
     1            XTEMP1,XTEMP2,
     1            XSKEW,XKURT,
     1            STATVA,PVAL,CDF,
     1            CUT25,CUT50,CUT75,CUT80,CUT90,
     1            CUT95,CUT975,CUT99,CUT999,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'JABE')THEN
        RIGHT=STATVA
      ELSEIF(ICASPL.EQ.'JAPV')THEN
        RIGHT=PVAL
      ELSEIF(ICASPL.EQ.'JACD')THEN
        RIGHT=CDF
      ENDIF
      GOTO79000
C
34120 CONTINUE
      IHP='ALPH'
      IHP2='A   '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ALPHA=VALUE(ILOCP)
      IF(ALPHA.GT.1.0 .AND. ALPHA.LT.100.0)THEN
        ALPHA=ALPHA/100.0
        IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
      ELSEIF(ALPHA.GT.0.0 .AND. ALPHA.LT.1.0)THEN
        IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
      ELSE
        ALPHA=0.95
      ENDIF
C
      IF(ICASPL(1:1).EQ.'S')THEN
        YMEAN=TEMP(1)
        YSD=TEMPZ(1)
        NS2=INT(TEMPZ3(1)+0.5)
      ELSE
        CALL MEAN(TEMP,NS2,IWRITE,YMEAN,IBUGG3,IERROR)
        CALL SD(TEMP,NS2,IWRITE,YSD,IBUGG3,IERROR)
      ENDIF
      YSDMEA=YSD/SQRT(REAL(NS2))
C
      PCONF=ALPHA
      IF(ICASPL.EQ.'LCL ' .OR. ICASPL.EQ.'UCL ' .OR.
     1   ICASPL.EQ.'SLCL' .OR. ICASPL.EQ.'SUCL')THEN
        CDF=0.5+(PCONF/2.0)
      ELSEIF(ICASPL.EQ.'1LCL' .OR. ICASPL.EQ.'1UCL' .OR.
     1       ICASPL.EQ.'SLC1' .OR. ICASPL.EQ.'SUC1')THEN
        CDF=PCONF
      ENDIF
      NM1=NS2-1
      CALL TPPF(CDF,REAL(NM1),TVAL)
      TSDM=TVAL*YSDMEA
      ALOWER=YMEAN-TSDM
      AUPPER=YMEAN+TSDM
      IF(ICASPL.EQ.'LCL ' .OR. ICASPL.EQ.'SLCL')THEN
        RIGHT=ALOWER
      ELSEIF(ICASPL.EQ.'UCL ' .OR. ICASPL.EQ.'SUCL')THEN
        RIGHT=AUPPER
      ELSEIF(ICASPL.EQ.'1LCL' .OR. ICASPL.EQ.'SLC1')THEN
        RIGHT=ALOWER
      ELSEIF(ICASPL.EQ.'1UCL' .OR. ICASPL.EQ.'SUC1')THEN
        RIGHT=AUPPER
      ENDIF
      GOTO79000
C
34130 CONTINUE
      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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.GT.1.0 .AND. ALPHA.LT.100.0)THEN
          ALPHA=ALPHA/100.0
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSEIF(ALPHA.GT.0.0 .AND. ALPHA.LT.1.0)THEN
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSE
          ALPHA=0.95
        ENDIF
      ELSE
        ALPHA=0.95
      ENDIF
C
      IHP='NNEW'
      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)
      IF(IERROR.EQ.'NO')THEN
        NNEW=INT(VALUE(ILOCP)+0.5)
      ELSE
        NNEW=1
      ENDIF
      IF(NNEW.LT.1)NNEW=1
C
      IF(ICASPL(1:1).EQ.'S')THEN
        IF(ICASPL.EQ.'SLS2' .OR. ICASPL.EQ.'SUS2' .OR.
     1     ICASPL.EQ.'SLS1' .OR. ICASPL.EQ.'SUS1')THEN
          YSD=TEMP(1)
          NS2=INT(TEMPZ(1)+0.5)
        ELSE
          YMEAN=TEMP(1)
          YSD=TEMPZ(1)
          NS2=INT(TEMPZ3(1)+0.5)
        ENDIF
      ENDIF
C
      ICASA2='LIMI'
      ICASA3='UPPE'
      ICASA4='RAW'
      ICASA5='TWOS'
C
      IF(ICASPL(1:1).EQ.'S')ICASA4='SUMM'
C
      IF(ICASPL.EQ.'LPB ')THEN
        ICASA2='BOUN'
        ICASA3='LOWE'
      ENDIF
      IF(ICASPL.EQ.'UPB ')ICASA2='BOUN'
      IF(ICASPL.EQ.'UPB1')ICASA2='BOUN'
C
      IF(ICASPL.EQ.'LPL1')THEN
        ICASA3='LOWE'
        ICASA5='ONES'
      ENDIF
      IF(ICASPL.EQ.'LPB1')THEN
        ICASA2='BOUN'
        ICASA3='LOWE'
        ICASA5='ONES'
      ENDIF
      IF(ICASPL.EQ.'UPL1')ICASA5='ONES'
      IF(ICASPL.EQ.'UPB1')ICASA5='ONES'
C
      IF(ICASPL.EQ.'SLPB')THEN
        ICASA2='BOUN'
        ICASA3='LOWE'
      ENDIF
      IF(ICASPL.EQ.'SUPB')ICASA2='BOUN'
      IF(ICASPL.EQ.'SUB1')ICASA2='BOUN'
C
      IF(ICASPL.EQ.'SLP1')THEN
        ICASA3='LOWE'
        ICASA5='ONES'
      ENDIF
      IF(ICASPL.EQ.'SLB1')THEN
        ICASA2='BOUN'
        ICASA3='LOWE'
        ICASA5='ONES'
      ENDIF
      IF(ICASPL.EQ.'SUB1')ICASA5='ONES'
      IF(ICASPL.EQ.'SUP1')ICASA5='ONES'
C
      IF(ICASPL.EQ.'UPS1')THEN
        ICASA2='SDLI'
        ICASA5='ONES'
      ELSEIF(ICASPL.EQ.'LPS1')THEN
        ICASA2='SDLI'
        ICASA3='LOWE'
        ICASA5='ONES'
      ELSEIF(ICASPL.EQ.'UPS2')THEN
        ICASA2='SDLI'
      ELSEIF(ICASPL.EQ.'LPS2')THEN
        ICASA2='SDLI'
        ICASA3='LOWE'
      ELSEIF(ICASPL.EQ.'SUS1')THEN
        ICASA2='SDLI'
        ICASA5='ONES'
      ELSEIF(ICASPL.EQ.'SLS1')THEN
        ICASA2='SDLI'
        ICASA3='LOWE'
        ICASA5='ONES'
      ELSEIF(ICASPL.EQ.'SUS2')THEN
        ICASA2='SDLI'
      ELSEIF(ICASPL.EQ.'SLS2')THEN
        ICASA2='SDLI'
        ICASA3='LOWE'
      ENDIF
C
      ALPHAT(1)=ALPHA
      NALPHA=1
      CALL DPPRL3(TEMP,NS2,NNEW,ICASA2,ICASA3,ICASA4,ICASA5,
     1            YMEAN,YSD,
     1            ALPHAT,NALPHA,ALOWLV,AUPPLV,
     1            ISUBRO,IBUGG3,IERROR)
C
      IF(ICASPL.EQ.'LPL ')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'LPB ')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'LPL1')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'LPB1')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'UPL ')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'UPB ')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'UPL1')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'UPB1')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'SLPL')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'SLPB')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'SLP1')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'SLB1')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'SUPL')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'SUPB')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'SUP1')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'SUB1')RIGHT=AUPPLV(1)
C
      IF(ICASPL.EQ.'SUS1')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'SUS2')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'UPS1')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'UPS2')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'SLS1')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'SLS2')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'LPS1')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'LPS2')RIGHT=ALOWLV(1)
C
      GOTO79000
C
34140 CONTINUE
      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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.GT.1.0 .AND. ALPHA.LT.100.0)THEN
          ALPHA=ALPHA/100.0
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSEIF(ALPHA.GT.0.0 .AND. ALPHA.LT.1.0)THEN
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSE
          ALPHA=0.95
        ENDIF
      ELSE
        ALPHA=0.95
      ENDIF
C
      IF(ICASPL(1:1).EQ.'S')THEN
        YSD=TEMP(1)
        NS2=INT(TEMPZ(1)+0.1)
      ENDIF
C
      ICASA2='LIMI'
      ICASA3='UPPE'
      ICASA4='RAW'
      ICASA5='TWOS'
C
      IF(ICASPL(1:1).EQ.'S')ICASA4='SUMM'
C
      IF(ICASPL.EQ.'LCS1')ICASA3='LOWE'
      IF(ICASPL.EQ.'LCS2')ICASA3='LOWE'
      IF(ICASPL.EQ.'SLZ1')ICASA3='LOWE'
      IF(ICASPL.EQ.'SLZ2')ICASA3='LOWE'
C
      IF(ICASPL.EQ.'LCS1')ICASA5='ONES'
      IF(ICASPL.EQ.'UCS1')ICASA5='ONES'
      IF(ICASPL.EQ.'SLZ1')ICASA5='ONES'
      IF(ICASPL.EQ.'SUZ1')ICASA5='ONES'
C
      ALPHAT(1)=ALPHA
      NALPHA=1
      CALL DPSDC3(TEMP,NS2,ICASA2,ICASA3,ICASA4,ICASA5,
     1            YSD,
     1            ALPHAT,NALPHA,ALOWLV,AUPPLV,
     1            ISUBRO,IBUGG3,IERROR)
C
      IF(ICASPL.EQ.'LCS1')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'LCS2')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'SLZ1')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'SLZ2')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'UCS1')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'UCS2')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'SUZ1')RIGHT=AUPPLV(1)
      IF(ICASPL.EQ.'SUZ2')RIGHT=AUPPLV(1)
C
      GOTO79000
C
34145 CONTINUE
      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)
      IF(IERROR.EQ.'NO')THEN
        ALPHA=VALUE(ILOCP)
        IF(ALPHA.GT.1.0 .AND. ALPHA.LT.100.0)THEN
          ALPHA=ALPHA/100.0
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSEIF(ALPHA.GT.0.0 .AND. ALPHA.LT.1.0)THEN
          IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
        ELSE
          ALPHA=0.95
        ENDIF
      ELSE
        ALPHA=0.95
      ENDIF
C
      IHP='N0  '
      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)
      IF(IERROR.EQ.'NO')THEN
        N0=INT(VALUE(ILOCP)+0.5)
      ELSE
        N0=0
      ENDIF
C
      IHP='KURT'
      IHP2='OSIS'
      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.'NO')THEN
        AKURT=VALUE(ILOCP)
      ELSE
        AKURT=CPUMIN
      ENDIF
C
      ICASA3='UPPE'
      ICASA5='TWOS'
      IF(ICASPL.EQ.'BLSD')ICASA3='LOWE'
      ALPHAT(1)=ALPHA
      NALPHA=1
      CALL DPSDR3(TEMP,NS2,ICASA3,ICASA5,MAXNXT,
     1            XTEMP1,AKURT,N0,IBONAD,
     1            YSD,
     1            ALPHAT,NALPHA,ALOWLV,AUPPLV,
     1            ISUBRO,IBUGG3,IERROR)
C
      IF(ICASPL.EQ.'BLSD')RIGHT=ALOWLV(1)
      IF(ICASPL.EQ.'BUSD')RIGHT=AUPPLV(1)
      GOTO79000
C
34150 CONTINUE
      ICASE='STAT'
      IF(ICASPL.EQ.'MWLC')ICASE='CV'
      IF(ICASPL.EQ.'MWPV')ICASE='CV'
      CALL DPMCW3(TEMP,TEMPZ,NS2,
     1            TEMPZ3,XTEMP1,XTEMP2,XTEMP3,DTEMP1,ITEMP1,
     1            ICASE,ISEED,MAXNXT,
     1            STATVA,STATCD,PVAL,CV50,CV90,CV95,
     1            CA,CL,IR,IR1,IMCCR1,IRANAL,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'MWLT')RIGHT=STATVA
      IF(ICASPL.EQ.'MWLC')RIGHT=STATCD
      IF(ICASPL.EQ.'MWPV')RIGHT=PVAL
      IF(ICASPL.EQ.'MW50')RIGHT=CV50
      IF(ICASPL.EQ.'MW90')RIGHT=CV90
      IF(ICASPL.EQ.'MW95')RIGHT=CV95
      GOTO79000
C
34160 CONTINUE
      ICASE='RAW'
      CALL DPPDT3(TEMP,TEMPZ,NS2,ICASE,
     1            STATVA,STATCD,STATNU,PVALUE,
     1            YMEAN,YSD,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'PDTE')RIGHT=STATVA
      IF(ICASPL.EQ.'PDCD')RIGHT=STATCD
      IF(ICASPL.EQ.'PDPV')RIGHT=PVALUE
      GOTO79000
C
34170 CONTINUE
      ICASE='GROU'
      CALL DPPDT3(TEMP,TEMPZ,NS2,ICASE,
     1            STATVA,STATCD,STATNU,PVALUE,
     1            YMEAN,YSD,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'GPDT')RIGHT=STATVA
      IF(ICASPL.EQ.'GPDC')RIGHT=STATCD
      IF(ICASPL.EQ.'GPDP')RIGHT=PVALUE
      GOTO79000
C
34180 CONTINUE
C
      IHP='XMIN'
      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)
      IF(IERROR.EQ.'NO')THEN
        XMIN=VALUE(ILOCP)
      ELSE
        XMIN=CPUMIN
      ENDIF
C
      IHP='XMAX'
      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)
      IF(IERROR.EQ.'NO')THEN
        XMAX=VALUE(ILOCP)
      ELSE
        XMAX=CPUMIN
      ENDIF
C
      IHP='YMIN'
      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)
      IF(IERROR.EQ.'NO')THEN
        YMIN=VALUE(ILOCP)
      ELSE
        YMIN=CPUMIN
      ENDIF
C
      IHP='YMAX'
      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)
      IF(IERROR.EQ.'NO')THEN
        YMAX=VALUE(ILOCP)
      ELSE
        YMAX=CPUMIN
      ENDIF
C
      CALL DPCSR3(TEMP,TEMPZ,NS2,XTEMP1,XTEMP2,
     1            XMIN,XMAX,YMIN,YMAX,
     1            STATVA,
     1            CV01,CV02,CV05,CV10,CV15,CV25,CV50,
     1            CV75,CV85,CV090,CV95,CV98,CV99,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'BCVM')RIGHT=STATVA
      IF(ICASPL.EQ.'BC95')RIGHT=CV95
      IF(ICASPL.EQ.'BC05')RIGHT=CV05
      GOTO79000
C
C     ---------------------------
C
34190 CONTINUE
      CALL DPCSR4(TEMP,TEMPZ,NS2,XTEMP1,XTEMP2,
     1            STATVA,STATCD,PVALUE,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'MNNC')RIGHT=STATVA
      IF(ICASPL.EQ.'MNND')RIGHT=STATCD
      IF(ICASPL.EQ.'MNNP')RIGHT=PVALUE
      GOTO79000
C
34200 CONTINUE
      IF(ICASPL.EQ.'POL1')JINDX=1
      IF(ICASPL.EQ.'POL2')JINDX=2
      IF(ICASPL.EQ.'POL3')JINDX=3
      IF(ICASPL.EQ.'POL4')JINDX=4
      IF(ICASPL.EQ.'POL5')JINDX=5
      IF(ICASPL.EQ.'POC1')JINDX=1
      IF(ICASPL.EQ.'POC2')JINDX=2
      IF(ICASPL.EQ.'POC3')JINDX=3
      IF(ICASPL.EQ.'POC4')JINDX=4
      IF(ICASPL.EQ.'POC5')JINDX=5
      IF(ICASPL.EQ.'POP1')JINDX=1
      IF(ICASPL.EQ.'POP2')JINDX=2
      IF(ICASPL.EQ.'POP3')JINDX=3
      IF(ICASPL.EQ.'POP4')JINDX=4
      IF(ICASPL.EQ.'POP5')JINDX=5
C
      CALL DPCSR5(TEMP,TEMPZ,NS2,JINDX,XTEMP1,
     1            STATVA,STATV2,STATCD,PVALUE,STATNU,
     1            ISUBRO,IBUGG3,IERROR)
C
      IF(ICASPL.EQ.'POL1')RIGHT=STATVA
      IF(ICASPL.EQ.'POL2')RIGHT=STATVA
      IF(ICASPL.EQ.'POL3')RIGHT=STATVA
      IF(ICASPL.EQ.'POL4')RIGHT=STATVA
      IF(ICASPL.EQ.'POL5')RIGHT=STATVA
      IF(ICASPL.EQ.'PO1C')RIGHT=STATCD
      IF(ICASPL.EQ.'PO2C')RIGHT=STATCD
      IF(ICASPL.EQ.'PO3C')RIGHT=STATCD
      IF(ICASPL.EQ.'PO4C')RIGHT=STATCD
      IF(ICASPL.EQ.'PO5C')RIGHT=STATCD
      IF(ICASPL.EQ.'PO1P')RIGHT=PVALUE
      IF(ICASPL.EQ.'PO2P')RIGHT=PVALUE
      IF(ICASPL.EQ.'PO3P')RIGHT=PVALUE
      IF(ICASPL.EQ.'PO4P')RIGHT=PVALUE
      IF(ICASPL.EQ.'PO5P')RIGHT=PVALUE
      GOTO79000
C
34210 CONTINUE
      IHP='XVAL'
      IHP2='UE  '
      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.'NO')THEN
        XVAL=VALUE(ILOCP)
        CALL VALCNT(TEMP,NS2,XVAL,IWRITE,RIGHT,ISUBRO,IBUGG3,IERROR)
      ELSE
        RIGHT=0.0
      ENDIF
C
      GOTO79000
C
34220 CONTINUE
      CALL VARDIS(TEMP,NS2,IWRITE,VDIST,RDI,CHISQ,
     1            ICASPL,ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'VDIS')RIGHT=VDIST
      IF(ICASPL.EQ.'RDI ')RIGHT=RDI
      IF(ICASPL.EQ.'UCHS')RIGHT=CHISQ
      GOTO79000
C
34230 CONTINUE
      CALL DPCWS3(TEMP,TEMPZ,NS2,IWRITE,ISEED,MINMAX,MAXNXT,
     1            XTEMP1,DTEMP2,XTEMP2,XTEMP3,TEMPZ3,DTEMP1,
     1            STATVA,STATCD,PVALUE,NDIST,NGROUP,
     1            CV90,CV95,CV99,BETACM,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASPL.EQ.'WSHT')RIGHT=STATVA
      IF(ICASPL.EQ.'WSCD')RIGHT=STATCD
      IF(ICASPL.EQ.'WSHP')RIGHT=PVALUE
      IF(ICASPL.EQ.'WS90')RIGHT=CV90
      IF(ICASPL.EQ.'WS95')RIGHT=CV95
      IF(ICASPL.EQ.'WS99')RIGHT=CV99
      GOTO79000
C
34240 CONTINUE
      CALL DPKAR3(TEMP,NS2,XTEMP1,MAXNXT,
     1            STATVA,CUTOFF,
     1            ISUBRO,IBUGG3,IERROR)
      RIGHT=STATVA
      IF(ICASPL.EQ.'KARC')RIGHT=CUTOFF
      GOTO79000
C
34260 CONTINUE
      ICASAN='UPPE'
      IF(ICASPL.EQ.'CV05')ICASAN='LOWE'
      IF(ICASPL.EQ.'CV01')ICASAN='LOWE'
      IF(ICASPL.EQ.'CMVC')ICASAN='LOWE'
      IF(ICASPL.EQ.'CMVP')ICASAN='LOWE'
      IF(ICASPL.EQ.'CVMO')ICASAN='LOWE'
      CALL DPCVO3(TEMP,TEMPZ,NS2,ICASAN,
     1            XTEMP1,XTEMP2,XTEMP3,TEMPZ3,ITEMP1,
     1            STATVA,STATV2,STATCU,STATCL,PVALU,PVALL,
     1            ALPHAV,CV,NUMALZ,
     1            IDF1,IDF2,ILABMX,ILABMN,NUMDIS,NGROUP,
     1            DVARTO,VARMAX,VARMIN,
     1            IBUGG3,ISUBRO,IERROR)
      RIGHT=STATVA
      IF(ICASPL.EQ.'CV95')RIGHT=CV(11)
      IF(ICASPL.EQ.'CV99')RIGHT=CV(13)
      IF(ICASPL.EQ.'CVCD')RIGHT=STATCU
      IF(ICASPL.EQ.'CVPV')RIGHT=PVALU
      IF(ICASPL.EQ.'CV01')RIGHT=CV(3)
      IF(ICASPL.EQ.'CV05')RIGHT=CV(5)
      IF(ICASPL.EQ.'CVMO')RIGHT=STATV2
      IF(ICASPL.EQ.'CMVC')RIGHT=STATCL
      IF(ICASPL.EQ.'CMVP')RIGHT=PVALL
      GOTO79000
C
34270 CONTINUE
      CALL DPEQS3(TEMP,TEMPZ,TEMPZ3,NS2,MAXNXT,
     1            XTEMP1,XTEMP2,XTEMP3,
     1            DTEMP1(1),DTEMP1(10000),DTEMP1(20000),
     1            DTEMP1(30000),DTEMP1(40000),
     1            DTEMP1(50000),DTEMP1(60000),ITEMP1,
     1            NUMSLO,ICASEE,
     1            STATVA,STATCD,PVAL2T,
     1            STATV1,STATC1,PVAL1,
     1            STATV2,STATC2,PVAL2,
     1            STATV3,STATC2,PVAL3,
     1            CV80,CV90,CV95,CV99,
     1            CV180,CV190,CV195,CV199,
     1            CV280,CV290,CV295,CV299,
     1            CV380,CV390,CV395,CV399,
     1            IBUGG3,ISUBRO,IERROR)
      IF(ICASEE.EQ.'3ORMORE')THEN
        RIGHT=STATV2
        IF(ICASPL.EQ.'ESCD')RIGHT=STATC2
        IF(ICASPL.EQ.'ESCV')RIGHT=CV295
        IF(ICASPL.EQ.'ESPV')RIGHT=PVAL2
      ELSE
        RIGHT=STATVA
        IF(ICASPL.EQ.'ESCD')RIGHT=STATCD
        IF(ICASPL.EQ.'ESCV')RIGHT=CV95
        IF(ICASPL.EQ.'ESPV')RIGHT=PVAL2T
      ENDIF
      GOTO79000
C
34280 CONTINUE
C
      IHP='GAMM'
      IHP2='A0  '
      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')THEN
          RIGHT=0.0
          GOTO9000
      ELSE
        GAMMA0=VALUE(ILOCP)
      ENDIF
C
      ICASA3='RAW'
      CALL DPCVT3(TEMP,TEMPZ,ITEMP1,NS2,GAMMA0,IWRITE,ICASA3,
     1            XTEMP1,XTEMP2,
     1            NDIST,NGROUP,YMEAN,YSD,YCV,
     1            STATVA,STATCD,STATNU,
     1            PVAL2T,PVALLT,PVALUT,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'1CTE')RIGHT=STATVA
      IF(ICASPL.EQ.'1CCD')RIGHT=STATCD
      IF(ICASPL.EQ.'1C2P')RIGHT=PVAL2T
      IF(ICASPL.EQ.'1CLP')RIGHT=PVALLT
      IF(ICASPL.EQ.'1CUP')RIGHT=PVALUT
C
      GOTO79000
C
34290 CONTINUE
C
      IHP='GAMM'
      IHP2='A0  '
      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')THEN
          RIGHT=0.0
          GOTO9000
      ELSE
        GAMMA0=VALUE(ILOCP)
      ENDIF
C
      ICASA3='SUMM'
      DO34291II=1,NS2
        ITEMP1(II)=INT(TEMPZ3(II)+0.5)
34291 CONTINUE
      CALL DPCVT3(TEMP,TEMPZ,ITEMP1,NS2,GAMMA0,IWRITE,ICASA3,
     1            XTEMP1,XTEMP2,
     1            NDIST,NGROUP,YMEAN,YSD,YCV,
     1            STATVA,STATCD,STATNU,
     1            PVAL2T,PVALLT,PVALUT,
     1            ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'S1CT')RIGHT=STATVA
      IF(ICASPL.EQ.'S1CC')RIGHT=STATCD
      IF(ICASPL.EQ.'S1CP')RIGHT=PVAL2T
C
      GOTO79000
C
34300 CONTINUE
      DO34301II=1,NS2
        TEMPZ3(II)=1.0
34301 CONTINUE
      DO34303II=1,NSZ
        XTEMP3(II)=1.0
34303 CONTINUE
      IF(ICVTTE.EQ.'MILL')THEN
        CALL DPCVT6(TEMP,NS2,TEMPZ,NSZ,IWRITE,
     1              YMEAN1,YSD1,CV1,YMEAN2,YSD2,CV2,
     1              STATVA,STATCD,PVAL2T,PVALLT,PVALUT,
     1              ISUBRO,IBUGG3,IERROR)
      ELSE
        CALL DPCVT4(TEMP,TEMPZ3,NS2,TEMPZ,XTEMP3,NSZ,IWRITE,
     1              XTEMP1,XTEMP2,NGROU1,NGROU2,
     1              YMEAN1,YSD1,CV1,YMEAN2,YSD2,CV2,
     1              STATVA,STATCD,STATN1,STATN2,
     1              PVAL2T,PVALLT,PVALUT,
     1              ISUBRO,IBUGG3,IERROR)
      ENDIF
      IF(ICASPL.EQ.'2CTE')RIGHT=STATVA
      IF(ICASPL.EQ.'2CCD')RIGHT=STATCD
      IF(ICASPL.EQ.'2C2P')RIGHT=PVAL2T
      IF(ICASPL.EQ.'2CLP')RIGHT=PVALLT
      IF(ICASPL.EQ.'2CUP')RIGHT=PVALUT
      GOTO79000
C
C     ---------------------------
C
79000 CONTINUE
      NS2=NS2SAV
      NSZ=NSZSAV
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IPRINT=IPRSAV
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PSTA')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF CMPST2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IBUGG3,ISUBRO
 9012   FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)ICASPL,NS2,IERROR
 9013   FORMAT('ICASPL,NS2,IERROR = ',A4,I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)NUMV2,RIGHT
 9014   FORMAT('NUMV2,RIGHT = ',I8,E15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END