      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*ALOG(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*ALOG(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'
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      DATA 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
CCCCC IERR2=0
      IF (NTERM.NE.0) GO TO 10
C
      NTERM = -0.30*ALOG(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(ALOG(R1MACH(2)/12.0), -ALOG(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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
CCCCC 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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      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 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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89.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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      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
      PLOCAL=0.33333
      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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2002.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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      DATA 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)
      REAL CPUMAX, CPUMIN
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA 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)
      REAL CPUMAX, CPUMIN
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      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
 9000 CONTINUE
      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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C---------------------------------------------------------------------
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 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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C---------------------------------------------------------------------
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 CAUPPC(X,N,IWRITE,Y,W,MAXNYW,PPCC,IBUGA3,IERROR)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CAUCHY
C              PROBABILITY PLOT CORRELATION COEFFICIENT.
C              THE PROTOTYPE CAUCHY DISTRIBUTION USED HEREIN
C              HAS 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              AS USED HEREIN, A PROBABILITY PLOT FOR A DISTRIBUTION
C              IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS
C              THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION.
C              THE CAUCHY PROBABILITY PLOT IS USEFUL IN
C              GRAPHICALLY TESTING THE COMPOSITE (THAT IS,
C              LOCATION AND SCALE PARAMETERS NEED NOT BE SPECIFIED)
C              HYPOTHESIS THAT THE UNDERLYING DISTRIBUTION
C              FROM WHICH THE DATA HAVE BEEN RANDOMLY DRAWN
C              IS THE CAUCHY DISTRIBUTION.
C              IF THE HYPOTHESIS IS TRUE, THE PROBABILITY PLOT
C              SHOULD BE NEAR-LINEAR.
C              A MEASURE OF SUCH LINEARITY IS GIVEN BY THE
C              CALCULATED PROBABILITY PLOT CORRELATION COEFFICIENT.
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     OUTPUT ARGUMENTS--PPCC   = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED CAUCHY PPCC.
C     OUTPUT--NONE.
C     PRINTING--YES.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, SIN, COS.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--FILLIBEN, 'TECHNIQUES FOR TAIL LENGTH ANALYSIS',
C                 PROCEEDINGS OF THE EIGHTEENTH CONFERENCE
C                 ON THE DESIGN OF EXPERIMENTS IN ARMY RESEARCH
C                 DEVELOPMENT AND TESTING (ABERDEEN, MARYLAND,
C                 OCTOBER, 1972), PAGES 425-450.
C               --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING,
C                 1967, PAGES 260-308.
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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--JULY      1972.
C     UPDATED         --JULY      1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  MISPLACED PARAM. STATEMENT (ALAN)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
      DIMENSION Y(*)
      DIMENSION W(*)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA PI/3.14159265359/
C
C-----START POINT-----------------------------------------------------
C
C
      IERROR='NO'
      IUPPER=MAXOBV
C
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF CAUPPC--')
      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 ')
      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 CAUCHY                            **
C               **  PROBABILITY PLOT CORRELATION COEFFICIENT  **
C               ************************************************
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      AN=N
C
      IF(1.LE.N.AND.N.LE.IUPPER)GOTO119
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
  111 FORMAT('***** ERROR IN CAUPPC--')
      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 CAUCHY PROBABILITY PLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,115)
  115 FORMAT('      CORRELATION COEFFICIENT IS TO BE COMPUTED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,116)IUPPER
  116 FORMAT('      MUST BE BETWEEN 1 AND ',I8,' (INCLUSIVELY).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,117)
  117 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,118)N
  118 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS HERE = ',I8,
     1'.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
  119 CONTINUE
C
      IF(N.EQ.1)GOTO120
      GOTO129
  120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,121)
  121 FORMAT('***** NON-FATAL DIAGNOSTIC IN CAUPPC--',
     1'THE 2ND INPUT ARGUMENT (N) HAS THE VALUE 1')
      CALL DPWRST('XXX','BUG ')
      PPCC=0.0
      GOTO9000
  129 CONTINUE
C
      HOLD=X(1)
      DO135I=2,N
      IF(X(I).NE.HOLD)GOTO139
  135 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,136)HOLD
  136 FORMAT('***** NON-FATAL DIAGNOSTIC IN CAUPPC--',
     1'THE 1ST INPUT ARGUMENT (A VECTOR) HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      PPCC=0.0
      GOTO9000
  139 CONTINUE
C
  190 CONTINUE
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  COMPUTE THE CAUCHY                         **
C               **  PROBABILITY PLOT CORRELATION COEFFICIENT.  **
C               *************************************************
C
      CALL SORT(X,N,Y)
C
      CALL UNIMED(N,W)
C
      DO200I=1,N
      ARG=PI*W(I)
      W(I)=-COS(ARG)/SIN(ARG)
  200 CONTINUE
C
      SUM1=0.0
      DO300I=1,N
      SUM1=SUM1+Y(I)
  300 CONTINUE
      YBAR=SUM1/AN
      WBAR=0.0
C
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO400I=1,N
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR)
      SUM2=SUM2+(W(I)-WBAR)*(Y(I)-YBAR)
      SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR)
  400 CONTINUE
      PPCC=SUM2/SQRT(SUM3*SUM1)
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)
  811 FORMAT('THE CAUCHY PROBABILITY PLOT CORRELATION COEFFICIENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,812)N,PPCC
  812 FORMAT('OF THE ',I8,' OBSERVATIONS = ',E15.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 CAUPPC--')
      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)SUM1,SUM2,SUM3
 9014 FORMAT('SUM1,SUM2,SUM3 = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PPCC
 9015 FORMAT('PPCC = ',E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----DATA STATEMENTS-----------------------------------------------------
C
      DATA 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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA 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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C---------------------------------------------------------------------
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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      COMPLEX A, B, CGAMMA, CLBETA, CEXP
      DATA XMAX / 0.0 /
C***FIRST EXECUTABLE STATEMENT  CBETA
      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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98.11
C     ORIGINAL VERSION--NOVEMBER  1998.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      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'
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      DATA SQEPS /0./
C***FIRST EXECUTABLE STATEMENT  CCOT
      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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      REAL CPUMIN
      REAL CPUMAX
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
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
      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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      REAL CPUMIN
      REAL CPUMAX
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
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(MAXIMX,MAXJMX)
      DIMENSION X(*)
      DIMENSION Y(*)
      DIMENSION XC(*)
      DIMENSION YC(*)
      DIMENSION BOX(4,MAXIMX,MAXJMX)
C
      DIMENSION XP(3)
      DIMENSION YP(3)
      DIMENSION LP(3)
C
C-----START POINT-----------------------------------------------------
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 CFFT2D(N,F,LDF,W,FORWD)
C***BEGIN PROLOGUE  CFFT2D
C***DATE WRITTEN   870811   (YYMMDD)
C***REVISION DATE  870811   (YYMMDD)
C***CATEGORY NO.  J1B
C***KEYWORDS  TWO DIMENSIONAL FOURIER TRANSFORM, FFT
C***AUTHOR  KAHANER, DAVID K., (NBS) 
C***PURPOSE  Two dimensional complex fast Fourier transform.
C***DESCRIPTION
C           From the book, "Numerical Methods and Software" by
C                D. Kahaner, C. Moler, S. Nash
C                Prentice Hall, 1988
C       Two dimensional fast Fourier transform, forward or backward
C          of complex N*N matrix F.
C
C   Input: 
C     N: (INTEGER)        Number of rows and columns in the matrix F to be
C                            transformed. You must set N > 0, NOT CHECKED.
C     F: (COMPLEX)        Array of N*N complex values to be transformed.
C                            This array is overwritten on output.
C     LDF: (INTEGER)       Leading (first) dimension of the complex array F 
C                             in the subroutine that calls CFFT2D. For example,
C                             if you declare F by either
C                               COMPLEX F(0:15,0:20)  OR  F(16,21) then
C                             set LDF=16. You must have LDF >= N, NOT CHECKED.  
C     W: (COMPLEX)         Array for internal use as work storage.
C                             Must be dimensioned by calling program to be
C                             at least 6N+15 REAL words or 3N+8 COMPLEX words.
C     FORWD: (LOGICAL)     Direction of transform. Set to .TRUE. for
C                            forward transform, set to .FALSE. for backward
C                            transform.
C
C
C   Output:
C     F: (COMPLEX)         Forward or reverse transformed input matrix.
C                          Output is unscaled, that is, a call to CFFT2D
C                          with FORWD=.TRUE. followed by a call to CFFT2D
C                          with FORWD=.FALSE. returns original data 
C                          multiplied by N*N.
C
C
C   Remark:
C     For some applications it is desirable to have the transform scaled so
C        the center of the N by N frequency square corresponds to zero
C        frequency. The user can do this replacing the original input data
C        F(I,J) by F(I,J)*(-1.)**(I+J),  I,J =0,...,N-1.
C
C
C***REFERENCES  (NONE)
C***ROUTINES CALLED CFFTI, CFFTF, CFFTB
C***END PROLOGUE  CFFT2D
      COMPLEX F(0:LDF-1,0:*), W(0:*)
      LOGICAL FORWD
C***FIRST EXECUTABLE STATEMENT  CFFT2D
C   Find transform of each row, then of each column
C   First row transforms
      CALL CFFTI(N,W(N))
      DO 10 I=0,N-1
C         Place row in beginning of array W
            DO 5 J=0,N-1
               W(J) = F(I,J)
    5       CONTINUE
C         Compute fft of row
            IF(FORWD) THEN
               CALL CFFTF(N,W,W(N))
            ELSE
               CALL CFFTB(N,W,W(N))
            ENDIF
C         Copy back to row of f
            DO 6 J=0,N-1
               F(I,J)=W(J)
    6       CONTINUE          
   10 CONTINUE
C   Column transforms
      DO 20 J=0,N-1
C         Pass column of F to CFFTF or CFFTB by passing F(0,J). 
C         Similarly CFFTF or CFFTB places results back there.
            IF(FORWD) THEN
               CALL CFFTF(N, F(0,J), W(N))
            ELSE
               CALL CFFTB(N, F(0,J), W(N))
            ENDIF
   20 CONTINUE
      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 
      DIMENSION       CH(*)      ,C(*)       ,WA(*)      ,IFAC(*)
C***FIRST EXECUTABLE STATEMENT  CFFTB1  
      NF = IFAC(2)  
      NA = 0   
      L1 = 1   
      IW = 1   
      DO 116 K1=1,NF
         IP = IFAC(K1+2) 
         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 
      DIMENSION       CH(*)      ,C(*)       ,WA(*)      ,IFAC(*)
C***FIRST EXECUTABLE STATEMENT  CFFTF1  
      NF = IFAC(2)  
      NA = 0   
      L1 = 1   
      IW = 1   
      DO 116 K1=1,NF
         IP = IFAC(K1+2) 
         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   
      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 
      DIMENSION       WA(*)      ,IFAC(*)    ,NTRYH(4) 
      DATA NTRYH(1),NTRYH(2),NTRYH(3),NTRYH(4)/3,4,2,5/
C***FIRST EXECUTABLE STATEMENT  CFFTI1  
      NL = N   
      NF = 0   
      J = 0    
  101 J = J+1  
      IF (J-4) 102,102,103    
  102 NTRY = NTRYH(J)    
      GO TO 104
  103 NTRY = NTRY+2 
  104 NQ = NL/NTRY  
      NR = NL-NTRY*NQ    
      IF (NR) 101,105,101
  105 NF = NF+1
      IFAC(NF+2) = 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) = 2   
  107 IF (NL .NE. 1) GO TO 104
      IFAC(1) = N   
      IFAC(2) = NF  
      TPI = 8.*ATAN(1.)  
      ARGH = TPI/REAL(N) 
      I = 2    
      L1 = 1   
      DO 110 K1=1,NF
         IP = IFAC(K1+2) 
         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'
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      DATA ZERO,HALF/ 0.0 D 0 , 0.5 D 0 /
      DATA TEST,TWO/ 0.6 D 0 , 2.0 D 0 /
      U1 = 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)
        PI=3.141592653589793D0
        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/
        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)
10         GI=GI-A(K)*T*DSIN((2.0D0*K-1.0D0)*TH)
        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)
15            GI1=GI1+DATAN(Y/(X+J))
           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
      CHARACTER*4 IFEEDB
      CHARACTER*4 ICOUTINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,ICOUTINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
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
      CHARACTER*4 IFEEDB
      CHARACTER*4 ICOUTINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,ICOUTINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
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 CHEDIS(AMAT,AMAT2,MAXROM,MAXCOM,NR1,NC1,ICASE,IWRITE,
     1IBUGA3,IERROR)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              CHEBYCHEV DISTANCE OF A MATRIX.  THE FORMULA IS:
C                 Dij=MAX|(Xik - Xjk)|
C              THE MAXIMUM IS FROM K = 1 TO P (WHERE THERE ARE P
C              COLUMNS IN THE MATRIX).  FOR EXAMPLE, D23 IS
C              THE DISTANCE BETWEEN THE SECOND AND THIRD ROWS.
C              (ALTERNATIVELY, THE DISTANCE CAN BE CALCULATED
C              ACROSS COLUMNS).
C              THIS IS ALSO CALLED THE L INFINITY NORM DISTANCE
C              OR THE MAXIMUM DIFFERENCE DISTANCE.
C     INPUT  ARGUMENTS--AMAT   = THE SINGLE PRECISION MATRIX
C                     --MAXROM = THE INTEGER ROW DIMENSION OF AMAT
C                     --MAXCOM = THE INTEGER COUMN DIMENSION OF AMAT
C                     --NR1    = THE INTEGER NUMBER OF ROWS OF AMAT
C                     --NC1    = THE INTEGER NUMBER OF COLUMNS OF AMAT
C     OUTPUT ARGUMENTS--AMAT2    = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE CHEBYCHEV DISTANCES.
C     OUTPUT--MATRIX OF CHEBYCHEV DISTANCES
C     NOTE--THIS ROUTINE ASSUMES THE ERROR CHECKING (FOR EQUAL
C           ROWS AND COLUMNS, MATCHING DIMENSIONS FOR X AND AMAT)
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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98.7
C     ORIGINAL VERSION--JULY      1998.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASE
      CHARACTER*4 IWRITE
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DSUM
      DOUBLE PRECISION DYM1
      DOUBLE PRECISION DYM2
      DOUBLE PRECISION DTEMP
C
      DIMENSION AMAT(MAXROM,MAXCOM)
      DIMENSION AMAT2(MAXROM,MAXCOM)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF CHEDIS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NR1,NC1
   53 FORMAT('NR1, NC1 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ICASE
   54 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************
C               **  COMPUTE CHEBYCHEV DISTANCE *
C               ********************************
C
      IF(ICASE.EQ.'ROW ')THEN
        DO5861I=1,NR1
          DO5863J=1,I
            IF(I.EQ.J)THEN
              AMAT2(I,I)=0.0
            ELSE
              DSUM=0.0D0
              DO5865K=1,NC1
                DYM1=AMAT(I,K)
                DYM2=AMAT(J,K)
                DTEMP=DABS(DYM1-DYM2)
                IF(DTEMP.GT.DSUM)DSUM=DTEMP
 5865         CONTINUE
              AMAT2(I,J)=REAL(DSUM)
              AMAT2(J,I)=AMAT2(I,J)
            ENDIF
 5863     CONTINUE
 5861   CONTINUE
      ELSEIF(ICASE.EQ.'COLU')THEN
        DO5961I=1,NC1
          DO5963J=1,I
            IF(I.EQ.J)THEN
              AMAT2(I,I)=0.0
            ELSE
              DSUM=0.0D0
              DO5965K=1,NR1
                DYM1=AMAT(K,I)
                DYM2=AMAT(K,J)
                DTEMP=DABS(DYM1-DYM2)
                IF(DTEMP.GT.DSUM)DSUM=DTEMP
 5965         CONTINUE
              AMAT2(I,J)=REAL(DSUM)
              AMAT2(J,I)=AMAT2(I,J)
            ENDIF
 5963     CONTINUE
 5961   CONTINUE
      ENDIF
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)
  811 FORMAT('THE CHEBYCHEV DISTANCE MATRIX HAS BEEN CALCULATED.')
      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 CHEDIS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA3,IERROR
 9012 FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--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'
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----DATA STATEMENTS-------------------------------------------------
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(ANU.LE.0)GOTO50
      IF(X.LT.0.0)GOTO55
      GOTO90
   50 WRITE(ICOUT,15)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,47)ANU
      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
    4 FORMAT('***** NON-FATAL DIAGNOSTIC--THE 1ST INPUT ARGUMENT ',
     1'TO THE CHCDF SUBROUTINE IS NEGATIVE *****')
   15 FORMAT('***** FATAL ERROR--THE 2ND INPUT ARGUMENT TO THE ',
     1'CHCDF SUBROUTINE IS NON-POSITIVE *****')
   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
C
   90 CONTINUE
      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
      RETURN
      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)
        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
10            HG=HG+R
        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
20               SUM2=SUM2+R2
              HG1=TB/TBA*X**(-A)*DCOS(PI*A)*SUM1
              HG2=TB/TA*DEXP(X)*X**(A-B)*SUM2
              HG=HG1+HG2
           ENDIF
25         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
35            A=A+1.0D0
        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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----DATA STATEMENTS-------------------------------------------------
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(ANU.LE.0)GOTO50
      IF(X.LE.0.0)GOTO55
      GOTO90
   50 WRITE(ICOUT,15)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,46)ANU
      CALL DPWRST('XXX','BUG ')
      PDF=0.0
      RETURN
   55 WRITE(ICOUT,4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,46)X
      CALL DPWRST('XXX','BUG ')
      PDF=0.0
      RETURN
    4 FORMAT('***** NON-FATAL DIAGNOSTIC--THE 1ST INPUT ARGUMENT ',
     1'TO THE CHPDF SUBROUTINE IS NEGATIVE *****')
   15 FORMAT('***** FATAL ERROR--THE 2ND INPUT ARGUMENT TO THE ',
     1'CHPDF SUBROUTINE IS NON-POSITIVE *****')
   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
C
   90 CONTINUE
      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('***** FATAL 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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--95/4
C     ORIGINAL VERSION--APRIL     1995.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      REAL NU
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      DATA EPS /0.00001/
      DATA SIG /1.0E-6/
      DATA ZERO /0./
      DATA MAXIT /500/
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LT.0.0.OR.P.GE.1.0)GOTO50
      IF(NU.LE.0.0)GOTO55
      GOTO90
   50 WRITE(ICOUT,1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,46)P
      CALL DPWRST('XXX','BUG ')
      PPF=0.0
      RETURN
   55 WRITE(ICOUT,11)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,46)NU
      CALL DPWRST('XXX','BUG ')
      PPF=0.0
      GOTO9999
C
    1 FORMAT('***** FATAL ERROR--THE 1ST INPUT ARGUMENT TO THE ',
     1' CHPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL.')
   11 FORMAT('***** FATAL ERROR--THE 2ND INPUT ARGUMENT TO THE ',
     1' CHPPF SUBROUTINE IS LESS THAN OR EQUAL TO 0.')
   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I15,' *****')
C
   90 CONTINUE
C
C  FIND BRACKETING INTERVAL.
C
      XL=0.0
      XINC=20.0
      ICOUNT=0
      MAXCNT=10000
C
   91 CONTINUE
      XR=XL+XINC
      IF(XL.LE.0.0)XL=0.0
      IF(XR.LE.0.0)XR=XL+1.0
      CALL CHCDF(XL,NU,CDFL)
      CALL CHCDF(XR,NU,CDFR)
      IF(CDFL.LT.P .AND. CDFR.LT.P)THEN
        XL=XR
      ELSEIF(CDFL.GT.P .AND. CDFR.GT.P)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('***** FATAL ERROR--CHPPF UNABLE TO FIND BRACKETING ',
     *       'INTERVAL. *****')
      GOTO91
C
C  BISECTION METHOD
C
   99 CONTINUE
      IC = 0
      FXL = -P
      FXR = 1.0 - P
  105 CONTINUE
      X = (XL+XR)*0.5
      CALL CHCDF(X,NU,CDF)
      P1=CDF
      PPF=X
      FCS = P1 - P
      IF(FCS*FXL.GT.ZERO)GOTO110
      XR = X
      FXR = FCS 
      GOTO115
  110 CONTINUE
      XL = X
      FXL = FCS
  115 CONTINUE
      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('***** FATAL 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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--2003.7
C     ORIGINAL VERSION--JULY      2003.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)THEN
        WRITE(ICOUT, 5)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,47)N
        CALL DPWRST('XXX','BUG ')
        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('***** FATAL ERROR--THE REQUESTED NUMBER OF CHI RANDOM',
     1       ' NUMBERS IS NON-POSITIVE.')
   15 FORMAT('***** FATAL ERROR--THE DEGREES OF FREEDOM PARAMETER FOR',
     1       ' CHI RANDOM NUMBERS IS NON-POSITIVE.')
   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
   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,
     1IERROR)
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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER 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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(MINNA.LE.NUMARG.AND.NUMARG.LE.MAXNA)GOTO1200
C
 1100 CONTINUE
      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)WRITE(ICOUT,1126)(IANS(I),I=1,IWIDTH)
 1126 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      RETURN
C
 1200 CONTINUE
      IERROR='NO'
      RETURN
C
      END
      SUBROUTINE CHECKF(IHWORD,IHWOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2002/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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      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='PARAMETER'
          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)
   51   FORMAT('***** VARIABLE ',A4,A4,' FOUND AS A ',A8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      RETURN
C
      END
      SUBROUTINE CHECKN(IHWORD,IHWOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER 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
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
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(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 CHECKN 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
      GOTO750
C
  750 CONTINUE
      ILOC=0
      IERROR='YES'
      RETURN
C
  800 CONTINUE
      ILOC=I2
      IERROR='NO'
      RETURN
C
      END
      SUBROUTINE CHECN2(IHTEST,IHTES2,ITTEST,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,IN,NUMNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,
     1JVALUE,AVALUE,JUSE,JN,
     1IOLDNA,IOLDN2,IOLDNI,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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C     ????? I
      I=(-999)
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'ECN2')GOTO90
      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
   52 FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IHTEST,IHTES2,ITTEST
   53 FORMAT('IHTEST,IHTES2,ITTEST = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMNAM
   54 FORMAT('NUMNAM = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)
   55 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I),',
     1'IN(I)--')
      CALL DPWRST('XXX','BUG ')
      DO56I=1,NUMNAM
      WRITE(ICOUT,57)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I),
     1IN(I)
   57 FORMAT(I8,2X,A4,2X,A4,2X,A4,I8,F15.7,I8)
      CALL DPWRST('XXX','BUG ')
   56 CONTINUE
      WRITE(ICOUT,61)IWIDTH
   61 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)(IANS(I),I=1,IWIDTH)
   62 FORMAT('IANS(.) = ',100A1)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
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 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.
          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.) GO TO 55
C         IF(AMU.EQ.0.)
C         THEN
            AMU=1.0
            GO TO 60
C         ELSE
   55       AMU=AMU*(1.0+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.
          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.
      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.
        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.
          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.0
          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 )
      JJ = 0
      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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA 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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
C               ********************************************
C               **  STEP 1--                              **
C               **  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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA 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
      IF(P.LT.0.0.OR.P.GE.1.0)GOTO50
      IF(NU.LT.1)GOTO55
      GOTO90
   50 WRITE(ICOUT,1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,46)P
      CALL DPWRST('XXX','BUG ')
      PPF=0.0
      RETURN
   55 WRITE(ICOUT,15)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,47)NU
      CALL DPWRST('XXX','BUG ')
      PPF=0.0
      RETURN
   90 CONTINUE
    1 FORMAT('***** FATAL ERROR--THE 1ST INPUT ARGUMENT TO THE ',
     1'CHSPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL')
   15 FORMAT('***** FATAL ERROR--THE 2ND INPUT ARGUMENT TO THE ',
     1'CHSPPF SUBROUTINE IS NON-POSITIVE *****')
   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8   ,' *****')
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
      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--ALOG, 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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA 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*ALOG(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,IBUGA3)
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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/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
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION IFOUNZ(*)
      DIMENSION IBEGIN(*)
      DIMENSION IANS(*)
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPARIT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IFOUNZ(11),IBEGIN(11)
   52 FORMAT('IFOUNZ(11),IBEGIN(11) = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IFOUNZ(21),IBEGIN(21)
   53 FORMAT('IFOUNZ(21),IBEGIN(21) = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IWIDTH
   61 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)
     1WRITE(ICOUT,62)(IANS(I),I=1,80)
   62 FORMAT('IANS(.) = ',80A1)
      IF(IWIDTH.GE.1)
     1CALL DPWRST('XXX','BUG ')
   90 CONTINUE
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.'OFF')GOTO9090
      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 ')
 9090 CONTINUE
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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/11
C     ORIGINAL VERSION--NOVEMBER  1998.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--AUGUST    1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JUNE      1987.
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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
C               *************************
C               **  CHECK FOR 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 CKFIT--')
      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 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='FIT'
C
CCCCC IF(ICOM.EQ.'FIT')GOTO110
      IF(ICOM.EQ.'FIT')GOTO1100
      GOTO1190
C
 1100 CONTINUE
      IF(NUMARG.LE.0)GOTO1190
      DO1110I=1,NUMARG
      IF(IHARG(I).EQ.'=')GOTO1120
      IF(IHARG(I).EQ.'SUBS'.AND.IHARG2(I).EQ.'ET  ')GOTO1130
      IF(IHARG(I).EQ.'EXCE'.AND.IHARG2(I).EQ.'PT  ')GOTO1130
      IF(IHARG(I).EQ.'FOR '.AND.IHARG2(I).EQ.'    ')GOTO1130
 1110 CONTINUE
      GOTO1130
 1120 CONTINUE
      ICASFI='FIT'
      GOTO110
 1130 CONTINUE
      ICASFI='MFIT'
      GOTO110
 1190 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.'FIT')GOTO112
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.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'0TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'ZERO'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'0'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'0'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'ZERO'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'CONS'.AND.IHARG(1).EQ.'FIT')GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RECT'.AND.IHARG(1).EQ.'FIT')GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'FLAT'.AND.IHARG(1).EQ.'FIT')GOTO111
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.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'1ST'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'FIRS'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'1'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'ONE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'1'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'ONE'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'LINE'.AND.IHARG(1).EQ.'FIT')GOTO111
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.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'2ND'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SECO'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'2'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'TWO'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'2'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'TWO'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'QUAD'.AND.IHARG(1).EQ.'FIT')GOTO111
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.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'3RD'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'THIR'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'3'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'THRE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'3'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'THRE'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'CUBI'.AND.IHARG(1).EQ.'FIT')GOTO111
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.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'4TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'FOUR'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'4'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'FOUR'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'4'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'FOUR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'QUAR'.AND.IHARG(1).EQ.'FIT')GOTO111
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.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'5TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'FIFT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'5'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'FIVE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'5'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'FIVE'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'QUIN'.AND.IHARG(1).EQ.'FIT')GOTO111
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.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'6TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SIXT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'6'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SIX'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'6'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'SIX'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SEXT'.AND.IHARG(1).EQ.'FIT')GOTO111
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.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'7TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SEVE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'7'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SEVE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'7'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'SEVE'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SEPT'.AND.IHARG(1).EQ.'FIT')GOTO111
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.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'8TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'EIGH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'8'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'EIGH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'8'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'EIGH'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'OCTI'.AND.IHARG(1).EQ.'FIT')GOTO111
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.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'9TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'NINT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'9'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'NINE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'9'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'NINE'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'NONI'.AND.IHARG(1).EQ.'FIT')GOTO111
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.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'10TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'TENT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'10'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'TEN'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'10'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'TEN'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'DEXI'.AND.IHARG(1).EQ.'FIT')GOTO111
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
  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 CKFIT--')
      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 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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 ICINT
      CHARACTER*4 ISIGN
      CHARACTER*4 IPATH
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'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)
      INT=ABSX
      AINT=INT
      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=ABSX
      GOTO1190
C
 1120 CONTINUE
      IPATH='2'
      ICINT='YES'
      IX=ABSX
      IX=IX+1
      GOTO1190
C
 1130 CONTINUE
      IPATH='3'
      ICINT='NO'
      IX=ABSX
      GOTO1190
C
 1190 CONTINUE
      IF(ISIGN.EQ.'NEG')IX=(-IX)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      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,INT,REM,ABSREM
 9013 FORMAT('X,ABSX,INT,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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED         --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         --MARCH     2004.    BU1CDF, BU1PDF, BU1PPF
C     UPDATED         --MARCH     2004.            ...
C     UPDATED         --MARCH     2004.    B12CDF, B12PDF, B12PPF
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
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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NCLF=-99
C
      NP1=N+1
C
      IF(IBUGCK.EQ.'OFF')GOTO90
      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
   90 CONTINUE
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               ****************************
C
  100 CONTINUE
      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')GOTO160
      IF(IA(IP1).EQ.'N')GOTO170
      IF(IA(IP1).EQ.'D')GOTO180
      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
  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               **       BU1CDF, BU1PDF, BU1PPF **
C               **               ...            **
C               **       B12CDF, B12PDF, B12PPF **
C               **       BEICDF, BEIPDF, BEIPPF **
C               **       BEKCDF, BEKPDF, BEKPPF **
C               **  NOVEMBER 2005:              **
C               **       BIRINT                 **
C               **  MARCH    2006:              **
C               **       BNOCDF, BNOPDF, BNOPPF **
C               **********************************
C
  200 CONTINUE
      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.'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')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.'R'.AND.IA(IP2).EQ.'A')GOTO221
      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               ****************************
C
CCCCC THE FOLLOWING C SECTION WAS CHANGED FOR CP AND CPK MAY 1989
  300 CONTINUE
      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.'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               ****************************
C
  400 CONTINUE
      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.'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')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.'G'.AND.IA(IP2).EQ.'A')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.'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               ****************************
C
  500 CONTINUE
      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
      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
      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.'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               ****************************
C
  600 CONTINUE
      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
      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               *******************************
C
  700 CONTINUE
      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
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.'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.'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.'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               *******************************
C
  800 CONTINUE
      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.'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               ****************************
C
  900 CONTINUE
      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
      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
      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
 1000 CONTINUE
      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
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 2
C           (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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED         --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
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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NCLF=-99
C
      NP1=N+1
C
      IF(IBUGCK.EQ.'OFF')GOTO90
      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
   90 CONTINUE
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               **********************************
C
 1100 CONTINUE
      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
      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               ****************************
C
 1200 CONTINUE
      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
C
      IF(IA(IP1).EQ.'N')GOTO1240
      IF(IA(IP1).EQ.'O')GOTO1210
      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.'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
      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.'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
 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               ****************************
C
 1300 CONTINUE
      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.'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
      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               ****************************
C
 1400 CONTINUE
      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
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.'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               ****************************
C
 1500 CONTINUE
      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')GOTO1510
      GOTO9000
C
 1510 CONTINUE
      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
      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               ****************************
C
CCCCC THE ENTIRE P SECTION IS NEW MAY 1989
 1600 CONTINUE
      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.'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
      IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'W')GOTO1610
      IF(IA(IP1).EQ.'O'.AND.IA(IP2).EQ.'L')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
      GOTO9000
C
 1690 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               ****************************
C
 1800 CONTINUE
      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')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.'C')GOTO1825
      IF(IA(IP1).EQ.'A'.AND.IA(IP2).EQ.'Y')GOTO1825
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(IP2).EQ.'G')GOTO1825
      GOTO9000
 1825 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
 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               ****************************
C
 1900 CONTINUE
      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')GOTO1920
      IF(IA(IP1).EQ.'Q')GOTO1930
      IF(IA(IP1).EQ.'R'.AND.IA(IP2).EQ.'A')GOTO1940
      IF(IA(IP1).EQ.'L'.AND.IA(IP2).EQ.'A')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.'N'.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.'N'.AND.IA(IP3).EQ.'I'.AND.IA(IP4).EQ.'N'.AND.
     1IA(IP5).EQ.'T')GOTO7600
      IF(IA(IP2).EQ.'N'.AND.IA(IP3).EQ.'H')GOTO7400
      IF(IA(IP2).EQ.'N')GOTO7300
      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.'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               ****************************
C
 2000 CONTINUE
      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
      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
      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
      IF(IA(IP3).EQ.'C'.AND.IA(IP4).EQ.'O'.AND.IA(IP5).EQ.'M'.AND.
     1IA(IP6).EQ.'I')GOTO7700
      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               ****************************
 2100 CONTINUE
      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.'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               ****************************
 2200 CONTINUE
      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
      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               ****************************
C
 2300 CONTINUE
      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')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')GOTO2315
      GOTO9000
C
 2310 CONTINUE
      IF(IA(IP2).EQ.'I')GOTO2315
      GOTO9000
 2315 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.'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
      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               ******************************
 2400 CONTINUE
      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               ****************************
 2500 CONTINUE
      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
      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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--88.10
C     ORIGINAL VERSION--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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'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,IMSUBC,ILOCV)
C
C     PURPOSE--CHECK TO SEE IF A TYPE 7 LET
C              COMMAND HAS BEEN GIVEN--
C                      SORT
C                      SORTC (= SORT AND CARRY)
C                      COCODE (= CORANK)
C                      COCOPY
C                      RANK
C                      CODE
C                      CODEH
C                      CODE2
C                      CODE4
C                      CODE8
C                      CODE10
C
C                      DISTINCT
C                      SEQUENTIAL DIFFERENCE
C                      INTERARRIVAL TIMES
C                      CUMULATIVE AVERAGE
C                      CUMULATIVE SUM
C                      CUMULATIVE INTEGRAL
C                      CUMULATIVE PRODUCT
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
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                      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
C                      MATRIX ADDITION
C                      MATRIX SUBTRACTION 
C                      MATRIX MULTIPLICATION
C
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 (NOT IMPLEMENTED)
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          (FUTURE--NOT YET IMP.)
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                      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
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 BIN
C                      MATRIX SUBTRACT
C
C                      FRACTAL
C                      BOOTSTRAP SAMPLE
C                      RANDOM SAMPLE = BOOTSTRAP SAMPLE
C                      JACKNIFE SAMPLE = BOOTSTRAP SAMPLE
C                      JACKNIFE INDEX
C                      RANDOM SAMPLE
C                      REVERSE
C                      CUMULATIVE HAZARD
C                      HAZARD
C                      EXPONENTIAL SMOOTHING
C
C                      BINNED (= FREQUENCY TABLE)
C                      RELATIVE BINNED (= RELATIVE FREQUENCY TABLE)
C                      ASH BINNED
C                      COUNTS ASH BINNED
C                      FREQUENCY TO RAW
C                      COMBINE FREQUENCY TABLE
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
C                      CROSS TABULATE <STAT>
C
C                      SORT BY <STAT>
C
C                      MATCH
C                      REPLACE
C                      STACK
C                      REPLICATED STACK
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     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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/10
C     ORIGINAL VERSION--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.     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
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
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
C
      IERROR='NO'
C
C               *********************************************
C               **  CHECK FOR A DATA MANIPULATION SUBCASE  **
C               *********************************************
C
      IFOUN7='NO'
      ICASL7='UNKN'
      ICASS7='UNKN'
      ILOCV=-1
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MATH')GOTO90
      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
   52 FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMARG
   53 FORMAT('NUMARG        = ',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
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE IF OF THIS TYPE  **
C               **  AND BRANCH ACCORDINGLY.    **
C               *********************************
C
      IF(NUMARG.LE.3)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.
C
      IF(NUMARG.GE.6.AND.IHARG(4).EQ.'SORT'.AND.IHARG(5).EQ.'BY  ')THEN
        IF(IHARG(6).EQ.'MEAN')GOTO13002
        IF(IHARG(6).EQ.'MIDM')GOTO13004
        IF(IHARG(6).EQ.'MEDI'.AND.
     1      IHARG(7).EQ.'ABSO'.AND.IHARG(8).EQ.'DEVI')GOTO13006
        IF(IHARG(6).EQ.'MAD')GOTO13008
        IF(IHARG(6).EQ.'SN'.AND.IHARG(7).EQ.'SCAL')GOTO13010
        IF(IHARG(6).EQ.'QN'.AND.IHARG(7).EQ.'SCAL')GOTO13012
        IF(IHARG(6).EQ.'MEDI')GOTO13014
        IF(IHARG(6).EQ.'TRIM'.AND.
     1     IHARG(7).EQ.'MEAN'.AND.IHARG(8).EQ.'STAN'.AND.
     1     IHARG(9).EQ.'ERRO')GOTO13016
        IF(IHARG(6).EQ.'TRIM'.AND.IHARG(7).EQ.'MEAN')GOTO13018
        IF(IHARG(6).EQ.'WINS'.AND.IHARG(7).EQ.'MEAN')GOTO13020
        IF(IHARG(6).EQ.'SUM ')GOTO13022
        IF(IHARG(6).EQ.'PROD')GOTO13024
        IF(IHARG(6).EQ.'SD  '.AND.
     1     IHARG(7).EQ.'OF  '.AND.IHARG(8).EQ.'MEAN')GOTO13026
        IF(IHARG(6).EQ.'SD  ')GOTO13028
        IF(IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI'.AND.
     1    IHARG(8).EQ.'OF  '.AND.IHARG(9).EQ.'MEAN')GOTO13030
        IF(IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO13032
        IF(IHARG(6).EQ.'VARI'.AND.IHARG(7).EQ.'OF  '.AND.
     1     IHARG(8).EQ.'MEAN')GOTO13034
        IF(IHARG(6).EQ.'VARI')GOTO13036
        IF(IHARG(6).EQ.'RELA'.AND.IHARG(7).EQ.'VARI')GOTO13038
        IF(IHARG(6).EQ.'RELA'.AND.IHARG(7).EQ.'SD  ')GOTO13040
        IF(IHARG(6).EQ.'RELA'.AND.IHARG(7).EQ.'STAN'.AND.
     1     IHARG(8).EQ.'DEVI')GOTO13042
        IF(IHARG(6).EQ.'COEF'.AND.IHARG(7).EQ.'OF  '.AND.
     1     IHARG(8).EQ.'VARI')GOTO13044
        IF(IHARG(6).EQ.'AVER'.AND.IHARG(7).EQ.'ABSO'.AND.
     1     IHARG(8).EQ.'DEVI')GOTO13046
        IF(IHARG(6).EQ.'RANG')GOTO13048
        IF(IHARG(6).EQ.'MIDR')GOTO13050
        IF(IHARG(6).EQ.'MAXI')GOTO13052
        IF(IHARG(6).EQ.'MINI')GOTO13054
        IF(IHARG(6).EQ.'EXTR')GOTO13056
C
        IF(IHARG(6).EQ.'LOWE'.AND.IHARG(7).EQ.'HING')GOTO13058
        IF(IHARG(6).EQ.'UPPE'.AND.IHARG(7).EQ.'HING')GOTO13060
        IF(IHARG(6).EQ.'LOWE'.AND.IHARG(7).EQ.'QUAR')GOTO13062
        IF(IHARG(6).EQ.'UPPE'.AND.IHARG(7).EQ.'QUAR')GOTO13064
        IF(IHARG(6).EQ.'SKEW')GOTO13066
        IF(IHARG(6).EQ.'KURT')GOTO13068
        IF(IHARG(6).EQ.'AUTO'.AND.IHARG2(6).EQ.'CORR')GOTO13070
        IF(IHARG(6).EQ.'AUTO'.AND.IHARG2(6).EQ.'COVA')GOTO13072
        IF(IHARG(6).EQ.'INTE'.AND.IHARG(7).EQ.'RANG')GOTO13074
        IF(IHARG(6).EQ.'IQ  '.AND.IHARG(7).EQ.'RANG')GOTO13074
        IF(IHARG(6).EQ.'BIWE'.AND.IHARG(7).EQ.'LOCA')GOTO13078
        IF(IHARG(6).EQ.'BIWE'.AND.IHARG(7).EQ.'SCAL')GOTO13080
        IF(IHARG(6).EQ.'BIWE'.AND.IHARG(7).EQ.'MIDV')GOTO13082
        IF(IHARG(6).EQ.'WINS'.AND.IHARG(7).EQ.'SD')GOTO13084
        IF(IHARG(6).EQ.'WINS'.AND.IHARG(7).EQ.'STAN'.AND.
     1     IHARG(8).EQ.'DEVI')GOTO13086
        IF(IHARG(6).EQ.'WINS'.AND.IHARG(7).EQ.'VARI')GOTO13088
        IF(IHARG(6).EQ.'PERC'.AND.
     1     IHARG(7).EQ.'BEND'.AND.IHARG(8).EQ.'MIDV')GOTO13090
        IF(IHARG(6).EQ.'HODG'.AND.IHARG(7).EQ.'LEHM')GOTO13092
        IF(IHARG(6).EQ.'QUAN'.AND.
     1     IHARG(7).EQ.'STAN'.AND.IHARG(8).EQ.'ERRO')GOTO13094
        IF(IHARG(6).EQ.'QUAN')GOTO13096
        IF(IHARG(6).EQ.'CP')GOTO13098
        IF(IHARG(6).EQ.'CPK')GOTO13100
        IF(IHARG(6).EQ.'CPM')GOTO13102
        IF(IHARG(6).EQ.'CPL')GOTO13104
        IF(IHARG(6).EQ.'CPU')GOTO13106
        IF(IHARG(6).EQ.'CNPK')GOTO13108
        IF(IHARG(6).EQ.'CC')GOTO13110
        IF(IHARG(6).EQ.'PERC'.AND.IHARG(7).EQ.'DEFE')GOTO13112
        IF(IHARG(6).EQ.'EXPE'.AND.IHARG(7).EQ.'LOSS')GOTO13114
        IF(IHARG(6).EQ.'PERC')GOTO13116
        IF(IHARG(6).EQ.'HARM'.AND.IHARG(7).EQ.'MEAN')GOTO13118
        IF(IHARG(6).EQ.'GEOM'.AND.IHARG(7).EQ.'MEAN')GOTO13120
        IF(IHARG(6).EQ.'GEOM'.AND.IHARG(7).EQ.'SD')GOTO13122
        IF(IHARG(6).EQ.'GEOM'.AND.
     1     IHARG(7).EQ.'STAN'.AND.IHARG(8).EQ.'DEVI')GOTO13124
        IF(IHARG(6).EQ.'NORM'.AND.IHARG(7).EQ.'PPCC')GOTO13126
        IF(IHARG(6).EQ.'FIRS'.AND.IHARG(7).EQ.'DECI')GOTO13128
        IF(IHARG(6).EQ.'SECO'.AND.IHARG(7).EQ.'DECI')GOTO13130
        IF(IHARG(6).EQ.'THIR'.AND.IHARG(7).EQ.'DECI')GOTO13132
        IF(IHARG(6).EQ.'FOUR'.AND.IHARG(7).EQ.'DECI')GOTO13134
        IF(IHARG(6).EQ.'FIFT'.AND.IHARG(7).EQ.'DECI')GOTO13136
        IF(IHARG(6).EQ.'SIXT'.AND.IHARG(7).EQ.'DECI')GOTO13138
        IF(IHARG(6).EQ.'SEVE'.AND.IHARG(7).EQ.'DECI')GOTO13140
        IF(IHARG(6).EQ.'EIGH'.AND.IHARG(7).EQ.'DECI')GOTO13142
        IF(IHARG(6).EQ.'NINT'.AND.IHARG(7).EQ.'DECI')GOTO13144
        IF(IHARG(6).EQ.'TAGU'.AND.IHARG(7).EQ.'SN00')GOTO13146
        IF(IHARG(6).EQ.'TAGU'.AND.IHARG(7).EQ.'SN0')GOTO13148
        IF(IHARG(6).EQ.'TAGU'.AND.IHARG(7).EQ.'SN+')GOTO13150
        IF(IHARG(6).EQ.'TAGU'.AND.IHARG(7).EQ.'SN-')GOTO13152
        IF(IHARG(6).EQ.'SN00')GOTO13154
        IF(IHARG(6).EQ.'SN0')GOTO13156
        IF(IHARG(6).EQ.'SN+')GOTO13158
        IF(IHARG(6).EQ.'SN-')GOTO13160
        IF(IHARG(6).EQ.'SINE'.AND.IHARG(7).EQ.'FREQ')GOTO13162
        IF(IHARG(6).EQ.'SIN'.AND.IHARG(7).EQ.'FREQ')GOTO13162
        IF(IHARG(6).EQ.'SINE'.AND.IHARG(7).EQ.'AMPL')GOTO13164
        IF(IHARG(6).EQ.'SIN'.AND.IHARG(7).EQ.'AMPL')GOTO13164
      ENDIF
C
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'SORT'.AND.IHARG2(3).EQ.'    ')GOTO1201
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'RANK'.AND.IHARG2(3).EQ.'    ')GOTO1202
      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
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'DIFF'.AND.IHARG2(3).EQ.'EREN')GOTO1205
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'SEQU'.AND.IHARG(4).EQ.'DIFF')GOTO1206
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')GOTO1206
      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.'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
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
      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
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
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.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.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
      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
C               ***********************************************
C               **  CHECK FOR   COMPLEX ARITHMETIC SUBCASES  **
C               ***********************************************
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
      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
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'VECT')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
      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
      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
      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.'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.
      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
CCCCC JUNE 1998.  ADD FOLLOWING LINES.
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'MEAN')GOTO2992
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'MIDM')GOTO3002
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'MEDI')GOTO3012
      IF(NUMARG.GE.8.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'TRIM'.AND.
     1IHARG(6).EQ.'MEAN'.AND.IHARG(7).EQ.'STAN'.AND.
     1IHARG(8).EQ.'ERRO')GOTO3024
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'TRIM'.AND.
     1IHARG(6).EQ.'MEAN')GOTO3022
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'WINS'.AND.
     1IHARG(6).EQ.'MEAN')GOTO3032
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'HODG'.AND.
     1IHARG(6).EQ.'LEHM')GOTO3034
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'BIWE'.AND.
     1IHARG(6).EQ.'LOCA')GOTO3036
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'BIWE'.AND.
     1IHARG(6).EQ.'SCAL')GOTO3038
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'SUM ')GOTO3042
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'PROD')GOTO3045
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'SD  ')GOTO3052
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'STAN'.AND.
     1IHARG(6).EQ.'DEVI')GOTO3062
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'BIWE'.AND.
     1IHARG(6).EQ.'MIDV')GOTO3063
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'PERC'.AND.
     1IHARG(6).EQ.'BEND'.AND.IHARG(7).EQ.'MIDV')GOTO3064
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'WINS'.AND.
     1IHARG(6).EQ.'VARI')GOTO3065
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'WINS'.AND.
     1IHARG(6).EQ.'SD')GOTO3066
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'WINS'.AND.
     1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO3067
      IF(NUMARG.GE.8.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'STAN'.AND.
     1IHARG(6).EQ.'DEVI'.AND.IHARG(7).EQ.'OF  '.AND.
     1IHARG(8).EQ.'MEAN')GOTO3072
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'SD  '.AND.
     1IHARG(6).EQ.'OF  '.AND.IHARG(7).EQ.'MEAN')GOTO3082
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'VARI')GOTO3092
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'VARI'.AND.
     1IHARG(6).EQ.'OF  '.AND.IHARG(7).EQ.'MEAN')GOTO3102
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'RELA'.AND.
     1IHARG(6).EQ.'VARI')GOTO3112
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'RELA'.AND.
     1IHARG(6).EQ.'SD  ')GOTO3122
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'RELA'.AND.
     1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO3132
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'COEF'.AND.
     1IHARG(6).EQ.'OF  '.AND.IHARG(7).EQ.'VARI')GOTO3142
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'AVER'.AND.
     1IHARG(6).EQ.'ABSO'.AND.IHARG(7).EQ.'DEVI')GOTO3152
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'MEDI'.AND.
     1IHARG(6).EQ.'ABSO'.AND.IHARG(7).EQ.'DEVI')GOTO3162
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'RANG')GOTO3172
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'MIDR')GOTO3182
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'MAXI')GOTO3192
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'MINI')GOTO3202
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'EXTR')GOTO3212
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'LOWE'.AND.
     1IHARG(6).EQ.'HING')GOTO3222
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'UPPE'.AND.
     1IHARG(6).EQ.'HING')GOTO3232
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'LOWE'.AND.
     1IHARG(6).EQ.'QUAR')GOTO3242
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'UPPE'.AND.
     1IHARG(6).EQ.'QUAR')GOTO3252
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'SKEW')GOTO3262
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'KURT')GOTO3272
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'AUTO'.AND.
     1IHARG2(5).EQ.'CORR')GOTO3282
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'AUTO'.AND.
     1IHARG2(5).EQ.'COVA')GOTO3292
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'QUAN'.AND.
     1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'ERRO')GOTO3303
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'QUAN')GOTO3304
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'CP')GOTO3311
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'CPK')GOTO3312
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'CPM')GOTO3313
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'CPL')GOTO3314
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'CPU')GOTO3315
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'CNPK')GOTO3316
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'CC')GOTO3317
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'PERC'.AND.
     1IHARG(6).EQ.'DEFE')GOTO3318
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'EXPE'.AND.
     1IHARG(6).EQ.'LOSS')GOTO3319
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'PERC')GOTO3321
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'HARM'.AND.
     1IHARG(6).EQ.'MEAN')GOTO3322
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'GEOM'.AND.
     1IHARG(6).EQ.'MEAN')GOTO3323
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'GEOM'.AND.
     1IHARG(6).EQ.'SD')GOTO3324
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'GEOM'.AND.
     1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO3325
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'NORM'.AND.
     1IHARG(6).EQ.'PPCC')GOTO3326
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'FIRS'.AND.
     1IHARG(6).EQ.'DECI')GOTO3331
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SECO'.AND.
     1IHARG(6).EQ.'DECI')GOTO3332
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'THIR'.AND.
     1IHARG(6).EQ.'DECI')GOTO3333
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'FOUR'.AND.
     1IHARG(6).EQ.'DECI')GOTO3334
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'FIFT'.AND.
     1IHARG(6).EQ.'DECI')GOTO3335
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SIXT'.AND.
     1IHARG(6).EQ.'DECI')GOTO3336
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SEVE'.AND.
     1IHARG(6).EQ.'DECI')GOTO3337
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'EIGH'.AND.
     1IHARG(6).EQ.'DECI')GOTO3338
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'NINT'.AND.
     1IHARG(6).EQ.'DECI')GOTO3339
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SN'.AND.
     1IHARG(6).EQ.'SCAL')GOTO3354
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'QN'.AND.
     1IHARG(6).EQ.'SCAL')GOTO3356
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'TAGU'.AND.
     1IHARG(6).EQ.'SN00')GOTO3341
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'TAGU'.AND.
     1IHARG(6).EQ.'SN0')GOTO3342
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'TAGU'.AND.
     1IHARG(6).EQ.'SN+')GOTO3343
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'TAGU'.AND.
     1IHARG(6).EQ.'SN-')GOTO3344
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SN00')GOTO3346
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SN0')GOTO3347
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SN+')GOTO3348
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SN-')GOTO3349
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SINE'.AND.
     1IHARG(6).EQ.'FREQ')GOTO3351
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SIN'.AND.
     1IHARG(6).EQ.'FREQ')GOTO3351
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SINE'.AND.
     1IHARG(6).EQ.'AMPL')GOTO3352
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'ROW'.AND.IHARG(5).EQ.'SIN'.AND.
     1IHARG(6).EQ.'AMPL')GOTO3352
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'ROW '.AND.IHARG(5).EQ.'SCAL')GOTO3302
C
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'MEAN')GOTO3992
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'MIDM')GOTO4002
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'MEDI')GOTO4012
      IF(NUMARG.GE.8.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'TRIM'.AND.
     1IHARG(6).EQ.'MEAN'.AND.IHARG(7).EQ.'STAN'.AND.
     1IHARG(8).EQ.'ERRO')GOTO4024
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'TRIM'.AND.
     1IHARG(6).EQ.'MEAN')GOTO4022
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'WINS'.AND.
     1IHARG(6).EQ.'MEAN')GOTO4032
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'HODG'.AND.
     1IHARG(6).EQ.'LEHM')GOTO4034
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU '.AND.IHARG(5).EQ.'BIWE'.AND.
     1IHARG(6).EQ.'LOCA')GOTO4036
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU '.AND.IHARG(5).EQ.'BIWE'.AND.
     1IHARG(6).EQ.'SCAL')GOTO4038
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SUM ')GOTO4042
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'PROD')GOTO4045
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SD  ')GOTO4052
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'STAN'.AND.
     1IHARG(6).EQ.'DEVI')GOTO4062
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU '.AND.IHARG(5).EQ.'BIWE'.AND.
     1IHARG(6).EQ.'MIDV')GOTO4063
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'COLU '.AND.IHARG(5).EQ.'PERC'.AND.
     1IHARG(6).EQ.'BEND'.AND.IHARG(7).EQ.'MIDV')GOTO4064
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU '.AND.IHARG(5).EQ.'WINS'.AND.
     1IHARG(6).EQ.'VARI')GOTO4065
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU '.AND.IHARG(5).EQ.'WINS'.AND.
     1IHARG(6).EQ.'SD')GOTO4066
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'COLU '.AND.IHARG(5).EQ.'WINS'.AND.
     1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO4067
      IF(NUMARG.GE.8.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'STAN'.AND.
     1IHARG(6).EQ.'DEVI'.AND.IHARG(7).EQ.'OF  '.AND.
     1IHARG(8).EQ.'MEAN')GOTO4072
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SD  '.AND.
     1IHARG(6).EQ.'OF  '.AND.IHARG(7).EQ.'MEAN')GOTO4082
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'VARI')GOTO4092
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'VARI'.AND.
     1IHARG(6).EQ.'OF  '.AND.IHARG(7).EQ.'MEAN')GOTO4102
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'RELA'.AND.
     1IHARG(6).EQ.'VARI')GOTO4112
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'RELA'.AND.
     1IHARG(6).EQ.'SD  ')GOTO4122
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'RELA'.AND.
     1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO4142
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'COEF'.AND.
     1IHARG(6).EQ.'OF  '.AND.IHARG(7).EQ.'VARI')GOTO4142
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'AVER'.AND.
     1IHARG(6).EQ.'ABSO'.AND.IHARG(7).EQ.'DEVI')GOTO4152
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'MEDI'.AND.
     1IHARG(6).EQ.'ABSO'.AND.IHARG(7).EQ.'DEVI')GOTO4162
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'RANG')GOTO4172
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'MIDR')GOTO4182
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'MAXI')GOTO4192
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'MINI')GOTO4202
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'EXTR')GOTO4212
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'LOWE'.AND.
     1IHARG(6).EQ.'HING')GOTO4222
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'UPPE'.AND.
     1IHARG(6).EQ.'HING')GOTO4232
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'LOWE'.AND.
     1IHARG(6).EQ.'QUAR')GOTO4242
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'UPPE'.AND.
     1IHARG(6).EQ.'QUAR')GOTO4252
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SKEW')GOTO4262
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'KURT')GOTO4272
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'AUTO'.AND.
     1IHARG2(5).EQ.'CORR')GOTO4282
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'AUTO'.AND.
     1IHARG2(5).EQ.'COVA')GOTO4292
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'QUAN'.AND.
     1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'ERRO')GOTO4302
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'QUAN')GOTO4304
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'CP')GOTO4311
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'CPK')GOTO4312
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'CPM')GOTO4313
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'CPL')GOTO4314
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'CPU')GOTO4315
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'CNPK')GOTO4316
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'CC')GOTO4317
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'PERC'.AND.
     1IHARG(6).EQ.'DEFE')GOTO4318
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'EXPE'.AND.
     1IHARG(6).EQ.'LOSS')GOTO4319
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'PERC')GOTO4321
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'HARM'.AND.
     1IHARG(6).EQ.'MEAN')GOTO4322
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'GEOM'.AND.
     1IHARG(6).EQ.'MEAN')GOTO4323
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'GEOM'.AND.
     1IHARG(6).EQ.'SD')GOTO4324
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'GEOM'.AND.
     1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO4325
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'NORM'.AND.
     1IHARG(6).EQ.'PPCC')GOTO4326
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'FIRS'.AND.
     1IHARG(6).EQ.'DECI')GOTO4331
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SECO'.AND.
     1IHARG(6).EQ.'DECI')GOTO4332
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'THIR'.AND.
     1IHARG(6).EQ.'DECI')GOTO4333
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'FOUR'.AND.
     1IHARG(6).EQ.'DECI')GOTO4334
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'FIFT'.AND.
     1IHARG(6).EQ.'DECI')GOTO4335
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SIXT'.AND.
     1IHARG(6).EQ.'DECI')GOTO4336
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SEVE'.AND.
     1IHARG(6).EQ.'DECI')GOTO4337
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'EIGH'.AND.
     1IHARG(6).EQ.'DECI')GOTO4338
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'NINT'.AND.
     1IHARG(6).EQ.'DECI')GOTO4339
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SN'.AND.
     1IHARG(6).EQ.'SCAL')GOTO4354
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'QN'.AND.
     1IHARG(6).EQ.'SCAL')GOTO4356
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'TAGU'.AND.
     1IHARG(6).EQ.'SN00')GOTO4341
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'TAGU'.AND.
     1IHARG(6).EQ.'SN0')GOTO4342
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'TAGU'.AND.
     1IHARG(6).EQ.'SN+')GOTO4343
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'TAGU'.AND.
     1IHARG(6).EQ.'SN-')GOTO4344
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SN00')GOTO4346
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SN0')GOTO4347
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SN+')GOTO4348
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SN-')GOTO4349
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SINE'.AND.
     1IHARG(6).EQ.'FREQ')GOTO4351
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SIN'.AND.
     1IHARG(6).EQ.'FREQ')GOTO4351
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SINE'.AND.
     1IHARG(6).EQ.'AMPL')GOTO4352
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SIN'.AND.
     1IHARG(6).EQ.'AMPL')GOTO4352
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'COLU'.AND.IHARG(5).EQ.'SCAL')GOTO4302
C
CCCCC JUNE 2005: MATRIX PARTITION <STAT>
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'MEAN')GOTO4500
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'MIDM')GOTO4502
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'MEDI')GOTO4512
      IF(NUMARG.GE.8.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'TRIM'.AND.
     1IHARG(6).EQ.'MEAN'.AND.IHARG(7).EQ.'STAN'.AND.
     1IHARG(8).EQ.'ERRO')GOTO4524
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'TRIM'.AND.
     1IHARG(6).EQ.'MEAN')GOTO4522
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'WINS'.AND.
     1IHARG(6).EQ.'MEAN')GOTO4532
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'HODG'.AND.
     1IHARG(6).EQ.'LEHM')GOTO4534
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART '.AND.IHARG(5).EQ.'BIWE'.AND.
     1IHARG(6).EQ.'LOCA')GOTO4536
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART '.AND.IHARG(5).EQ.'BIWE'.AND.
     1IHARG(6).EQ.'SCAL')GOTO4538
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SUM ')GOTO4542
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'PROD')GOTO4545
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SD  ')GOTO4552
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'STAN'.AND.
     1IHARG(6).EQ.'DEVI')GOTO4562
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART '.AND.IHARG(5).EQ.'BIWE'.AND.
     1IHARG(6).EQ.'MIDV')GOTO4563
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'PART '.AND.IHARG(5).EQ.'PERC'.AND.
     1IHARG(6).EQ.'BEND'.AND.IHARG(7).EQ.'MIDV')GOTO4564
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART '.AND.IHARG(5).EQ.'WINS'.AND.
     1IHARG(6).EQ.'VARI')GOTO4565
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART '.AND.IHARG(5).EQ.'WINS'.AND.
     1IHARG(6).EQ.'SD')GOTO4566
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'PART '.AND.IHARG(5).EQ.'WINS'.AND.
     1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO4567
      IF(NUMARG.GE.8.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'STAN'.AND.
     1IHARG(6).EQ.'DEVI'.AND.IHARG(7).EQ.'OF  '.AND.
     1IHARG(8).EQ.'MEAN')GOTO4572
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SD  '.AND.
     1IHARG(6).EQ.'OF  '.AND.IHARG(7).EQ.'MEAN')GOTO4582
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'VARI')GOTO4592
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'VARI'.AND.
     1IHARG(6).EQ.'OF  '.AND.IHARG(7).EQ.'MEAN')GOTO4602
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'RELA'.AND.
     1IHARG(6).EQ.'VARI')GOTO4612
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'RELA'.AND.
     1IHARG(6).EQ.'SD  ')GOTO4622
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'RELA'.AND.
     1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO4652
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'COEF'.AND.
     1IHARG(6).EQ.'OF  '.AND.IHARG(7).EQ.'VARI')GOTO4652
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'AVER'.AND.
     1IHARG(6).EQ.'ABSO'.AND.IHARG(7).EQ.'DEVI')GOTO4652
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'MEDI'.AND.
     1IHARG(6).EQ.'ABSO'.AND.IHARG(7).EQ.'DEVI')GOTO4662
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'RANG')GOTO4672
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'MIDR')GOTO4682
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'MAXI')GOTO4692
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'MINI')GOTO4702
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'EXTR')GOTO4712
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'LOWE'.AND.
     1IHARG(6).EQ.'HING')GOTO4722
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'UPPE'.AND.
     1IHARG(6).EQ.'HING')GOTO4732
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'LOWE'.AND.
     1IHARG(6).EQ.'QUAR')GOTO4742
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'UPPE'.AND.
     1IHARG(6).EQ.'QUAR')GOTO4752
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SKEW')GOTO4762
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'KURT')GOTO4772
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'AUTO'.AND.
     1IHARG2(5).EQ.'CORR')GOTO4782
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'AUTO'.AND.
     1IHARG2(5).EQ.'COVA')GOTO4792
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'QUAN'.AND.
     1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'ERRO')GOTO4802
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'QUAN')GOTO4804
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'CP')GOTO4811
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'CPK')GOTO4812
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'CPM')GOTO4813
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'CPL')GOTO4814
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'CPU')GOTO4815
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'CNPK')GOTO4816
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'CC')GOTO4817
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'PERC'.AND.
     1IHARG(6).EQ.'DEFE')GOTO4818
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'EXPE'.AND.
     1IHARG(6).EQ.'LOSS')GOTO4819
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'PERC')GOTO4821
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'HARM'.AND.
     1IHARG(6).EQ.'MEAN')GOTO4822
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'GEOM'.AND.
     1IHARG(6).EQ.'MEAN')GOTO4823
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'GEOM'.AND.
     1IHARG(6).EQ.'SD')GOTO4824
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'GEOM'.AND.
     1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO4825
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'NORM'.AND.
     1IHARG(6).EQ.'PPCC')GOTO4826
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'FIRS'.AND.
     1IHARG(6).EQ.'DECI')GOTO4831
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SECO'.AND.
     1IHARG(6).EQ.'DECI')GOTO4832
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'THIR'.AND.
     1IHARG(6).EQ.'DECI')GOTO4833
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'FOUR'.AND.
     1IHARG(6).EQ.'DECI')GOTO4834
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'FIFT'.AND.
     1IHARG(6).EQ.'DECI')GOTO4835
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SIXT'.AND.
     1IHARG(6).EQ.'DECI')GOTO4836
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SEVE'.AND.
     1IHARG(6).EQ.'DECI')GOTO4837
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'EIGH'.AND.
     1IHARG(6).EQ.'DECI')GOTO4838
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'NINT'.AND.
     1IHARG(6).EQ.'DECI')GOTO4839
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SN'.AND.
     1IHARG(6).EQ.'SCAL')GOTO4854
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'QN'.AND.
     1IHARG(6).EQ.'SCAL')GOTO4856
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'TAGU'.AND.
     1IHARG(6).EQ.'SN00')GOTO4851
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'TAGU'.AND.
     1IHARG(6).EQ.'SN0')GOTO4852
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'TAGU'.AND.
     1IHARG(6).EQ.'SN+')GOTO4843
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'TAGU'.AND.
     1IHARG(6).EQ.'SN-')GOTO4844
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SN00')GOTO4846
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SN0')GOTO4847
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SN+')GOTO4848
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SN-')GOTO4849
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SINE'.AND.
     1IHARG(6).EQ.'FREQ')GOTO4851
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SIN'.AND.
     1IHARG(6).EQ.'FREQ')GOTO4851
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SINE'.AND.
     1IHARG(6).EQ.'AMPL')GOTO4852
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SIN'.AND.
     1IHARG(6).EQ.'AMPL')GOTO4852
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'PART'.AND.IHARG(5).EQ.'SCAL')GOTO4802
C
CCCCC JUNE 2005: MATRIX GRAND <STAT>
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'MEAN')GOTO6500
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'MIDM')GOTO6502
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'MEDI')GOTO6512
      IF(NUMARG.GE.8.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'TRIM'.AND.
     1IHARG(6).EQ.'MEAN'.AND.IHARG(7).EQ.'STAN'.AND.
     1IHARG(8).EQ.'ERRO')GOTO6524
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'TRIM'.AND.
     1IHARG(6).EQ.'MEAN')GOTO6522
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'WINS'.AND.
     1IHARG(6).EQ.'MEAN')GOTO6532
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'HODG'.AND.
     1IHARG(6).EQ.'LEHM')GOTO6534
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN '.AND.IHARG(5).EQ.'BIWE'.AND.
     1IHARG(6).EQ.'LOCA')GOTO6536
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN '.AND.IHARG(5).EQ.'BIWE'.AND.
     1IHARG(6).EQ.'SCAL')GOTO6538
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SUM ')GOTO6542
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'PROD')GOTO6545
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SD  ')GOTO6552
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'STAN'.AND.
     1IHARG(6).EQ.'DEVI')GOTO6562
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN '.AND.IHARG(5).EQ.'BIWE'.AND.
     1IHARG(6).EQ.'MIDV')GOTO6563
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'GRAN '.AND.IHARG(5).EQ.'PERC'.AND.
     1IHARG(6).EQ.'BEND'.AND.IHARG(7).EQ.'MIDV')GOTO6564
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN '.AND.IHARG(5).EQ.'WINS'.AND.
     1IHARG(6).EQ.'VARI')GOTO6565
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN '.AND.IHARG(5).EQ.'WINS'.AND.
     1IHARG(6).EQ.'SD')GOTO6566
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'GRAN '.AND.IHARG(5).EQ.'WINS'.AND.
     1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO6567
      IF(NUMARG.GE.8.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'STAN'.AND.
     1IHARG(6).EQ.'DEVI'.AND.IHARG(7).EQ.'OF  '.AND.
     1IHARG(8).EQ.'MEAN')GOTO6572
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SD  '.AND.
     1IHARG(6).EQ.'OF  '.AND.IHARG(7).EQ.'MEAN')GOTO6582
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'VARI')GOTO6592
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'VARI'.AND.
     1IHARG(6).EQ.'OF  '.AND.IHARG(7).EQ.'MEAN')GOTO6602
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'RELA'.AND.
     1IHARG(6).EQ.'VARI')GOTO6612
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'RELA'.AND.
     1IHARG(6).EQ.'SD  ')GOTO6622
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'RELA'.AND.
     1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO6652
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'COEF'.AND.
     1IHARG(6).EQ.'OF  '.AND.IHARG(7).EQ.'VARI')GOTO6652
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'AVER'.AND.
     1IHARG(6).EQ.'ABSO'.AND.IHARG(7).EQ.'DEVI')GOTO6652
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'MEDI'.AND.
     1IHARG(6).EQ.'ABSO'.AND.IHARG(7).EQ.'DEVI')GOTO6662
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'RANG')GOTO6672
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'MIDR')GOTO6682
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'MAXI')GOTO6692
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'MINI')GOTO6702
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'EXTR')GOTO6712
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'LOWE'.AND.
     1IHARG(6).EQ.'HING')GOTO6722
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'UPPE'.AND.
     1IHARG(6).EQ.'HING')GOTO6732
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'LOWE'.AND.
     1IHARG(6).EQ.'QUAR')GOTO6742
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'UPPE'.AND.
     1IHARG(6).EQ.'QUAR')GOTO6752
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SKEW')GOTO6762
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'KURT')GOTO6772
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'AUTO'.AND.
     1IHARG2(5).EQ.'CORR')GOTO6782
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'AUTO'.AND.
     1IHARG2(5).EQ.'COVA')GOTO6792
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'QUAN'.AND.
     1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'ERRO')GOTO6802
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'QUAN')GOTO6804
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'CP')GOTO6811
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'CPK')GOTO6812
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'CPM')GOTO6813
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'CPL')GOTO6814
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'CPU')GOTO6815
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'CNPK')GOTO6816
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'CC')GOTO6817
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'PERC'.AND.
     1IHARG(6).EQ.'DEFE')GOTO6818
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'EXPE'.AND.
     1IHARG(6).EQ.'LOSS')GOTO6819
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'PERC')GOTO6821
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'HARM'.AND.
     1IHARG(6).EQ.'MEAN')GOTO6822
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'GEOM'.AND.
     1IHARG(6).EQ.'MEAN')GOTO6823
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'GEOM'.AND.
     1IHARG(6).EQ.'SD')GOTO6824
      IF(NUMARG.GE.7.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'GEOM'.AND.
     1IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO6825
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'NORM'.AND.
     1IHARG(6).EQ.'PPCC')GOTO6826
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'FIRS'.AND.
     1IHARG(6).EQ.'DECI')GOTO6831
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SECO'.AND.
     1IHARG(6).EQ.'DECI')GOTO6832
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'THIR'.AND.
     1IHARG(6).EQ.'DECI')GOTO6833
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'FOUR'.AND.
     1IHARG(6).EQ.'DECI')GOTO6834
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'FIFT'.AND.
     1IHARG(6).EQ.'DECI')GOTO6835
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SIXT'.AND.
     1IHARG(6).EQ.'DECI')GOTO6836
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SEVE'.AND.
     1IHARG(6).EQ.'DECI')GOTO6837
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'EIGH'.AND.
     1IHARG(6).EQ.'DECI')GOTO6838
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'NINT'.AND.
     1IHARG(6).EQ.'DECI')GOTO6839
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SN'.AND.
     1IHARG(6).EQ.'SCAL')GOTO6854
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'QN'.AND.
     1IHARG(6).EQ.'SCAL')GOTO6856
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'TAGU'.AND.
     1IHARG(6).EQ.'SN00')GOTO6851
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'TAGU'.AND.
     1IHARG(6).EQ.'SN0')GOTO6852
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'TAGU'.AND.
     1IHARG(6).EQ.'SN+')GOTO6843
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'TAGU'.AND.
     1IHARG(6).EQ.'SN-')GOTO6844
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SN00')GOTO6846
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SN0')GOTO6847
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SN+')GOTO6848
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SN-')GOTO6849
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SINE'.AND.
     1IHARG(6).EQ.'FREQ')GOTO6851
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SIN'.AND.
     1IHARG(6).EQ.'FREQ')GOTO6851
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SINE'.AND.
     1IHARG(6).EQ.'AMPL')GOTO6852
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SIN'.AND.
     1IHARG(6).EQ.'AMPL')GOTO6852
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'GRAN'.AND.IHARG(5).EQ.'SCAL')GOTO6802
C
CCCCC END CHANGE
CCCCC SEPTEMBER 1993.  ADD FOLLOWING LINES.
      IF(IHARG(4).EQ.'ROW ')GOTO2649
      IF(IHARG(4).EQ.'ELEM')GOTO2650
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
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.'PSUE'.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
      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')GOTO5034
      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.'BLOC'.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.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
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.6.AND.
     1IHARG(4).EQ.'H   '.AND.IHARG(5).EQ.'CONS'.AND.
     1IHARG(6).EQ.'STAT')GOTO5206
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'H   '.AND.IHARG(5).EQ.'CONS')GOTO5207
      IF(NUMARG.GE.6.AND.
     1IHARG(4).EQ.'K   '.AND.IHARG(5).EQ.'CONS'.AND.
     1IHARG(6).EQ.'STAT')GOTO5208
      IF(NUMARG.GE.5.AND.
     1IHARG(4).EQ.'K   '.AND.IHARG(5).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
 1069 CONTINUE
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               **************************************
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
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
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
C
      IF(NUMARG.GE.4.AND.IHARG(3).EQ.'CROS'.AND.IHARG(4).EQ.'TABU')THEN
        IF(IHARG(5).EQ.'MEAN')GOTO2832
        IF(IHARG(5).EQ.'MIDM')GOTO2834
        IF(IHARG(5).EQ.'MEDI'.AND.
     1      IHARG(6).EQ.'ABSO'.AND.IHARG(7).EQ.'DEVI')GOTO2868
        IF(IHARG(5).EQ.'MAD')GOTO2869
        IF(IHARG(5).EQ.'SN'.AND.IHARG(6).EQ.'SCAL')GOTO12962
        IF(IHARG(5).EQ.'QN'.AND.IHARG(6).EQ.'SCAL')GOTO12964
        IF(IHARG(5).EQ.'MEDI')GOTO2836
        IF(IHARG(5).EQ.'TRIM'.AND.
     1     IHARG(6).EQ.'MEAN'.AND.IHARG(7).EQ.'STAN'.AND.
     1     IHARG(8).EQ.'ERRO')GOTO12908
        IF(IHARG(5).EQ.'TRIM'.AND.IHARG(6).EQ.'MEAN')GOTO2838
        IF(IHARG(5).EQ.'WINS'.AND.IHARG(6).EQ.'MEAN')GOTO2840
        IF(IHARG(5).EQ.'SUM ')GOTO2842
        IF(IHARG(5).EQ.'PROD')GOTO2844
        IF(IHARG(5).EQ.'SD  ')GOTO2846
        IF(IHARG(5).EQ.'STAN'.AND.IHARG(6).EQ.'DEVI')GOTO2848
        IF(IHARG(5).EQ.'STAN'.AND.IHARG(6).EQ.'DEVI'.AND.
     1    IHARG(7).EQ.'OF  '.AND.IHARG(8).EQ.'MEAN')GOTO2850
        IF(IHARG(5).EQ.'SD  '.AND.
     1     IHARG(6).EQ.'OF  '.AND.IHARG(7).EQ.'MEAN')GOTO2852
        IF(IHARG(5).EQ.'VARI'.AND.IHARG(6).EQ.'OF  '.AND.
     1     IHARG(7).EQ.'MEAN')GOTO2856
        IF(IHARG(5).EQ.'VARI')GOTO2854
        IF(IHARG(5).EQ.'RELA'.AND.IHARG(6).EQ.'VARI')GOTO2858
        IF(IHARG(5).EQ.'RELA'.AND.IHARG(6).EQ.'SD  ')GOTO2860
        IF(IHARG(5).EQ.'RELA'.AND.IHARG(6).EQ.'STAN'.AND.
     1     IHARG(7).EQ.'DEVI')GOTO2862
        IF(IHARG(5).EQ.'COEF'.AND.IHARG(6).EQ.'OF  '.AND.
     1     IHARG(7).EQ.'VARI')GOTO2864
        IF(IHARG(5).EQ.'AVER'.AND.IHARG(6).EQ.'ABSO'.AND.
     1     IHARG(7).EQ.'DEVI')GOTO2866
        IF(IHARG(5).EQ.'RANG')GOTO2870
        IF(IHARG(5).EQ.'MIDR')GOTO2872
        IF(IHARG(5).EQ.'MAXI')GOTO2874
        IF(IHARG(5).EQ.'MINI')GOTO2876
        IF(IHARG(5).EQ.'EXTR')GOTO2878
C
        IF(IHARG(5).EQ.'LOWE'.AND.IHARG(6).EQ.'HING')GOTO2880
        IF(IHARG(5).EQ.'UPPE'.AND.IHARG(6).EQ.'HING')GOTO2882
        IF(IHARG(5).EQ.'LOWE'.AND.IHARG(6).EQ.'QUAR')GOTO2884
        IF(IHARG(5).EQ.'UPPE'.AND.IHARG(6).EQ.'QUAR')GOTO2886
        IF(IHARG(5).EQ.'SKEW')GOTO2888
        IF(IHARG(5).EQ.'KURT')GOTO2890
        IF(IHARG(5).EQ.'AUTO'.AND.IHARG2(5).EQ.'CORR')GOTO2892
        IF(IHARG(5).EQ.'AUTO'.AND.IHARG2(5).EQ.'COVA')GOTO2894
        IF(IHARG(5).EQ.'INTE'.AND.IHARG(6).EQ.'RANG')GOTO2896
        IF(IHARG(5).EQ.'IQ  '.AND.IHARG(6).EQ.'RANG')GOTO2896
        IF(IHARG(5).EQ.'BIWE'.AND.IHARG(6).EQ.'LOCA')GOTO2898
        IF(IHARG(5).EQ.'BIWE'.AND.IHARG(6).EQ.'SCAL')GOTO2899
        IF(IHARG(5).EQ.'BIWE'.AND.IHARG(6).EQ.'MIDV')GOTO12900
        IF(IHARG(5).EQ.'WINS'.AND.IHARG(6).EQ.'SD')GOTO12901
        IF(IHARG(5).EQ.'WINS'.AND.IHARG(6).EQ.'STAN'.AND.
     1     IHARG(7).EQ.'DEVI')GOTO12902
        IF(IHARG(5).EQ.'WINS'.AND.IHARG(6).EQ.'VARI')GOTO12903
        IF(IHARG(5).EQ.'PERC'.AND.
     1     IHARG(6).EQ.'BEND'.AND.IHARG(7).EQ.'MIDV')GOTO12904
        IF(IHARG(5).EQ.'HODG'.AND.IHARG(6).EQ.'LEHM')GOTO12905
        IF(IHARG(5).EQ.'QUAN'.AND.
     1     IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'ERRO')GOTO12906
        IF(IHARG(5).EQ.'QUAN')GOTO12907
        IF(IHARG(5).EQ.'CP')GOTO12911
        IF(IHARG(5).EQ.'CPK')GOTO12912
        IF(IHARG(5).EQ.'CPM')GOTO12913
        IF(IHARG(5).EQ.'CPL')GOTO12914
        IF(IHARG(5).EQ.'CPU')GOTO12915
        IF(IHARG(5).EQ.'CNPK')GOTO12916
        IF(IHARG(5).EQ.'CC')GOTO12917
        IF(IHARG(5).EQ.'PERC'.AND.IHARG(6).EQ.'DEFE')GOTO12918
        IF(IHARG(5).EQ.'EXPE'.AND.IHARG(6).EQ.'LOSS')GOTO12919
        IF(IHARG(5).EQ.'PERC')GOTO12921
        IF(IHARG(5).EQ.'HARM'.AND.IHARG(6).EQ.'MEAN')GOTO12922
        IF(IHARG(5).EQ.'GEOM'.AND.IHARG(6).EQ.'MEAN')GOTO12923
        IF(IHARG(5).EQ.'GEOM'.AND.IHARG(6).EQ.'SD')GOTO12924
        IF(IHARG(5).EQ.'GEOM'.AND.
     1     IHARG(6).EQ.'STAN'.AND.IHARG(7).EQ.'DEVI')GOTO12925
        IF(IHARG(5).EQ.'NORM'.AND.IHARG(6).EQ.'PPCC')GOTO12926
        IF(IHARG(5).EQ.'FIRS'.AND.IHARG(6).EQ.'DECI')GOTO12931
        IF(IHARG(5).EQ.'SECO'.AND.IHARG(6).EQ.'DECI')GOTO12932
        IF(IHARG(5).EQ.'THIR'.AND.IHARG(6).EQ.'DECI')GOTO12933
        IF(IHARG(5).EQ.'FOUR'.AND.IHARG(6).EQ.'DECI')GOTO12934
        IF(IHARG(5).EQ.'FIFT'.AND.IHARG(6).EQ.'DECI')GOTO12935
        IF(IHARG(5).EQ.'SIXT'.AND.IHARG(6).EQ.'DECI')GOTO12936
        IF(IHARG(5).EQ.'SEVE'.AND.IHARG(6).EQ.'DECI')GOTO12937
        IF(IHARG(5).EQ.'EIGH'.AND.IHARG(6).EQ.'DECI')GOTO12938
        IF(IHARG(5).EQ.'NINT'.AND.IHARG(6).EQ.'DECI')GOTO12939
        IF(IHARG(5).EQ.'TAGU'.AND.IHARG(6).EQ.'SN00')GOTO12941
        IF(IHARG(5).EQ.'TAGU'.AND.IHARG(6).EQ.'SN0')GOTO12942
        IF(IHARG(5).EQ.'TAGU'.AND.IHARG(6).EQ.'SN+')GOTO12943
        IF(IHARG(5).EQ.'TAGU'.AND.IHARG(6).EQ.'SN-')GOTO12944
        IF(IHARG(5).EQ.'SN00')GOTO12946
        IF(IHARG(5).EQ.'SN0')GOTO12947
        IF(IHARG(5).EQ.'SN+')GOTO12948
        IF(IHARG(5).EQ.'SN-')GOTO12949
        IF(IHARG(5).EQ.'SINE'.AND.IHARG(6).EQ.'FREQ')GOTO12951
        IF(IHARG(5).EQ.'SIN'.AND.IHARG(6).EQ.'FREQ')GOTO12951
        IF(IHARG(5).EQ.'SINE'.AND.IHARG(6).EQ.'AMPL')GOTO12952
        IF(IHARG(5).EQ.'SIN'.AND.IHARG(6).EQ.'AMPL')GOTO12952
        IF(IHARG(5).EQ.'WEIG'.AND.IHARG(6).EQ.'MEAN')GOTO12954
        IF(IHARG(5).EQ.'WEIG'.AND.IHARG(6).EQ.'VARI')GOTO12956
        IF(IHARG(5).EQ.'WEIG'.AND.IHARG(6).EQ.'SD')GOTO12958
        IF(IHARG(5).EQ.'WEIG'.AND.IHARG(6).EQ.'STAN'.AND.
     1     IHARG(7).EQ.'DEVI')GOTO12960
        IF(IHARG(5).EQ.'RATI')GOTO12961
C
C  IMPLEMENT "DIFFERENCE OF" STATISTICS
C
        IF(NUMARG.GE.6.AND.
     1     IHARG(5).EQ.'DIFF'.AND.IHARG(6).EQ.'OF')THEN
          IF(IHARG(7).EQ.'MEAN' .OR. IHARG(7).EQ.'AVER')GOTO12501
          IF(IHARG(7).EQ.'MIDM')GOTO12502
          IF(IHARG(7).EQ.'MEDI')GOTO12503
          IF(IHARG(7).EQ.'TRIM'.AND.IHARG(8).EQ.'MEAN')GOTO12504
          IF(IHARG(7).EQ.'WINS'.AND.IHARG(8).EQ.'MEAN')GOTO12505
          IF(IHARG(7).EQ.'GEOM'.AND.IHARG(8).EQ.'MEAN')GOTO12506
          IF(IHARG(7).EQ.'HARM'.AND.IHARG(8).EQ.'MEAN')GOTO12507
          IF(IHARG(7).EQ.'HODG'.AND.IHARG(8).EQ.'LEHM')GOTO12508
          IF(IHARG(7).EQ.'BIWE'.AND.IHARG(8).EQ.'LOCA')GOTO12509
          IF(IHARG(7).EQ.'SD')GOTO12520
          IF(IHARG(7).EQ.'STAN'.AND.IHARG(8).EQ.'DEVI')GOTO12521
          IF(IHARG(7).EQ.'VARI')GOTO12522
          IF(IHARG(7).EQ.'AVER'.AND.IHARG(8).EQ.'ABSO'.AND.
     1     IHARG(9).EQ.'DEVI')GOTO12623
          IF(IHARG(7).EQ.'AAD')GOTO12523
          IF(IHARG(7).EQ.'MEDI'.AND.IHARG(8).EQ.'ABSO'.AND.
     1     IHARG(9).EQ.'DEVI')GOTO12624
          IF(IHARG(7).EQ.'MAD')GOTO12524
          IF(IHARG(7).EQ.'INTE'.AND.IHARG(8).EQ.'RANG')GOTO12525
          IF(IHARG(7).EQ.'IQ  '.AND.IHARG(8).EQ.'RANG')GOTO12525
          IF(IHARG(7).EQ.'WINS'.AND.IHARG(8).EQ.'SD')GOTO12526
          IF(IHARG(7).EQ.'WINS'.AND.IHARG(8).EQ.'VARI')GOTO12527
          IF(IHARG(7).EQ.'BIWE'.AND.IHARG(8).EQ.'MIDV')GOTO12528
          IF(IHARG(7).EQ.'BIWE'.AND.IHARG(8).EQ.'SCAL')GOTO12529
          IF(IHARG(7).EQ.'PERC'.AND.IHARG(8).EQ.'BEND'.AND.
     1     IHARG(9).EQ.'MIDV')GOTO12530
          IF(IHARG(7).EQ.'GEOM'.AND.IHARG(8).EQ.'SD')GOTO12531
          IF(IHARG(7).EQ.'RANG')GOTO12532
          IF(IHARG(7).EQ.'MIDR')GOTO12533
          IF(IHARG(7).EQ.'QUAN')GOTO12534
          IF(IHARG(7).EQ.'SKEW')GOTO12535
          IF(IHARG(7).EQ.'KURT')GOTO12536
          IF(IHARG(7).EQ.'RELA'.AND.IHARG(8).EQ.'SD')GOTO12537
          IF(IHARG(7).EQ.'SD'.AND.IHARG(8).EQ.'OF'.AND.
     1     IHARG(9).EQ.'THE'.AND.IHARG(10).EQ.'MEAN')GOTO12738
          IF(IHARG(7).EQ.'SD'.AND.IHARG(8).EQ.'OF'.AND.
     1     IHARG(9).EQ.'MEAN')GOTO12638
          IF(IHARG(7).EQ.'SD'.AND.IHARG(8).EQ.'MEAN')GOTO12538
          IF(IHARG(7).EQ.'RELA'.AND.IHARG(8).EQ.'VARI')GOTO12539
          IF(IHARG(7).EQ.'VARI'.AND.IHARG(8).EQ.'OF'.AND.
     1     IHARG(9).EQ.'THE'.AND.IHARG(10).EQ.'MEAN')GOTO12740
          IF(IHARG(7).EQ.'VARI'.AND.IHARG(8).EQ.'OF'.AND.
     1     IHARG(9).EQ.'MEAN')GOTO12640
          IF(IHARG(7).EQ.'VARI'.AND.IHARG(8).EQ.'MEAN')GOTO12540
          IF(IHARG(7).EQ.'MINI')GOTO12541
          IF(IHARG(7).EQ.'MAXI')GOTO12542
          IF(IHARG(7).EQ.'EXTR')GOTO12543
          IF(IHARG(7).EQ.'COEF'.AND.IHARG(8).EQ.'OF'.AND.
     1     IHARG(9).EQ.'VARI')GOTO12554
          IF(IHARG(7).EQ.'COEF'.AND.IHARG(8).EQ.'VARI')GOTO12544
          IF(IHARG(7).EQ.'SN')GOTO12545
          IF(IHARG(7).EQ.'QN')GOTO12546
          IF(IHARG(7).EQ.'SUM')GOTO12551
          IF(IHARG(7).EQ.'SUMS')GOTO12551
          IF(IHARG(7).EQ.'SIZE')GOTO12552
          IF(IHARG(7).EQ.'NUMB')GOTO12552
          IF(IHARG(7).EQ.'COUN')GOTO12552
        ENDIF
      ENDIF
C
C               ********************************
C               **  IF NO MATCH, THEN RETURN  **
C               ********************************
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
11206 CONTINUE
      ICASL7='IART'
      GOTO8005
C
 1207 CONTINUE
      ICASL7='CUMS'
      GOTO8005
C
11207 CONTINUE
      ICASL7='CUMA'
      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
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
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
 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
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
 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
 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
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 MARCH 2001
 2820 CONTINUE
      ICASL7='USCO'
      GOTO8004
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 LONG SECTION IDENTIFIES THE SPECFIC STATISTIC
CCCCC FOR THE CROSS TABULATE COMMAND
 2832 CONTINUE
      ICASL7='CTAB'
      ICASS7='MEAN'
      GOTO8006
C
 2834 CONTINUE
      ICASL7='CTAB'
      ICASS7='MIDM'
      GOTO8006
C
 2836 CONTINUE
      ICASL7='CTAB'
      ICASS7='MEDI'
      GOTO8006
C
 2838 CONTINUE
      ICASL7='CTAB'
      ICASS7='TRIM'
      GOTO8007
C
 2840 CONTINUE
      ICASL7='CTAB'
      ICASS7='WINM'
      GOTO8007
C
 2842 CONTINUE
      ICASL7='CTAB'
      ICASS7='SUM'
      GOTO8006
C
 2844 CONTINUE
      ICASL7='CTAB'
      ICASS7='PROD'
      GOTO8006
C
 2846 CONTINUE
      ICASL7='CTAB'
      ICASS7='SD'
      GOTO8006
C
 2848 CONTINUE
      ICASL7='CTAB'
      ICASS7='SD'
      GOTO8007
C
 2850 CONTINUE
      ICASL7='CTAB'
      ICASS7='SDME'
      GOTO8009
C
 2852 CONTINUE
      ICASL7='CTAB'
      ICASS7='SDME'
      GOTO8008
C
 2854 CONTINUE
      ICASL7='CTAB'
      ICASS7='VARI'
      GOTO8006
C
 2856 CONTINUE
      ICASL7='CTAB'
      ICASS7='VAME'
      GOTO8008
C
 2858 CONTINUE
      ICASL7='CTAB'
      ICASS7='REVA'
      GOTO8007
C
 2860 CONTINUE
      ICASL7='CTAB'
      ICASS7='RESD'
      GOTO8007
C
 2862 CONTINUE
      ICASL7='CT26'
      ICASS7='RESD'
      GOTO8008
C
 2864 CONTINUE
      ICASL7='CTAB'
      ICASS7='CVAR'
      GOTO8008
C
 2866 CONTINUE
      ICASL7='CTAB'
      ICASS7='AAD'
      GOTO8008
C
 2868 CONTINUE
      ICASL7='CTAB'
      ICASS7='MAD'
      GOTO8008
C
 2869 CONTINUE
      ICASL7='CTAB'
      ICASS7='MAD'
      GOTO8006
C
 2870 CONTINUE
      ICASL7='CTAB'
      ICASS7='RANG'
      GOTO8006
C
 2872 CONTINUE
      ICASL7='CTAB'
      ICASS7='MIDR'
      GOTO8006
C
 2874 CONTINUE
      ICASL7='CTAB'
      ICASS7='MAXI'
      GOTO8006
C
 2876 CONTINUE
      ICASL7='CTAB'
      ICASS7='MINI'
      GOTO8006
C
 2878 CONTINUE
      ICASL7='CTAB'
      ICASS7='EXTR'
      GOTO8006
C
 2880 CONTINUE
      ICASL7='CTAB'
      ICASS7='LOWH'
      GOTO8007
C
 2882 CONTINUE
      ICASL7='CTAB'
      ICASS7='UPPH'
      GOTO8007
C
 2884 CONTINUE
      ICASL7='CTAB'
      ICASS7='LOWQ'
      GOTO8007
C
 2886 CONTINUE
      ICASL7='CTAB'
      ICASS7='UPPQ'
      GOTO8007
C
 2888 CONTINUE
      ICASL7='CTAB'
      ICASS7='SKEW'
      GOTO8006
C
 2890 CONTINUE
      ICASL7='CTAB'
      ICASS7='KURT'
      GOTO8006
C
 2892 CONTINUE
      ICASL7='CTAB'
      ICASS7='AUCR'
      GOTO8006
C
 2894 CONTINUE
      ICASL7='CTAB'
      ICASS7='AUCV'
      GOTO8006
C
 2896 CONTINUE
      ICASL7='CTAB'
      ICASS7='IQRA'
      GOTO8007
C
 2898 CONTINUE
      ICASL7='CTAB'
      ICASS7='BILO'
      GOTO8007
C
 2899 CONTINUE
      ICASL7='CTAB'
      ICASS7='BISC'
      GOTO8007
C
12900 CONTINUE
      ICASL7='CTAB'
      ICASS7='BIMV'
      GOTO8007
C
12901 CONTINUE
      ICASL7='CTAB'
      ICASS7='WISD'
      GOTO8007
C
12902 CONTINUE
      ICASL7='CTAB'
      ICASS7='WISD'
      GOTO8008
C
12903 CONTINUE
      ICASL7='CTAB'
      ICASS7='WIVA'
      GOTO8007
C
12904 CONTINUE
      ICASL7='CTAB'
      ICASS7='PBMV'
      GOTO8008
C
12905 CONTINUE
      ICASL7='CTAB'
      ICASS7='HLEH'
      GOTO8007
C
12906 CONTINUE
      ICASL7='CTAB'
      ICASS7='QUSE'
      GOTO8008
C
12907 CONTINUE
      ICASL7='CTAB'
      ICASS7='QUAN'
      GOTO8006
C
12908 CONTINUE
      ICASL7='CTAB'
      ICASS7='TMSE'
      GOTO8008
C
12911 CONTINUE
      ICASL7='CTAB'
      ICASS7='CP'
      GOTO8006
C
12912 CONTINUE
      ICASL7='CTAB'
      ICASS7='CPK'
      GOTO8006
C
12913 CONTINUE
      ICASL7='CTAB'
      ICASS7='CPM'
      GOTO8006
C
12914 CONTINUE
      ICASL7='CTAB'
      ICASS7='CPL'
      GOTO8006
C
12915 CONTINUE
      ICASL7='CTAB'
      ICASS7='CPU'
      GOTO8006
C
12916 CONTINUE
      ICASL7='CTAB'
      ICASS7='CNPK'
      GOTO8006
C
12917 CONTINUE
      ICASL7='CTAB'
      ICASS7='CC'
      GOTO8006
C
12918 CONTINUE
      ICASL7='CTAB'
      ICASS7='PEDE'
      GOTO8007
C
12919 CONTINUE
      ICASL7='CTAB'
      ICASS7='EXLO'
      GOTO8007
C
12921 CONTINUE
      ICASL7='CTAB'
      ICASS7='PERC'
      GOTO8006
C
12922 CONTINUE
      ICASL7='CTAB'
      ICASS7='HAME'
      GOTO8007
C
12923 CONTINUE
      ICASL7='CTAB'
      ICASS7='GEME'
      GOTO8007
C
12924 CONTINUE
      ICASL7='CTAB'
      ICASS7='GESD'
      GOTO8007
C
12925 CONTINUE
      ICASL7='CTAB'
      ICASS7='GESD'
      GOTO8008
C
12926 CONTINUE
      ICASL7='CTAB'
      ICASS7='NOPP'
      GOTO8007
C
12931 CONTINUE
      ICASL7='CTAB'
      ICASS7='1DEC'
      GOTO8007
C
12932 CONTINUE
      ICASL7='CTAB'
      ICASS7='2DEC'
      GOTO8007
C
12933 CONTINUE
      ICASL7='CTAB'
      ICASS7='3DEC'
      GOTO8007
C
12934 CONTINUE
      ICASL7='CTAB'
      ICASS7='4DEC'
      GOTO8007
C
12935 CONTINUE
      ICASL7='CTAB'
      ICASS7='5DEC'
      GOTO8007
C
12936 CONTINUE
      ICASL7='CTAB'
      ICASS7='6DEC'
      GOTO8007
C
12937 CONTINUE
      ICASL7='CTAB'
      ICASS7='7DEC'
      GOTO8007
C
12938 CONTINUE
      ICASL7='CTAB'
      ICASS7='8DEC'
      GOTO8007
C
12939 CONTINUE
      ICASL7='CTAB'
      ICASS7='9DEC'
      GOTO8007
C
12941 CONTINUE
      ICASL7='CTAB'
      ICASS7='SN00'
      GOTO8007
C
12942 CONTINUE
      ICASL7='CTAB'
      ICASS7='SN0'
      GOTO8007
C
12943 CONTINUE
      ICASL7='CTAB'
      ICASS7='SN+'
      GOTO8007
C
12944 CONTINUE
      ICASL7='CTAB'
      ICASS7='SN-'
      GOTO8007
C
12946 CONTINUE
      ICASL7='CTAB'
      ICASS7='SN00'
      GOTO8006
C
12947 CONTINUE
      ICASL7='CTAB'
      ICASS7='SN0'
      GOTO8006
C
12948 CONTINUE
      ICASL7='CTAB'
      ICASS7='SN+'
      GOTO8006
C
12949 CONTINUE
      ICASL7='CTAB'
      ICASS7='SN-'
      GOTO8006
C
12951 CONTINUE
      ICASL7='CTAB'
      ICASS7='SIFR'
      GOTO8007
C
12952 CONTINUE
      ICASL7='CTAB'
      ICASS7='SIAM'
      GOTO8007
C
12954 CONTINUE
      ICASL7='CTAB'
      ICASS7='WEME'
      GOTO8007
C
12956 CONTINUE
      ICASL7='CTAB'
      ICASS7='WEVA'
      GOTO8007
C
12958 CONTINUE
      ICASL7='CTAB'
      ICASS7='WESD'
      GOTO8007
C
12960 CONTINUE
      ICASL7='CTAB'
      ICASS7='WESD'
      GOTO8008
C
12961 CONTINUE
      ICASL7='CTAB'
      ICASS7='RATI'
      GOTO8006
C
12962 CONTINUE
      ICASL7='CTAB'
      ICASS7='SNSC'
      GOTO8007
C
12964 CONTINUE
      ICASL7='CTAB'
      ICASS7='QNSC'
      GOTO8007
C
12501 CONTINUE
      ICASL7='CTAB'
      ICASS7='DMEA'
      GOTO8008
C
12502 CONTINUE
      ICASL7='CTAB'
      ICASS7='DMDM'
      GOTO8008
C
12503 CONTINUE
      ICASL7='CTAB'
      ICASS7='DMED'
      GOTO8008
C
12504 CONTINUE
      ICASL7='CTAB'
      ICASS7='DTRM'
      GOTO8009
C
12505 CONTINUE
      ICASL7='CTAB'
      ICASS7='DWNM'
      GOTO8009
C
12506 CONTINUE
      ICASL7='CTAB'
      ICASS7='DGEO'
      GOTO8009
C
12507 CONTINUE
      ICASL7='CTAB'
      ICASS7='DHAR'
      GOTO8009
C
12508 CONTINUE
      ICASL7='CTAB'
      ICASS7='DHDL'
      GOTO8009
C
12509 CONTINUE
      ICASL7='CTAB'
      ICASS7='DBIW'
      GOTO8009
C
12520 CONTINUE
      ICASL7='CTAB'
      ICASS7='DSD '
      GOTO8008
C
12521 CONTINUE
      ICASL7='CTAB'
      ICASS7='DSD '
      GOTO8009
C
12522 CONTINUE
      ICASL7='CTAB'
      ICASS7='DVAR'
      GOTO8008
C
12623 CONTINUE
      ICASL7='CTAB'
      ICASS7='DAAD'
      GOTO8010
C
12523 CONTINUE
      ICASL7='CTAB'
      ICASS7='DAAD'
      GOTO8008
C
12624 CONTINUE
      ICASL7='CTAB'
      ICASS7='MAAD'
      GOTO8010
C
12524 CONTINUE
      ICASL7='CTAB'
      ICASS7='DMAD'
      GOTO8008
C
12525 CONTINUE
      ICASL7='CTAB'
      ICASS7='DIQR'
      GOTO8009
C
12526 CONTINUE
      ICASL7='CTAB'
      ICASS7='DWSD'
      GOTO8010
C
12527 CONTINUE
      ICASL7='CTAB'
      ICASS7='DWVA'
      GOTO8009
C
12528 CONTINUE
      ICASL7='CTAB'
      ICASS7='DBIM'
      GOTO8009
C
12529 CONTINUE
      ICASL7='CTAB'
      ICASS7='DBIS'
      GOTO8009
C
12530 CONTINUE
      ICASL7='CTAB'
      ICASS7='DPBN'
      GOTO8010
C
12531 CONTINUE
      ICASL7='CTAB'
      ICASS7='DGSD'
      GOTO8010
C
12532 CONTINUE
      ICASL7='CTAB'
      ICASS7='DRAN'
      GOTO8008
C
12533 CONTINUE
      ICASL7='CTAB'
      ICASS7='DMDR'
      GOTO8009
C
12534 CONTINUE
      ICASL7='CTAB'
      ICASS7='DQUA'
      GOTO8008
C
12535 CONTINUE
      ICASL7='CTAB'
      ICASS7='DSKE'
      GOTO8008
C
12536 CONTINUE
      ICASL7='CTAB'
      ICASS7='DKUR'
      GOTO8008
C
12537 CONTINUE
      ICASL7='CTAB'
      ICASS7='DRSD'
      GOTO8009
C
12738 CONTINUE
      ICASL7='CTAB'
      ICASS7='DSDM'
      GOTO8011
C
12638 CONTINUE
      ICASL7='CTAB'
      ICASS7='DSDM'
      GOTO8010
C
12538 CONTINUE
      ICASL7='CTAB'
      ICASS7='DSDM'
      GOTO8009
C
12539 CONTINUE
      ICASL7='CTAB'
      ICASS7='DRVA'
      GOTO8009
C
12740 CONTINUE
      ICASL7='CTAB'
      ICASS7='DVAM'
      GOTO8011
C
12640 CONTINUE
      ICASL7='CTAB'
      ICASS7='DVAM'
      GOTO8010
C
12540 CONTINUE
      ICASL7='CTAB'
      ICASS7='DVAM'
      GOTO8009
C
12541 CONTINUE
      ICASL7='CTAB'
      ICASS7='DMIN'
      GOTO8008
C
12542 CONTINUE
      ICASL7='CTAB'
      ICASS7='DMAX'
      GOTO8008
C
12543 CONTINUE
      ICASL7='CTAB'
      ICASS7='DEXT'
      GOTO8008
C
12554 CONTINUE
      ICASL7='CTAB'
      ICASS7='DCVA'
      GOTO8010
C
12544 CONTINUE
      ICASL7='CTAB'
      ICASS7='DCVA'
      GOTO8009
C
12545 CONTINUE
      ICASL7='CTAB'
      ICASS7='DSN'
      GOTO8008
C
12546 CONTINUE
      ICASL7='CTAB'
      ICASS7='DQN'
      GOTO8008
C
12551 CONTINUE
      ICASL7='CTAB'
      ICASS7='DSUM'
      GOTO8008
C
12552 CONTINUE
      ICASL7='CTAB'
      ICASS7='DCOU'
      GOTO8008
C
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
 2992 CONTINUE
      ICASL7='MROW'
      ICASS7='MEAN'
      GOTO8006
C
 3002 CONTINUE
      ICASL7='MROW'
      ICASS7='MIDM'
      GOTO8006
C
 3012 CONTINUE
      ICASL7='MROW'
      ICASS7='MEDI'
      GOTO8006
C
 3022 CONTINUE
      ICASL7='MROW'
      ICASS7='TRIM'
      GOTO8007
C
 3024 CONTINUE
      ICASL7='MROW'
      ICASS7='TRSE'
      GOTO8009
C
 3032 CONTINUE
      ICASL7='MROW'
      ICASS7='WINM'
      GOTO8007
C
 3034 CONTINUE
      ICASL7='MROW'
      ICASS7='HLEH'
      GOTO8007
C
 3036 CONTINUE
      ICASL7='MROW'
      ICASS7='BILO'
      GOTO8007
C
 3038 CONTINUE
      ICASL7='MROW'
      ICASS7='BISC'
      GOTO8007
C
 3042 CONTINUE
      ICASL7='MROW'
      ICASS7='SUM'
      GOTO8006
C
 3045 CONTINUE
      ICASL7='MROW'
      ICASS7='PROD'
      GOTO8006
C
 3052 CONTINUE
      ICASL7='MROW'
      ICASS7='SD'
      GOTO8006
C
 3062 CONTINUE
      ICASL7='MROW'
      ICASS7='SD'
      GOTO8007
C
 3063 CONTINUE
      ICASL7='MROW'
      ICASS7='BIMV'
      GOTO8007
C
 3064 CONTINUE
      ICASL7='MROW'
      ICASS7='PBMV'
      GOTO8008
C
 3065 CONTINUE
      ICASL7='MROW'
      ICASS7='WIVA'
      GOTO8007
C
 3066 CONTINUE
      ICASL7='MROW'
      ICASS7='WISD'
      GOTO8007
C
 3067 CONTINUE
      ICASL7='MROW'
      ICASS7='WISD'
      GOTO8008
C
 3072 CONTINUE
      ICASL7='MROW'
      ICASS7='SDME'
      GOTO8009
C
 3082 CONTINUE
      ICASL7='MROW'
      ICASS7='SDME'
      GOTO8008
C
 3092 CONTINUE
      ICASL7='MROW'
      ICASS7='VARI'
      GOTO8006
C
 3102 CONTINUE
      ICASL7='MROW'
      ICASS7='VAME'
      GOTO8008
C
 3112 CONTINUE
      ICASL7='MROW'
      ICASS7='REVA'
      GOTO8007
C
 3122 CONTINUE
      ICASL7='MROW'
      ICASS7='RESD'
      GOTO8007
C
 3132 CONTINUE
      ICASL7='MROW'
      ICASS7='RESD'
      GOTO8008
C
 3142 CONTINUE
      ICASL7='MROW'
      ICASS7='CVAR'
      GOTO8008
C
 3152 CONTINUE
      ICASL7='MROW'
      ICASS7='AAD'
      GOTO8008
C
 3162 CONTINUE
      ICASL7='MROW'
      ICASS7='MAD'
      GOTO8008
C
 3172 CONTINUE
      ICASL7='MROW'
      ICASS7='RANG'
      GOTO8006
C
 3182 CONTINUE
      ICASL7='MROW'
      ICASS7='MIDR'
      GOTO8006
C
 3192 CONTINUE
      ICASL7='MROW'
      ICASS7='MAXI'
      GOTO8006
C
 3202 CONTINUE
      ICASL7='MROW'
      ICASS7='MINI'
      GOTO8006
C
 3212 CONTINUE
      ICASL7='MROW'
      ICASS7='EXTR'
      GOTO8006
C
 3222 CONTINUE
      ICASL7='MROW'
      ICASS7='LOWH'
      GOTO8007
C
 3232 CONTINUE
      ICASL7='MROW'
      ICASS7='UPPH'
      GOTO8007
C
 3242 CONTINUE
      ICASL7='MROW'
      ICASS7='LOWQ'
      GOTO8007
C
 3252 CONTINUE
      ICASL7='MROW'
      ICASS7='UPPQ'
      GOTO8007
C
 3262 CONTINUE
      ICASL7='MROW'
      ICASS7='SKEW'
      GOTO8006
C
 3272 CONTINUE
      ICASL7='MROW'
      ICASS7='KURT'
      GOTO8006
C
 3282 CONTINUE
      ICASL7='MROW'
      ICASS7='AUCR'
      GOTO8006
C
 3292 CONTINUE
      ICASL7='MROW'
      ICASS7='AUCV'
      GOTO8006
C
 3302 CONTINUE
      ICASL7='MRSC'
      GOTO8006
C
 3303 CONTINUE
      ICASL7='MROW'
      ICASS7='QUSE'
      GOTO8008
C
 3304 CONTINUE
      ICASL7='MROW'
      ICASS7='QUAN'
      GOTO8006
C
 3311 CONTINUE
      ICASL7='MROW'
      ICASS7='CP'
      GOTO8006
C
 3312 CONTINUE
      ICASL7='MROW'
      ICASS7='CPK'
      GOTO8006
C
 3313 CONTINUE
      ICASL7='MROW'
      ICASS7='CPM'
      GOTO8006
C
 3314 CONTINUE
      ICASL7='MROW'
      ICASS7='CPL'
      GOTO8006
C
 3315 CONTINUE
      ICASL7='MROW'
      ICASS7='CPU'
      GOTO8006
C
 3316 CONTINUE
      ICASL7='MROW'
      ICASS7='CNPK'
      GOTO8006
C
 3317 CONTINUE
      ICASL7='MROW'
      ICASS7='CC'
      GOTO8006
C
 3318 CONTINUE
      ICASL7='MROW'
      ICASS7='PEDE'
      GOTO8007
C
 3319 CONTINUE
      ICASL7='MROW'
      ICASS7='EXLO'
      GOTO8007
C
 3321 CONTINUE
      ICASL7='MROW'
      ICASS7='PERC'
      GOTO8006
C
 3322 CONTINUE
      ICASL7='MROW'
      ICASS7='HAME'
      GOTO8007
C
 3323 CONTINUE
      ICASL7='MROW'
      ICASS7='GEME'
      GOTO8007
C
 3324 CONTINUE
      ICASL7='MROW'
      ICASS7='GESD'
      GOTO8007
C
 3325 CONTINUE
      ICASL7='MROW'
      ICASS7='GESD'
      GOTO8008
C
 3326 CONTINUE
      ICASL7='MROW'
      ICASS7='NOPP'
      GOTO8007
C
 3331 CONTINUE
      ICASL7='MROW'
      ICASS7='1DEC'
      GOTO8007
C
 3332 CONTINUE
      ICASL7='MROW'
      ICASS7='2DEC'
      GOTO8007
C
 3333 CONTINUE
      ICASL7='MROW'
      ICASS7='3DEC'
      GOTO8007
C
 3334 CONTINUE
      ICASL7='MROW'
      ICASS7='4DEC'
      GOTO8007
C
 3335 CONTINUE
      ICASL7='MROW'
      ICASS7='5DEC'
      GOTO8007
C
 3336 CONTINUE
      ICASL7='MROW'
      ICASS7='6DEC'
      GOTO8007
C
 3337 CONTINUE
      ICASL7='MROW'
      ICASS7='7DEC'
      GOTO8007
C
 3338 CONTINUE
      ICASL7='MROW'
      ICASS7='8DEC'
      GOTO8007
C
 3339 CONTINUE
      ICASL7='MROW'
      ICASS7='9DEC'
      GOTO8007
C
 3341 CONTINUE
      ICASL7='MROW'
      ICASS7='SN00'
      GOTO8007
C
 3342 CONTINUE
      ICASL7='MROW'
      ICASS7='SN0'
      GOTO8007
C
 3343 CONTINUE
      ICASL7='MROW'
      ICASS7='SN+'
      GOTO8007
C
 3344 CONTINUE
      ICASL7='MROW'
      ICASS7='SN-'
      GOTO8007
C
 3346 CONTINUE
      ICASL7='MROW'
      ICASS7='SN00'
      GOTO8006
C
 3347 CONTINUE
      ICASL7='MROW'
      ICASS7='SN0'
      GOTO8006
C
 3348 CONTINUE
      ICASL7='MROW'
      ICASS7='SN+'
      GOTO8006
C
 3349 CONTINUE
      ICASL7='MROW'
      ICASS7='SN-'
      GOTO8006
C
 3351 CONTINUE
      ICASL7='MROW'
      ICASS7='SIFR'
      GOTO8007
C
 3352 CONTINUE
      ICASL7='MROW'
      ICASS7='SIAM'
      GOTO8007
C
 3354 CONTINUE
      ICASL7='MROW'
      ICASS7='SNSC'
      GOTO8007
C
 3356 CONTINUE
      ICASL7='MROW'
      ICASS7='QNSC'
      GOTO8007
C
 3992 CONTINUE
      ICASL7='MCOL'
      ICASS7='MEAN'
      GOTO8006
C
 4002 CONTINUE
      ICASL7='MCOL2'
      ICASS7='MIDM'
      GOTO8006
C
 4012 CONTINUE
      ICASL7='MCOL'
      ICASS7='MEDI'
      GOTO8006
C
 4022 CONTINUE
      ICASL7='MCOL'
      ICASS7='TRIM'
      GOTO8007
C
 4024 CONTINUE
      ICASL7='MCOL'
      ICASS7='TRSE'
      GOTO8009
C
 4032 CONTINUE
      ICASL7='MCOL'
      ICASS7='WINM'
      GOTO8007
C
 4034 CONTINUE
      ICASL7='MCOL'
      ICASS7='HLEH'
      GOTO8007
C
 4036 CONTINUE
      ICASL7='MCOL'
      ICASS7='BILO'
      GOTO8007
C
 4038 CONTINUE
      ICASL7='MCOL'
      ICASS7='BISC'
      GOTO8007
C
 4042 CONTINUE
      ICASL7='MCOL'
      ICASS7='SUM'
      GOTO8006
C
 4045 CONTINUE
      ICASL7='MCOL'
      ICASS7='PROD'
      GOTO8006
C
 4052 CONTINUE
      ICASL7='MCOL'
      ICASS7='SD'
      GOTO8006
C
 4062 CONTINUE
      ICASL7='MCOL'
      ICASS7='SD'
      GOTO8007
C
 4063 CONTINUE
      ICASL7='MCOL'
      ICASS7='BIMV'
      GOTO8007
C
 4064 CONTINUE
      ICASL7='MCOL'
      ICASS7='PBMV'
      GOTO8008
C
 4065 CONTINUE
      ICASL7='MCOL'
      ICASS7='WIVA'
      GOTO8007
C
 4066 CONTINUE
      ICASL7='MCOL'
      ICASS7='WISD'
      GOTO8007
C
 4067 CONTINUE
      ICASL7='MCOL'
      ICASS7='WISD'
      GOTO8008
C
 4072 CONTINUE
      ICASL7='MCOL'
      ICASS7='SDME'
      GOTO8009
C
 4082 CONTINUE
      ICASL7='MCOL'
      ICASS7='SDME'
      GOTO8008
C
 4092 CONTINUE
      ICASL7='MCOL'
      ICASS7='VARI'
      GOTO8006
C
 4102 CONTINUE
      ICASL7='MCOL'
      ICASS7='VAME'
      GOTO8008
C
 4112 CONTINUE
      ICASL7='MCOL'
      ICASS7='REVA'
      GOTO8007
C
 4122 CONTINUE
      ICASL7='MCOL'
      ICASS7='RESD'
      GOTO8007
C
 4132 CONTINUE
      ICASL7='MCOL'
      ICASS7='RESD'
      GOTO8008
C
 4142 CONTINUE
      ICASL7='MCOL'
      ICASS7='CVAR'
      GOTO8008
C
 4152 CONTINUE
      ICASL7='MCOL'
      ICASS7='AAD'
      GOTO8008
C
 4162 CONTINUE
      ICASL7='MCOL'
      ICASS7='MAD'
      GOTO8008
C
 4172 CONTINUE
      ICASL7='MCOL'
      ICASS7='RANG'
      GOTO8006
C
 4182 CONTINUE
      ICASL7='MCOL'
      ICASS7='MRAN'
      GOTO8006
C
 4192 CONTINUE
      ICASL7='MCOL'
      ICASS7='MAXI'
      GOTO8006
C
 4202 CONTINUE
      ICASL7='MCOL'
      ICASS7='MINI'
      GOTO8006
C
 4212 CONTINUE
      ICASL7='MCOL'
      ICASS7='EXTR'
      GOTO8006
C
 4222 CONTINUE
      ICASL7='MCOL'
      ICASS7='LOWH'
      GOTO8007
C
 4232 CONTINUE
      ICASL7='MCOL'
      ICASS7='UPPH'
      GOTO8007
C
 4242 CONTINUE
      ICASL7='MCOL'
      ICASS7='LOWQ'
      GOTO8007
C
 4252 CONTINUE
      ICASL7='MCOL'
      ICASS7='UPPQ'
      GOTO8007
C
 4262 CONTINUE
      ICASL7='MCOL'
      ICASS7='SKEW'
      GOTO8006
C
 4272 CONTINUE
      ICASL7='MCOL'
      ICASS7='KURT'
      GOTO8006
C
 4282 CONTINUE
      ICASL7='MCOL'
      ICASS7='AUCR'
      GOTO8006
C
 4292 CONTINUE
      ICASL7='MCOL'
      ICASS7='AUCV'
      GOTO8006
C
 4302 CONTINUE
      ICASL7='MCSC'
      GOTO8006
C
 4303 CONTINUE
      ICASL7='MCOL'
      ICASS7='QUSE'
      GOTO8008
C
 4304 CONTINUE
      ICASL7='MCOL'
      ICASS7='QUAN'
      GOTO8006
C
 4311 CONTINUE
      ICASL7='MCOL'
      ICASS7='CP'
      GOTO8006
C
 4312 CONTINUE
      ICASL7='MCOL'
      ICASS7='CPK'
      GOTO8006
C
 4313 CONTINUE
      ICASL7='MCOL'
      ICASS7='CPM'
      GOTO8006
C
 4314 CONTINUE
      ICASL7='MCOL'
      ICASS7='CPL'
      GOTO8006
C
 4315 CONTINUE
      ICASL7='MCOL'
      ICASS7='CPU'
      GOTO8006
C
 4316 CONTINUE
      ICASL7='MCOL'
      ICASS7='CNPK'
      GOTO8006
C
 4317 CONTINUE
      ICASL7='MCOL'
      ICASS7='CC'
      GOTO8006
C
 4318 CONTINUE
      ICASL7='MCOL'
      ICASS7='PEDE'
      GOTO8007
C
 4319 CONTINUE
      ICASL7='MCOL'
      ICASS7='EXLO'
      GOTO8007
C
 4321 CONTINUE
      ICASL7='MCOL'
      ICASS7='PERC'
      GOTO8006
C
 4322 CONTINUE
      ICASL7='MCOL'
      ICASS7='HAME'
      GOTO8007
C
 4323 CONTINUE
      ICASL7='MCOL'
      ICASS7='GEME'
      GOTO8007
C
 4324 CONTINUE
      ICASL7='MCOL'
      ICASS7='GESD'
      GOTO8007
C
 4325 CONTINUE
      ICASL7='MCOL'
      ICASS7='GESD'
      GOTO8008
C
 4326 CONTINUE
      ICASL7='MCOL'
      ICASS7='NOPP'
      GOTO8007
C
 4331 CONTINUE
      ICASL7='MCOL'
      ICASS7='1DEC'
      GOTO8007
C
 4332 CONTINUE
      ICASL7='MCOL'
      ICASS7='2DEC'
      GOTO8007
C
 4333 CONTINUE
      ICASL7='MCOL'
      ICASS7='3DEC'
      GOTO8007
C
 4334 CONTINUE
      ICASL7='MCOL'
      ICASS7='4DEC'
      GOTO8007
C
 4335 CONTINUE
      ICASL7='MCOL'
      ICASS7='5DEC'
      GOTO8007
C
 4336 CONTINUE
      ICASL7='MCOL'
      ICASS7='6DEC'
      GOTO8007
C
 4337 CONTINUE
      ICASL7='MCOL'
      ICASS7='7DEC'
      GOTO8007
C
 4338 CONTINUE
      ICASL7='MCOL'
      ICASS7='8DEC'
      GOTO8007
C
 4339 CONTINUE
      ICASL7='MCOL'
      ICASS7='9DEC'
      GOTO8007
C
 4341 CONTINUE
      ICASL7='MCOL'
      ICASS7='SN00'
      GOTO8007
C
 4342 CONTINUE
      ICASL7='MCOL'
      ICASS7='SN0'
      GOTO8007
C
 4343 CONTINUE
      ICASL7='MCOL'
      ICASS7='SN+'
      GOTO8007
C
 4344 CONTINUE
      ICASL7='MCOL'
      ICASS7='SN-'
      GOTO8007
C
 4346 CONTINUE
      ICASL7='MCOL'
      ICASS7='SN00'
      GOTO8006
C
 4347 CONTINUE
      ICASL7='MCOL'
      ICASS7='SN0'
      GOTO8006
C
 4348 CONTINUE
      ICASL7='MCOL'
      ICASS7='SN+'
      GOTO8006
C
 4349 CONTINUE
      ICASL7='MCOL'
      ICASS7='SN-'
      GOTO8006
C
 4351 CONTINUE
      ICASL7='MCOL'
      ICASS7='SIFR'
      GOTO8007
C
 4352 CONTINUE
      ICASL7='MCOL'
      ICASS7='SIAM'
      GOTO8007
C
 4354 CONTINUE
      ICASL7='MCOL'
      ICASS7='SNSC'
      GOTO8007
C
 4356 CONTINUE
      ICASL7='MCOL'
      ICASS7='QNSC'
      GOTO8007
C
 4500 CONTINUE
      ICASL7='MPAR'
      ICASS7='MEAN'
      GOTO8006
C
 4502 CONTINUE
      ICASL7='MPAR2'
      ICASS7='MIDM'
      GOTO8006
C
 4512 CONTINUE
      ICASL7='MPAR'
      ICASS7='MEDI'
      GOTO8006
C
 4522 CONTINUE
      ICASL7='MPAR'
      ICASS7='TRIM'
      GOTO8007
C
 4524 CONTINUE
      ICASL7='MPAR'
      ICASS7='TRSE'
      GOTO8009
C
 4532 CONTINUE
      ICASL7='MPAR'
      ICASS7='WINM'
      GOTO8007
C
 4534 CONTINUE
      ICASL7='MPAR'
      ICASS7='HLEH'
      GOTO8007
C
 4536 CONTINUE
      ICASL7='MPAR'
      ICASS7='BILO'
      GOTO8007
C
 4538 CONTINUE
      ICASL7='MPAR'
      ICASS7='BISC'
      GOTO8007
C
 4542 CONTINUE
      ICASL7='MPAR'
      ICASS7='SUM'
      GOTO8006
C
 4545 CONTINUE
      ICASL7='MPAR'
      ICASS7='PROD'
      GOTO8006
C
 4552 CONTINUE
      ICASL7='MPAR'
      ICASS7='SD'
      GOTO8006
C
 4562 CONTINUE
      ICASL7='MPAR'
      ICASS7='SD'
      GOTO8007
C
 4563 CONTINUE
      ICASL7='MPAR'
      ICASS7='BIMV'
      GOTO8007
C
 4564 CONTINUE
      ICASL7='MPAR'
      ICASS7='PBMV'
      GOTO8008
C
 4565 CONTINUE
      ICASL7='MPAR'
      ICASS7='WIVA'
      GOTO8007
C
 4566 CONTINUE
      ICASL7='MPAR'
      ICASS7='WISD'
      GOTO8007
C
 4567 CONTINUE
      ICASL7='MPAR'
      ICASS7='WISD'
      GOTO8008
C
 4572 CONTINUE
      ICASL7='MPAR'
      ICASS7='SDME'
      GOTO8009
C
 4582 CONTINUE
      ICASL7='MPAR'
      ICASS7='SDME'
      GOTO8008
C
 4592 CONTINUE
      ICASL7='MPAR'
      ICASS7='VARI'
      GOTO8006
C
 4602 CONTINUE
      ICASL7='MPAR'
      ICASS7='VAME'
      GOTO8008
C
 4612 CONTINUE
      ICASL7='MPAR'
      ICASS7='REVA'
      GOTO8007
C
 4622 CONTINUE
      ICASL7='MPAR'
      ICASS7='RESD'
      GOTO8007
C
 4632 CONTINUE
      ICASL7='MPAR'
      ICASS7='RESD'
      GOTO8008
C
 4642 CONTINUE
      ICASL7='MPAR'
      ICASS7='CVAR'
      GOTO8008
C
 4652 CONTINUE
      ICASL7='MPAR'
      ICASS7='AAD'
      GOTO8008
C
 4662 CONTINUE
      ICASL7='MPAR'
      ICASS7='MAD'
      GOTO8008
C
 4672 CONTINUE
      ICASL7='MPAR'
      ICASS7='RANG'
      GOTO8006
C
 4682 CONTINUE
      ICASL7='MPAR'
      ICASS7='MRAN'
      GOTO8006
C
 4692 CONTINUE
      ICASL7='MPAR'
      ICASS7='MAXI'
      GOTO8006
C
 4702 CONTINUE
      ICASL7='MPAR'
      ICASS7='MINI'
      GOTO8006
C
 4712 CONTINUE
      ICASL7='MPAR'
      ICASS7='EXTR'
      GOTO8006
C
 4722 CONTINUE
      ICASL7='MPAR'
      ICASS7='LOWH'
      GOTO8007
C
 4732 CONTINUE
      ICASL7='MPAR'
      ICASS7='UPPH'
      GOTO8007
C
 4742 CONTINUE
      ICASL7='MPAR'
      ICASS7='LOWQ'
      GOTO8007
C
 4752 CONTINUE
      ICASL7='MPAR'
      ICASS7='UPPQ'
      GOTO8007
C
 4762 CONTINUE
      ICASL7='MPAR'
      ICASS7='SKEW'
      GOTO8006
C
 4772 CONTINUE
      ICASL7='MPAR'
      ICASS7='KURT'
      GOTO8006
C
 4782 CONTINUE
      ICASL7='MPAR'
      ICASS7='AUCR'
      GOTO8006
C
 4792 CONTINUE
      ICASL7='MPAR'
      ICASS7='AUCV'
      GOTO8006
C
 4802 CONTINUE
      ICASL7='MCSC'
      GOTO8006
C
 4803 CONTINUE
      ICASL7='MPAR'
      ICASS7='QUSE'
      GOTO8008
C
 4804 CONTINUE
      ICASL7='MPAR'
      ICASS7='QUAN'
      GOTO8006
C
 4811 CONTINUE
      ICASL7='MPAR'
      ICASS7='CP'
      GOTO8006
C
 4812 CONTINUE
      ICASL7='MPAR'
      ICASS7='CPK'
      GOTO8006
C
 4813 CONTINUE
      ICASL7='MPAR'
      ICASS7='CPM'
      GOTO8006
C
 4814 CONTINUE
      ICASL7='MPAR'
      ICASS7='CPL'
      GOTO8006
C
 4815 CONTINUE
      ICASL7='MPAR'
      ICASS7='CPU'
      GOTO8006
C
 4816 CONTINUE
      ICASL7='MPAR'
      ICASS7='CNPK'
      GOTO8006
C
 4817 CONTINUE
      ICASL7='MPAR'
      ICASS7='CC'
      GOTO8006
C
 4818 CONTINUE
      ICASL7='MPAR'
      ICASS7='PEDE'
      GOTO8007
C
 4819 CONTINUE
      ICASL7='MPAR'
      ICASS7='EXLO'
      GOTO8007
C
 4821 CONTINUE
      ICASL7='MPAR'
      ICASS7='PERC'
      GOTO8006
C
 4822 CONTINUE
      ICASL7='MPAR'
      ICASS7='HAME'
      GOTO8007
C
 4823 CONTINUE
      ICASL7='MPAR'
      ICASS7='GEME'
      GOTO8007
C
 4824 CONTINUE
      ICASL7='MPAR'
      ICASS7='GESD'
      GOTO8007
C
 4825 CONTINUE
      ICASL7='MPAR'
      ICASS7='GESD'
      GOTO8008
C
 4826 CONTINUE
      ICASL7='MPAR'
      ICASS7='NOPP'
      GOTO8007
C
 4831 CONTINUE
      ICASL7='MPAR'
      ICASS7='1DEC'
      GOTO8007
C
 4832 CONTINUE
      ICASL7='MPAR'
      ICASS7='2DEC'
      GOTO8007
C
 4833 CONTINUE
      ICASL7='MPAR'
      ICASS7='3DEC'
      GOTO8007
C
 4834 CONTINUE
      ICASL7='MPAR'
      ICASS7='4DEC'
      GOTO8007
C
 4835 CONTINUE
      ICASL7='MPAR'
      ICASS7='5DEC'
      GOTO8007
C
 4836 CONTINUE
      ICASL7='MPAR'
      ICASS7='6DEC'
      GOTO8007
C
 4837 CONTINUE
      ICASL7='MPAR'
      ICASS7='7DEC'
      GOTO8007
C
 4838 CONTINUE
      ICASL7='MPAR'
      ICASS7='8DEC'
      GOTO8007
C
 4839 CONTINUE
      ICASL7='MPAR'
      ICASS7='9DEC'
      GOTO8007
C
 4841 CONTINUE
      ICASL7='MPAR'
      ICASS7='SN00'
      GOTO8007
C
 4842 CONTINUE
      ICASL7='MPAR'
      ICASS7='SN0'
      GOTO8007
C
 4843 CONTINUE
      ICASL7='MPAR'
      ICASS7='SN+'
      GOTO8007
C
 4844 CONTINUE
      ICASL7='MPAR'
      ICASS7='SN-'
      GOTO8007
C
 4846 CONTINUE
      ICASL7='MPAR'
      ICASS7='SN00'
      GOTO8006
C
 4847 CONTINUE
      ICASL7='MPAR'
      ICASS7='SN0'
      GOTO8006
C
 4848 CONTINUE
      ICASL7='MPAR'
      ICASS7='SN+'
      GOTO8006
C
 4849 CONTINUE
      ICASL7='MPAR'
      ICASS7='SN-'
      GOTO8006
C
 4851 CONTINUE
      ICASL7='MPAR'
      ICASS7='SIFR'
      GOTO8007
C
 4852 CONTINUE
      ICASL7='MPAR'
      ICASS7='SIAM'
      GOTO8007
C
 4854 CONTINUE
      ICASL7='MPAR'
      ICASS7='SNSC'
      GOTO8007
C
 4856 CONTINUE
      ICASL7='MPAR'
      ICASS7='QNSC'
      GOTO8007
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
 5034 CONTINUE
      ICASL7='MDEC'
      GOTO8006
C
 5042 CONTINUE
      ICASL7='MDMR'
      GOTO8006
C
 5044 CONTINUE
      ICASL7='MDMC'
      GOTO8006
C
 5052 CONTINUE
      ICASL7='MQRD'
      GOTO8005
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
 5110 CONTINUE
      ICASL7='BINN'
      GOTO8005
C
 5112 CONTINUE
      ICASL7='BINN'
      GOTO8006
C
 5114 CONTINUE
      ICASL7='BINR'
      GOTO8006
C
 5116 CONTINUE
      ICASL7='BINR'
      GOTO8007
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
 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
 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'
      GOTO8007
C
 5207 CONTINUE
      ICASL7='HCO2'
      GOTO8006
C
 5208 CONTINUE
      ICASL7='KCO2'
      GOTO8007
C
 5209 CONTINUE
      ICASL7='KCO2'
      GOTO8006
C
 5211 CONTINUE
      ICASL7='LMOM'
      GOTO8005
C
 5213 CONTINUE
      ICASL7='PWMO'
      GOTO8006
C
 5215 CONTINUE
      ICASL7='BPWM'
      GOTO8007
C
 6500 CONTINUE
      ICASL7='MGRA'
      ICASS7='MEAN'
      GOTO8006
C
 6502 CONTINUE
      ICASL7='MGRA2'
      ICASS7='MIDM'
      GOTO8006
C
 6512 CONTINUE
      ICASL7='MGRA'
      ICASS7='MEDI'
      GOTO8006
C
 6522 CONTINUE
      ICASL7='MGRA'
      ICASS7='TRIM'
      GOTO8007
C
 6524 CONTINUE
      ICASL7='MGRA'
      ICASS7='TRSE'
      GOTO8009
C
 6532 CONTINUE
      ICASL7='MGRA'
      ICASS7='WINM'
      GOTO8007
C
 6534 CONTINUE
      ICASL7='MGRA'
      ICASS7='HLEH'
      GOTO8007
C
 6536 CONTINUE
      ICASL7='MGRA'
      ICASS7='BILO'
      GOTO8007
C
 6538 CONTINUE
      ICASL7='MGRA'
      ICASS7='BISC'
      GOTO8007
C
 6542 CONTINUE
      ICASL7='MGRA'
      ICASS7='SUM'
      GOTO8006
C
 6545 CONTINUE
      ICASL7='MGRA'
      ICASS7='PROD'
      GOTO8006
C
 6552 CONTINUE
      ICASL7='MGRA'
      ICASS7='SD'
      GOTO8006
C
 6562 CONTINUE
      ICASL7='MGRA'
      ICASS7='SD'
      GOTO8007
C
 6563 CONTINUE
      ICASL7='MGRA'
      ICASS7='BIMV'
      GOTO8007
C
 6564 CONTINUE
      ICASL7='MGRA'
      ICASS7='PBMV'
      GOTO8008
C
 6565 CONTINUE
      ICASL7='MGRA'
      ICASS7='WIVA'
      GOTO8007
C
 6566 CONTINUE
      ICASL7='MGRA'
      ICASS7='WISD'
      GOTO8007
C
 6567 CONTINUE
      ICASL7='MGRA'
      ICASS7='WISD'
      GOTO8008
C
 6572 CONTINUE
      ICASL7='MGRA'
      ICASS7='SDME'
      GOTO8009
C
 6582 CONTINUE
      ICASL7='MGRA'
      ICASS7='SDME'
      GOTO8008
C
 6592 CONTINUE
      ICASL7='MGRA'
      ICASS7='VARI'
      GOTO8006
C
 6602 CONTINUE
      ICASL7='MGRA'
      ICASS7='VAME'
      GOTO8008
C
 6612 CONTINUE
      ICASL7='MGRA'
      ICASS7='REVA'
      GOTO8007
C
 6622 CONTINUE
      ICASL7='MGRA'
      ICASS7='RESD'
      GOTO8007
C
 6632 CONTINUE
      ICASL7='MGRA'
      ICASS7='RESD'
      GOTO8008
C
 6642 CONTINUE
      ICASL7='MGRA'
      ICASS7='CVAR'
      GOTO8008
C
 6652 CONTINUE
      ICASL7='MGRA'
      ICASS7='AAD'
      GOTO8008
C
 6662 CONTINUE
      ICASL7='MGRA'
      ICASS7='MAD'
      GOTO8008
C
 6672 CONTINUE
      ICASL7='MGRA'
      ICASS7='RANG'
      GOTO8006
C
 6682 CONTINUE
      ICASL7='MGRA'
      ICASS7='MRAN'
      GOTO8006
C
 6692 CONTINUE
      ICASL7='MGRA'
      ICASS7='MAXI'
      GOTO8006
C
 6702 CONTINUE
      ICASL7='MGRA'
      ICASS7='MINI'
      GOTO8006
C
 6712 CONTINUE
      ICASL7='MGRA'
      ICASS7='EXTR'
      GOTO8006
C
 6722 CONTINUE
      ICASL7='MGRA'
      ICASS7='LOWH'
      GOTO8007
C
 6732 CONTINUE
      ICASL7='MGRA'
      ICASS7='UPPH'
      GOTO8007
C
 6742 CONTINUE
      ICASL7='MGRA'
      ICASS7='LOWQ'
      GOTO8007
C
 6752 CONTINUE
      ICASL7='MGRA'
      ICASS7='UPPQ'
      GOTO8007
C
 6762 CONTINUE
      ICASL7='MGRA'
      ICASS7='SKEW'
      GOTO8006
C
 6772 CONTINUE
      ICASL7='MGRA'
      ICASS7='KURT'
      GOTO8006
C
 6782 CONTINUE
      ICASL7='MGRA'
      ICASS7='AUCR'
      GOTO8006
C
 6792 CONTINUE
      ICASL7='MGRA'
      ICASS7='AUCV'
      GOTO8006
C
 6802 CONTINUE
      ICASL7='MCSC'
      GOTO8006
C
 6803 CONTINUE
      ICASL7='MGRA'
      ICASS7='QUSE'
      GOTO8008
C
 6804 CONTINUE
      ICASL7='MGRA'
      ICASS7='QUAN'
      GOTO8006
C
 6811 CONTINUE
      ICASL7='MGRA'
      ICASS7='CP'
      GOTO8006
C
 6812 CONTINUE
      ICASL7='MGRA'
      ICASS7='CPK'
      GOTO8006
C
 6813 CONTINUE
      ICASL7='MGRA'
      ICASS7='CPM'
      GOTO8006
C
 6814 CONTINUE
      ICASL7='MGRA'
      ICASS7='CPL'
      GOTO8006
C
 6815 CONTINUE
      ICASL7='MGRA'
      ICASS7='CPU'
      GOTO8006
C
 6816 CONTINUE
      ICASL7='MGRA'
      ICASS7='CNPK'
      GOTO8006
C
 6817 CONTINUE
      ICASL7='MGRA'
      ICASS7='CC'
      GOTO8006
C
 6818 CONTINUE
      ICASL7='MGRA'
      ICASS7='PEDE'
      GOTO8007
C
 6819 CONTINUE
      ICASL7='MGRA'
      ICASS7='EXLO'
      GOTO8007
C
 6821 CONTINUE
      ICASL7='MGRA'
      ICASS7='PERC'
      GOTO8006
C
 6822 CONTINUE
      ICASL7='MGRA'
      ICASS7='HAME'
      GOTO8007
C
 6823 CONTINUE
      ICASL7='MGRA'
      ICASS7='GEME'
      GOTO8007
C
 6824 CONTINUE
      ICASL7='MGRA'
      ICASS7='GESD'
      GOTO8007
C
 6825 CONTINUE
      ICASL7='MGRA'
      ICASS7='GESD'
      GOTO8008
C
 6826 CONTINUE
      ICASL7='MGRA'
      ICASS7='NOPP'
      GOTO8007
C
 6831 CONTINUE
      ICASL7='MGRA'
      ICASS7='1DEC'
      GOTO8007
C
 6832 CONTINUE
      ICASL7='MGRA'
      ICASS7='2DEC'
      GOTO8007
C
 6833 CONTINUE
      ICASL7='MGRA'
      ICASS7='3DEC'
      GOTO8007
C
 6834 CONTINUE
      ICASL7='MGRA'
      ICASS7='4DEC'
      GOTO8007
C
 6835 CONTINUE
      ICASL7='MGRA'
      ICASS7='5DEC'
      GOTO8007
C
 6836 CONTINUE
      ICASL7='MGRA'
      ICASS7='6DEC'
      GOTO8007
C
 6837 CONTINUE
      ICASL7='MGRA'
      ICASS7='7DEC'
      GOTO8007
C
 6838 CONTINUE
      ICASL7='MGRA'
      ICASS7='8DEC'
      GOTO8007
C
 6839 CONTINUE
      ICASL7='MGRA'
      ICASS7='9DEC'
      GOTO8007
C
 6841 CONTINUE
      ICASL7='MGRA'
      ICASS7='SN00'
      GOTO8007
C
 6842 CONTINUE
      ICASL7='MGRA'
      ICASS7='SN0'
      GOTO8007
C
 6843 CONTINUE
      ICASL7='MGRA'
      ICASS7='SN+'
      GOTO8007
C
 6844 CONTINUE
      ICASL7='MGRA'
      ICASS7='SN-'
      GOTO8007
C
 6846 CONTINUE
      ICASL7='MGRA'
      ICASS7='SN00'
      GOTO8006
C
 6847 CONTINUE
      ICASL7='MGRA'
      ICASS7='SN0'
      GOTO8006
C
 6848 CONTINUE
      ICASL7='MGRA'
      ICASS7='SN+'
      GOTO8006
C
 6849 CONTINUE
      ICASL7='MGRA'
      ICASS7='SN-'
      GOTO8006
C
 6851 CONTINUE
      ICASL7='MGRA'
      ICASS7='SIFR'
      GOTO8007
C
 6852 CONTINUE
      ICASL7='MGRA'
      ICASS7='SIAM'
      GOTO8007
C
 6854 CONTINUE
      ICASL7='MGRA'
      ICASS7='SNSC'
      GOTO8007
C
 6856 CONTINUE
      ICASL7='MGRA'
      ICASS7='QNSC'
      GOTO8007
C
CCCCC THE FOLLOWING LONG SECTION IDENTIFIES THE SPECFIC STATISTIC
CCCCC FOR THE "SORT BY" COMMAND
13002 CONTINUE
      ICASL7='SRTB'
      ICASS7='MEAN'
      GOTO8007
C
13004 CONTINUE
      ICASL7='SRTB'
      ICASS7='MIDM'
      GOTO8007
C
13006 CONTINUE
      ICASL7='SRTB'
      ICASS7='MAD '
      GOTO8009
C
13008 CONTINUE
      ICASL7='SRTB'
      ICASS7='MAD '
      GOTO8007
C
13010 CONTINUE
      ICASL7='SRTB'
      ICASS7='SNSC'
      GOTO8008
C
13012 CONTINUE
      ICASL7='SRTB'
      ICASS7='QNSC'
      GOTO8008
C
13014 CONTINUE
      ICASL7='SRTB'
      ICASS7='MEDI'
      GOTO8007
C
13016 CONTINUE
      ICASL7='SRTB'
      ICASS7='TMSE'
      GOTO8010
C
13018 CONTINUE
      ICASL7='SRTB'
      ICASS7='TRIM'
      GOTO8008
C
13020 CONTINUE
      ICASL7='SRTB'
      ICASS7='WINM'
      GOTO8008
C
13022 CONTINUE
      ICASL7='SRTB'
      ICASS7='SUM'
      GOTO8007
C
13024 CONTINUE
      ICASL7='SRTB'
      ICASS7='PROD'
      GOTO8007
C
13026 CONTINUE
      ICASL7='SRTB'
      ICASS7='SDME'
      GOTO8010
C
13028 CONTINUE
      ICASL7='SRTB'
      ICASS7='SD'
      GOTO8007
C
13030 CONTINUE
      ICASL7='SRTB'
      ICASS7='SDME'
      GOTO8009
C
13032 CONTINUE
      ICASL7='SRTB'
      ICASS7='SD'
      GOTO8008
C
13034 CONTINUE
      ICASL7='SRTB'
      ICASS7='VAME'
      GOTO8009
C
13036 CONTINUE
      ICASL7='SRTB'
      ICASS7='VARI'
      GOTO8007
C
13038 CONTINUE
      ICASL7='SRTB'
      ICASS7='REVA'
      GOTO8008
C
13040 CONTINUE
      ICASL7='SRTB'
      ICASS7='RESD'
      GOTO8008
C
13042 CONTINUE
      ICASL7='CT26'
      ICASS7='RESD'
      GOTO8009
C
13044 CONTINUE
      ICASL7='SRTB'
      ICASS7='CVAR'
      GOTO8009
C
13046 CONTINUE
      ICASL7='SRTB'
      ICASS7='AAD'
      GOTO8009
C
13048 CONTINUE
      ICASL7='SRTB'
      ICASS7='RANG'
      GOTO8009
C
13050 CONTINUE
      ICASL7='SRTB'
      ICASS7='MIDR'
      GOTO8007
C
13052 CONTINUE
      ICASL7='SRTB'
      ICASS7='MAXI'
      GOTO8007
C
13054 CONTINUE
      ICASL7='SRTB'
      ICASS7='MINI'
      GOTO8007
C
13056 CONTINUE
      ICASL7='SRTB'
      ICASS7='EXTR'
      GOTO8007
C
13058 CONTINUE
      ICASL7='SRTB'
      ICASS7='LOWH'
      GOTO8008
C
13060 CONTINUE
      ICASL7='SRTB'
      ICASS7='UPPH'
      GOTO8008
C
13062 CONTINUE
      ICASL7='SRTB'
      ICASS7='LOWQ'
      GOTO8008
C
13064 CONTINUE
      ICASL7='SRTB'
      ICASS7='UPPQ'
      GOTO8008
C
13066 CONTINUE
      ICASL7='SRTB'
      ICASS7='SKEW'
      GOTO8007
C
13068 CONTINUE
      ICASL7='SRTB'
      ICASS7='KURT'
      GOTO8007
C
13070 CONTINUE
      ICASL7='SRTB'
      ICASS7='AUCR'
      GOTO8007
C
13072 CONTINUE
      ICASL7='SRTB'
      ICASS7='AUCV'
      GOTO8007
C
13074 CONTINUE
      ICASL7='SRTB'
      ICASS7='IQRA'
      GOTO8008
C
13078 CONTINUE
      ICASL7='SRTB'
      ICASS7='BILO'
      GOTO8008
C
13080 CONTINUE
      ICASL7='SRTB'
      ICASS7='BISC'
      GOTO8008
C
13082 CONTINUE
      ICASL7='SRTB'
      ICASS7='BIMV'
      GOTO8008
C
13084 CONTINUE
      ICASL7='SRTB'
      ICASS7='WISD'
      GOTO8008
C
13086 CONTINUE
      ICASL7='SRTB'
      ICASS7='WISD'
      GOTO8009
C
13088 CONTINUE
      ICASL7='SRTB'
      ICASS7='WIVA'
      GOTO8008
C
13090 CONTINUE
      ICASL7='SRTB'
      ICASS7='PBMV'
      GOTO8009
C
13092 CONTINUE
      ICASL7='SRTB'
      ICASS7='HLEH'
      GOTO8008
C
13094 CONTINUE
      ICASL7='SRTB'
      ICASS7='QUSE'
      GOTO8009
C
13096 CONTINUE
      ICASL7='SRTB'
      ICASS7='QUAN'
      GOTO8007
C
13098 CONTINUE
      ICASL7='SRTB'
      ICASS7='CP'
      GOTO8007
C
13100 CONTINUE
      ICASL7='SRTB'
      ICASS7='CPK'
      GOTO8007
C
13102 CONTINUE
      ICASL7='SRTB'
      ICASS7='CPM'
      GOTO8007
C
13104 CONTINUE
      ICASL7='SRTB'
      ICASS7='CPL'
      GOTO8007
C
13106 CONTINUE
      ICASL7='SRTB'
      ICASS7='CPU'
      GOTO8007
C
13108 CONTINUE
      ICASL7='SRTB'
      ICASS7='CNPK'
      GOTO8007
C
13110 CONTINUE
      ICASL7='SRTB'
      ICASS7='CC'
      GOTO8007
C
13112 CONTINUE
      ICASL7='SRTB'
      ICASS7='PEDE'
      GOTO8008
C
13114 CONTINUE
      ICASL7='SRTB'
      ICASS7='EXLO'
      GOTO8008
C
13116 CONTINUE
      ICASL7='SRTB'
      ICASS7='PERC'
      GOTO8007
C
13118 CONTINUE
      ICASL7='SRTB'
      ICASS7='HAME'
      GOTO8008
C
13120 CONTINUE
      ICASL7='SRTB'
      ICASS7='GEME'
      GOTO8008
C
13122 CONTINUE
      ICASL7='SRTB'
      ICASS7='GESD'
      GOTO8008
C
13124 CONTINUE
      ICASL7='SRTB'
      ICASS7='GESD'
      GOTO8009
C
13126 CONTINUE
      ICASL7='SRTB'
      ICASS7='NOPP'
      GOTO8008
C
13128 CONTINUE
      ICASL7='SRTB'
      ICASS7='1DEC'
      GOTO8008
C
13130 CONTINUE
      ICASL7='SRTB'
      ICASS7='2DEC'
      GOTO8008
C
13132 CONTINUE
      ICASL7='SRTB'
      ICASS7='3DEC'
      GOTO8008
C
13134 CONTINUE
      ICASL7='SRTB'
      ICASS7='4DEC'
      GOTO8008
C
13136 CONTINUE
      ICASL7='SRTB'
      ICASS7='5DEC'
      GOTO8008
C
13138 CONTINUE
      ICASL7='SRTB'
      ICASS7='6DEC'
      GOTO8008
C
13140 CONTINUE
      ICASL7='SRTB'
      ICASS7='7DEC'
      GOTO8008
C
13142 CONTINUE
      ICASL7='SRTB'
      ICASS7='8DEC'
      GOTO8008
C
13144 CONTINUE
      ICASL7='SRTB'
      ICASS7='9DEC'
      GOTO8008
C
13146 CONTINUE
      ICASL7='SRTB'
      ICASS7='SN00'
      GOTO8008
C
13148 CONTINUE
      ICASL7='SRTB'
      ICASS7='SN0'
      GOTO8008
C
13150 CONTINUE
      ICASL7='SRTB'
      ICASS7='SN+'
      GOTO8008
C
13152 CONTINUE
      ICASL7='SRTB'
      ICASS7='SN-'
      GOTO8008
C
13154 CONTINUE
      ICASL7='SRTB'
      ICASS7='SN00'
      GOTO8007
C
13156 CONTINUE
      ICASL7='SRTB'
      ICASS7='SN0'
      GOTO8007
C
13158 CONTINUE
      ICASL7='SRTB'
      ICASS7='SN+'
      GOTO8007
C
13160 CONTINUE
      ICASL7='SRTB'
      ICASS7='SN-'
      GOTO8007
C
13162 CONTINUE
      ICASL7='SRTB'
      ICASS7='SIFR'
      GOTO8008
C
13164 CONTINUE
      ICASL7='SRTB'
      ICASS7='SIAM'
      GOTO8008
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
 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
 8011 CONTINUE
      ILOCV=11
      GOTO8020
C
 8020 CONTINUE
      IF(ILOCV.GT.NUMARG)GOTO8039
CCCCC OCTOBER 1993.  JACKNIFE INDEX HAS PARAMETER ARGUMENTS
      IF(ICASL7.EQ.'JAIN')GOTO8040
      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.'OFF'.AND.ISUBRO.NE.'MATH')GOTO9090
      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 = ',A4,2X,A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
C               *****************************
C               **  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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--88.10
C     ORIGINAL VERSION--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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERRG4='NO'
      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 ')
 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,IBUGA3,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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MAY       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
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASRA
      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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
C               ******************************************
C               **  CHECK FOR RANDOM NUMBER GENERATION  **
C               ******************************************
C
      IFOUND='NO'
      IERROR='NO'
      ICASRA='UNKN'
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF CKRAND--')
      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 ')
      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
      IF(NUMARG.LE.4)GOTO9000
      JMAX=NUMARG-1
      DO100J=1,JMAX
      JP1=J+1
CCCCC IF(IHARG(J).EQ.'RAND'.AND.IHARG2(J).EQ.'OM  '.AND.
CCCCC1   IHARG(JP1).EQ.'NUMB'.AND.IHARG2(JP1).EQ.'ERS ')
CCCCC1   GOTO190
      IF(J.GE.4.AND.IHARG(J).EQ.'RAND'.AND.IHARG(JP1).EQ.'NUMB')GOTO190
      IF(J.GE.4.AND.IHARG(J).EQ.'RAND'.AND.IHARG(JP1).EQ.'SAMP')GOTO190
      IF(IHARG(J).EQ.'BOOT'.AND.IHARG(JP1).EQ.'INDE')GOTO190
      IF(IHARG(J).EQ.'RAND'.AND.IHARG(JP1).EQ.'INDE')GOTO190
CCCCC OCTOBER 1993.  JACKNIFE INDEX TO CKMATH
CCCCC IF(IHARG(J).EQ.'JACK'.AND.IHARG(JP1).EQ.'INDE')GOTO190
      IF(IHARG(J).EQ.'RAND'.AND.IHARG(JP1).EQ.'PERM')GOTO190
  100 CONTINUE
      GOTO9000
  190 CONTINUE
C
      IF(IHARG(3).EQ.'UNIF')GOTO1101
      IF(IHARG(3).EQ.'RECT')GOTO1101
CCCCC ADD FOLLOWING 2 LINES     MAY 1998.
      IF(IHARG(3).EQ.'NORM'.AND.IHARG(4).EQ.'MIXT')GOTO2201
      IF(IHARG(3).EQ.'GAUS'.AND.IHARG(4).EQ.'MIXT')GOTO2201
      IF(IHARG(3).EQ.'NORM')GOTO1102
      IF(IHARG(3).EQ.'GAUS')GOTO1102
      IF(IHARG(3).EQ.'LOGI')GOTO1103
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'DOUB'.AND.
     1   IHARG(4).EQ.'EXPO')GOTO1104
      IF(IHARG(3).EQ.'LAPL')GOTO1151
      IF(IHARG(3).EQ.'CAUC')GOTO1105
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'TUKE'.AND.
     1   IHARG(4).EQ.'LAMB')GOTO1152
      IF(IHARG(3).EQ.'TUKE')GOTO1106
      IF(IHARG(3).EQ.'LAMB')GOTO1106
      IF(IHARG(3).EQ.'LOGN')GOTO1107
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'LOG '.AND.
     1   IHARG(4).EQ.'NORM')GOTO1153
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'HALF'.AND.
     1   IHARG(4).EQ.'NORM')GOTO1154
CCCCC OCTOBER 1995.  NAME CONFLICT WITH HALF-CAUCHY
CCCCC OCTOBER 2001.  NAME CONFLICT WITH HALF-LOGISTIC
CCCCC IF(IHARG(3).EQ.'HALF')GOTO1108
      IF(IHARG(3).EQ.'HALF'.AND.IHARG(4).NE.'CAUC'.AND.
     1   IHARG(4).NE.'LOGI')GOTO1108
      IF(IHARG(3).EQ.'T   ')GOTO1109
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'STUD'.AND.
     1   IHARG(4).EQ.'T   ')GOTO1155
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'GOSS'.AND.
     1   IHARG(4).EQ.'T   ')GOTO1155
      IF(IHARG(3).EQ.'CHIS')GOTO1110
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'CHI '.AND.
     1   IHARG(4).EQ.'SQUA')GOTO1156
      IF(IHARG(3).EQ.'F   ')GOTO1111
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'SNED'.AND.
     1   IHARG(4).EQ.'F   ')GOTO1157
CCCCC CHECK FOR NAME CONFLICT WITH EXPONENTIATED WEIBULL.  OCTOBER 2001
      IF(IHARG(3).EQ.'EXPO'.AND.IHARG(4).NE.'WEIB')GOTO1112
      IF(IHARG(3).EQ.'GAMM')GOTO1113
      IF(IHARG(3).EQ.'BETA' .AND.
     1  (IHARG(4).NE.'BINO' .AND. IHARG(4).NE.'NORM'))GOTO1114
      IF(IHARG(3).EQ.'WEIB')GOTO1115
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'EXTR'.AND.
     1   IHARG(4).EQ.'VALU'.AND.
     1   IHARG(5).EQ.'TYPE'.AND.
     1   IHARG(6).EQ.'1   ')GOTO1116
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'EXTR'.AND.
     1   IHARG(4).EQ.'VALU'.AND.
     1   IHARG(5).EQ.'TYPE'.AND.
     1   IHARG(6).EQ.'I   ')GOTO1116
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'EXTR'.AND.
     1   IHARG(4).EQ.'VALU'.AND.
     1   IHARG(5).EQ.'1   ')GOTO1158
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'EXTR'.AND.
     1   IHARG(4).EQ.'VALU'.AND.
     1   IHARG(5).EQ.'I   ')GOTO1158
CCCCC THE FOLLOWING LINE WAS ADDED    MAY 1993
      IF(IHARG(3).EQ.'GUMB')GOTO1162
CCCCC THE FOLLOWING LINE WAS ADDED    DECEMBER 1993
      IF(IHARG(3).EQ.'EV1 ')GOTO1162
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'EXTR'.AND.
     1   IHARG(4).EQ.'VALU'.AND.
     1   IHARG(5).EQ.'TYPE'.AND.
     1   IHARG(6).EQ.'2   ')GOTO1117
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'EXTR'.AND.
     1   IHARG(4).EQ.'VALU'.AND.
     1   IHARG(5).EQ.'TYPE'.AND.
     1   IHARG(6).EQ.'II  ')GOTO1117
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'EXTR'.AND.
     1   IHARG(4).EQ.'VALU'.AND.
     1   IHARG(5).EQ.'2   ')GOTO1160
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'EXTR'.AND.
     1   IHARG(4).EQ.'VALU'.AND.
     1   IHARG(5).EQ.'II  ')GOTO1160
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'EXTR'.AND.
     1   IHARG(4).EQ.'VALU')GOTO1159
CCCCC THE FOLLOWING LINE WAS ADDED    MAY 1993
      IF(IHARG(3).EQ.'FREC')GOTO1163
CCCCC THE FOLLOWING LINE WAS ADDED    DECEMBER 1993
      IF(IHARG(3).EQ.'EV2 ')GOTO1163
      IF(IHARG(3).EQ.'PARE'.AND.IHARG(4).NE.'SECO'.AND.
     1   IHARG(4).NE.'2ND'.AND.IHARG(4).NE.'TYPE')GOTO1118
      IF(IHARG(3).EQ.'BINO')GOTO1119
      IF(IHARG(3).EQ.'GEOM'.AND.IHARG(4).NE.'EXTR')GOTO1120
      IF(IHARG(3).EQ.'POIS')GOTO1121
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'NEGA'.AND.
     1   IHARG(4).EQ.'BINO')GOTO1122
      IF(IHARG(3).EQ.'SEMI')GOTO1123
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'SEMI'.AND.
     1   IHARG(4).EQ.'CIRC')GOTO1161
      IF(IHARG(3).EQ.'TRIA')GOTO1124
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'DISC'.AND.
     1   IHARG(4).EQ.'UNIF')GOTO1125
      IF(NUMARG.GE.4.AND.
     1   IHARG(3).EQ.'BOOT'.AND.
     1   IHARG(4).EQ.'INDE')GOTO1126
      IF(NUMARG.GE.4.AND.
     1   IHARG(3).EQ.'RAND'.AND.
     1   IHARG(4).EQ.'INDE')GOTO1126
CCCCC IF(NUMARG.GE.4.AND.
CCCCC1   IHARG(3).EQ.'JACK'.AND.
CCCCC1   IHARG(4).EQ.'INDE')GOTO1127
      IF(NUMARG.GE.4.AND.
     1   IHARG(3).EQ.'RAND'.AND.
     1   IHARG(4).EQ.'PERM')GOTO1131
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
      IF(NUMARG.GE.4.AND.
     1   IHARG(3).EQ.'INVE'.AND.
     1   IHARG(4).EQ.'GAUS')GOTO1132
      IF(IHARG(3).EQ.'IG')GOTO1133
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
      IF(IHARG(3).EQ.'WALD')GOTO1134
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'RECI'.AND.
     1   IHARG(4).EQ.'INVE'.AND.
     1   IHARG(5).EQ.'GAUS')GOTO1135
      IF(IHARG(3).EQ.'RIG')GOTO1136
      IF(IHARG(3).EQ.'TWEE')GOTO1136
      IF(NUMARG.GE.4.AND.
     1   IHARG(3).EQ.'BIRN'.AND.
     1   IHARG(4).EQ.'SAUN')GOTO1137
      IF(NUMARG.GE.4.AND.
     1   IHARG(3).EQ.'SAUN'.AND.
     1   IHARG(4).EQ.'BIRN')GOTO1137
C
      IF(NUMARG.GE.4.AND.
     1   IHARG(3).EQ.'FATI'.AND.
     1   IHARG(4).EQ.'LIFE')GOTO1138
      IF(IHARG(3).EQ.'FL')GOTO1139
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED     DECEMBER 1993
      IF(IHARG(3).EQ.'GEP ')GOTO1164
      IF(IHARG(3).EQ.'GP  ')GOTO1164
C
CCCCC THE FOLLOWING 3 LINES WAS ADDED     DECEMBER 1993
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'GENE'.AND.
     1   IHARG(4).EQ.'PARE')GOTO1165
C
CCCCC THE FOLLOWING 3 LINES WAS ADDED     APRIL 1995
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'POWE'.AND.
     1   IHARG(4).EQ.'FUNC')GOTO1166
C
CCCCC THE FOLLOWING 3 LINES WAS ADDED     JUNE 1998
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'POWE'.AND.
     1   IHARG(4).EQ.'LAW ')GOTO11166
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'HYPE'.AND.
     1   IHARG(4).EQ.'SECA')GOTO2228
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     SEPTEMBER 2004
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'HYPE'.AND.IHARG2(3).EQ.'BOLI')GOTO2352
C
CCCCC THE FOLLOWING 3 LINES WAS ADDED     AUGUST 1995
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'HYPE'.AND.
     1   IHARG(4).EQ.'GEOM')GOTO1167
CCCCC OCTOBER 2001: CHECK FOR NAME CONFLICT WITH HYPERBOLIC SECANT
      IF(NUMARG.GE.5.AND.
CCCCC1   IHARG(3).EQ.'HYPE')GOTO1168
     1   IHARG(3).EQ.'HYPE'.AND.IHARG(4).NE.'SECA')GOTO1168
CCCCC THE FOLLOWING SECTION WAS ADDED     AUGUST 1995
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'NONC'.AND.
     1   IHARG(4).EQ.'CHIS')GOTO1169
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'NONC'.AND.
     1   IHARG(4).EQ.'CHI '.AND.
     1   IHARG(5).EQ.'SQUA')GOTO2169
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'NON '.AND.
     1   IHARG(4).EQ.'CENT'.AND.
     1   IHARG(5).EQ.'CHIS')GOTO2169
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'NON '.AND.
     1   IHARG(4).EQ.'CENT'.AND.
     1   IHARG(5).EQ.'CHI '.AND.
     1   IHARG(6).EQ.'SQUA')GOTO3169
C
CCCCC THE FOLLOWING SECTION WAS ADDED     AUGUST 1995
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'NONC'.AND.
     1   IHARG(4).EQ.'F   ')GOTO1170
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'NON '.AND.
     1   IHARG(4).EQ.'CENT'.AND.
     1   IHARG(5).EQ.'F   ')GOTO2170
C
CCCCC THE FOLLOWING SECTION WAS ADDED     AUGUST 1995
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'DOUB'.AND.
     1   IHARG(4).EQ.'NONC'.AND.
     1   IHARG(5).EQ.'F   ')GOTO1171
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'DOUB'.AND.
     1   IHARG(4).EQ.'NON '.AND.
     1   IHARG(4).EQ.'CENT'.AND.
     1   IHARG(5).EQ.'F   ')GOTO2171
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 1995
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'FOLD'.AND.
     1   IHARG(4).EQ.'NORM')GOTO2181
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 1995
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'HALF'.AND.
     1   IHARG(4).EQ.'CAUC')GOTO2191
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     AUGUST 2001
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'GENE'.AND.
     1   IHARG(4).EQ.'LAMB')GOTO2211
C
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'TUKE'.AND.
     1   IHARG(5).EQ.'LAMB')GOTO2212
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     SEPTEMBER 2001
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'INVE'.AND.
     1   IHARG(4).EQ.'WEIB')GOTO2221
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'DOUB'.AND.
     1   IHARG(4).EQ.'WEIB')GOTO2222
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'DOUB'.AND.
     1   IHARG(4).EQ.'GAMM')GOTO2223
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'LOG '.AND.
     1   IHARG(4).EQ.'GAMM')GOTO2224
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'INVE'.AND.
     1   IHARG(4).EQ.'GAMM')GOTO2225
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'COSI')GOTO2226
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'ANGL')GOTO2227
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'ARCS')GOTO2229
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'LOG '.AND.
     1   IHARG(4).EQ.'DOUB'.AND.IHARG(5).EQ.'EXPO')GOTO2230
C
CCCCC THE FOLLOWING 3 SECTIONS WERE ADDED     MARCH 2006
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'LOG '.AND.
     1   IHARG(4).EQ.'LAPL')GOTO2366
C
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'ASYM'.AND.IHARG(4).EQ.'LOG '.AND.
     1   IHARG(5).EQ.'DOUB'.AND.IHARG(6).EQ.'EXPO')GOTO2368
C
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'ASYM'.AND.
     1   IHARG(4).EQ.'LOG '.AND.IHARG(5).EQ.'LAPL')GOTO2370
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'GENE'.AND.
     1   IHARG(4).EQ.'EXTR'.AND.IHARG(5).EQ.'VALU')GOTO2231
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'EXPO'.AND.
     1   IHARG(4).EQ.'WEIB')GOTO2232
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'GOMP' .AND. IHARG(4).NE.'MAKE')GOTO2233
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'HALF'.AND.
     1   IHARG(4).EQ.'LOGI')GOTO2234
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'POWE'.AND.
     1   IHARG(4).EQ.'EXPO')GOTO2235
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'ALPH')GOTO2236
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'BRAD')GOTO2237
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'RECI')GOTO2238
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'JOHN'.AND.
     1   IHARG(4).EQ.'SB  ')GOTO2239
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'JOHN'.AND.
     1   IHARG(4).EQ.'SU  ')GOTO2240
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'POWE'.AND.
     1   IHARG(4).EQ.'NORM')GOTO2241
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     OCTOBER 2001
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'LOG '.AND.
     1   IHARG(4).EQ.'LOGI')GOTO2242
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     NOVEMBER 2001
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'GEOM'.AND.
     1   IHARG(4).EQ.'EXTR'.AND.IHARG(5).EQ.'EXPO')GOTO2244
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     NOVEMBER 2001
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'POWE'.AND.
     1   IHARG(4).EQ.'LOGN')GOTO2246
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     DECEMBER 2001
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'BETA'.AND.
     1   IHARG(4).EQ.'BINO')GOTO2248
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     MARCH 2006
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'BETA'.AND.
     1   IHARG(4).EQ.'NORM')GOTO2249
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     MAY 2002
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'TWO '.AND.
     1   IHARG(4).EQ.'SIDE'.AND.IHARG(5).EQ.'POWE')GOTO2250
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     MAY 2002
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'BIWE')GOTO2252
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'BI  '.AND.IHARG(4).EQ.'WEIB')GOTO2254
C
CCCCC THE FOLLOWING LINES WERE ADDED     AUGUST 2002
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'LOGA'.AND.IHARG(4).EQ.'SERI')GOTO2256
C
CCCCC THE FOLLOWING LINES WERE ADDED     JANUARY 2003
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'GH  ')GOTO2258
C
CCCCC THE FOLLOWING LINES WERE ADDED     JANUARY 2003
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'G   '.AND.IHARG(4).EQ.'AND '.AND.
     1   IHARG(5).EQ.'H')GOTO2260
C
CCCCC THE FOLLOWING LINES WERE ADDED     JANUARY 2003
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'SLAS')GOTO2262
C
CCCCC THE FOLLOWING LINES WERE ADDED     APRIL   2003
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'LAND')GOTO2264
C
CCCCC THE FOLLOWING LINES WERE ADDED     MAY     2003
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'INVE'.AND.IHARG(4).EQ.'BETA')GOTO2266
C
CCCCC THE FOLLOWING LINES WERE ADDED     MAY     2003
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'ERRO')GOTO2267
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'SUBB')GOTO2267
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'EXPO'.AND.IHARG(4).EQ.'POWE')GOTO2268
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'ERRO')GOTO2268
C
CCCCC THE FOLLOWING LINES WERE ADDED     JUNE     2003
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'TRAP')GOTO2270
C
CCCCC THE FOLLOWING LINES WERE ADDED     JUNE     2003
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'VON'.AND.IHARG(4).EQ.'MISE')GOTO2272
C
CCCCC THE FOLLOWING LINES WERE ADDED     JUNE     2003
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'WRAP'.AND.IHARG(4).EQ.'CAUC')GOTO2274
C
CCCCC THE FOLLOWING LINES WERE ADDED     JUNE     2003
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'PARE'.AND.
     1   (IHARG(4).EQ.'SECO'.OR.IHARG(4).EQ.'2ND').AND.
     1   IHARG(5).EQ.'KIND')GOTO2276
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'PARE'.AND.
     1   IHARG(4).EQ.'TYPE'.AND.IHARG(5).EQ.'2   ')GOTO2276
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'PARE'.AND.
     1   IHARG(4).EQ.'TYPE'.AND.IHARG(5).EQ.'TWO ')GOTO2276
C
CCCCC THE FOLLOWING LINES WERE ADDED     JUNE     2003
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'TRAP')GOTO2278
C
CCCCC THE FOLLOWING LINES WERE ADDED     JULY     2003
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'TRUN'.AND.IHARG(4).EQ.'NORM')GOTO2280
C
CCCCC THE FOLLOWING LINES WERE ADDED     JULY     2003
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'CHI ')GOTO2282
C
CCCCC THE FOLLOWING LINES WERE ADDED     JULY     2003
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'FOLD'.AND.IHARG(4).EQ.'CAUC')GOTO2284
C
CCCCC THE FOLLOWING LINES WERE ADDED     JULY     2003
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'BETA'.AND.IHARG(4).EQ.'KAPP')GOTO2286
C
CCCCC THE FOLLOWING LINES WERE ADDED     JULY     2003
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'MIEL'.AND.IHARG(4).EQ.'BETA'.AND.
     1   IHARG(5).EQ.'KAPP')GOTO2288
C
CCCCC THE FOLLOWING LINES WERE ADDED     JULY     2003
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'TRUN'.AND.IHARG(4).EQ.'EXPO')GOTO2290
C
CCCCC THE FOLLOWING LINES WERE ADDED     JULY     2003
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'EXPO')GOTO2292
C
CCCCC THE FOLLOWING LINES WERE ADDED     SEPTEMBER  2003
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'GAMM')GOTO2294
C
CCCCC THE FOLLOWING LINES WERE ADDED     NOVEMBER   2003
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'FOLD'.AND.IHARG(4).EQ.'T   ')GOTO2296
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'SKEW'.AND.IHARG(4).EQ.'T   ')GOTO2298
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'SKEW'.AND.IHARG(4).EQ.'NORM')GOTO2300
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'ZIPF')GOTO2302
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'GOMP'.AND.IHARG(4).EQ.'MAKE')GOTO2304
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'INVE'.AND.
     1   IHARG(5).EQ.'GAUS')GOTO2306
C
CCCCC THE FOLLOWING LINES WERE ADDED     MARCH   2004
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'LOG'.AND.
     1   IHARG(4).EQ.'SKEW'.AND.IHARG(5).EQ.'T   ')GOTO2308
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'LOG'.AND.
     1   IHARG(4).EQ.'SKEW'.AND.IHARG(5).EQ.'NORM')GOTO2310
C
CCCCC THE FOLLOWING LINES WERE ADDED     MARCH   2004
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'NONC'.AND.IHARG(4).EQ.'T   ')GOTO2312
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'NON '.AND.IHARG(4).EQ.'CENT'.AND.
     1   IHARG(4).EQ.'T   ')GOTO2312
C
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'DOUB'.AND.
     1   IHARG(4).EQ.'NONC'.AND.IHARG(5).EQ.'T   ')GOTO2314
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'DOUB'.AND.IHARG(4).EQ.'NON '.AND.
     1   IHARG(5).EQ.'CENT'.AND.IHARG(6).EQ.'T   ')GOTO2315
C
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'GENE'.AND.
     1   IHARG(4).EQ.'HALF'.AND.IHARG(5).EQ.'LOGI')GOTO2318
C
CCCCC THE FOLLOWING LINES WERE ADDED     MARCH    2004
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'POLY')GOTO2320
C
CCCCC THE FOLLOWING LINES WERE ADDED     APRIL    2004
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'HERM')GOTO2322
C
CCCCC THE FOLLOWING LINES WERE ADDED     APRIL    2004
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'YULE')GOTO2324
C
CCCCC THE FOLLOWING LINES WERE ADDED     APRIL    2004
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'WARI')GOTO2326
C
CCCCC THE FOLLOWING LINES WERE ADDED     APRIL    2004
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'WARI')GOTO2328
C
CCCCC THE FOLLOWING LINES WERE ADDED     APRIL   2004
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'NONC'.AND.IHARG(4).EQ.'BETA')GOTO2330
C
CCCCC THE FOLLOWING LINES WERE ADDED     MAY     2004
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'DOUB'.AND.IHARG(4).EQ.'NONC'.AND.
     1   IHARG(5).EQ.'BETA')GOTO2332
C
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'DOUB'.AND.IHARG(4).EQ.'NON '.AND.
     1   IHARG(5).EQ.'CENT'.AND.IHARG(6).EQ.'BETA')GOTO2333
C
CCCCC THE FOLLOWING LINES WERE ADDED     JUNE    2004
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'SKEW'.AND.IHARG(4).EQ.'LAPL')GOTO2334
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'SKEW'.AND.IHARG(4).EQ.'DOUB'.AND.
     1   IHARG(5).EQ.'EXPO')GOTO2335
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'ASYM'.AND.IHARG(4).EQ.'LAPL')GOTO2336
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'ASYM'.AND.IHARG(4).EQ.'DOUB'.AND.
     1   IHARG(5).EQ.'EXPO')GOTO2337
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'ASYM'.AND.
     1   IHARG(5).EQ.'LAPL')GOTO2338
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'ASYM'.AND.
     1   IHARG(5).EQ.'DOUB'.AND.IHARG(6).EQ.'EXPO')GOTO2339
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'MAXW')GOTO2340
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'RAYL')GOTO2341
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'MCLE')GOTO2343
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'BESS'.AND.IHARG(4).EQ.'I   '.AND.
     1   IHARG(5).EQ.'FUNC')GOTO2345
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'BESS'.AND.IHARG(4).EQ.'I   ')GOTO2346
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'BESS'.AND.IHARG(4).EQ.'K   '.AND.
     1   IHARG(5).EQ.'FUNC')GOTO2347
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'BESS'.AND.IHARG(4).EQ.'K   ')GOTO2348
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'MCLE')GOTO2350
C
CCCCC THE FOLLOWING LINES WERE ADDED     FEBRUARY   2006
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGI'.AND.
     1   IHARG(5).EQ.'TYPE'.AND.IHARG(6).EQ.'5   ')GOTO2354
C
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGI'.AND.
     1   IHARG(5).EQ.'TYPE'.AND.IHARG(6).EQ.'V   ')GOTO2354
C
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'TYPE'.AND.IHARG(4).EQ.'5   '.AND.
     1   IHARG(5).EQ.'GENE'.AND.IHARG(6).EQ.'LOGI')GOTO2354
C
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'TYPE'.AND.IHARG(4).EQ.'V   '.AND.
     1   IHARG(5).EQ.'GENE'.AND.IHARG(6).EQ.'LOGI')GOTO2354
C
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'HOSK'.AND.IHARG(4).EQ.'GENE'.AND.
     1   IHARG(5).EQ.'LOGI')GOTO2356
C
      IF(NUMARG.GE.7.AND.
     1   IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGI'.AND.
     1   IHARG(5).EQ.'HOSK')GOTO2356
C
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGI'.AND.
     1   IHARG(5).EQ.'TYPE'.AND.IHARG(6).EQ.'2   ')GOTO2360
C
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGI'.AND.
     1   IHARG(5).EQ.'TYPE'.AND.IHARG(6).EQ.'II  ')GOTO2360
C
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'TYPE'.AND.IHARG(4).EQ.'2   '.AND.
     1   IHARG(5).EQ.'GENE'.AND.IHARG(6).EQ.'LOGI')GOTO2360
C
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'TYPE'.AND.IHARG(4).EQ.'II  '.AND.
     1   IHARG(5).EQ.'GENE'.AND.IHARG(6).EQ.'LOGI')GOTO2360
C
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGI'.AND.
     1   IHARG(5).EQ.'TYPE'.AND.IHARG(6).EQ.'3   ')GOTO2362
C
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGI'.AND.
     1   IHARG(5).EQ.'TYPE'.AND.IHARG(6).EQ.'III ')GOTO2362
C
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'TYPE'.AND.IHARG(4).EQ.'3   '.AND.
     1   IHARG(5).EQ.'GENE'.AND.IHARG(6).EQ.'LOGI')GOTO2362
C
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'TYPE'.AND.IHARG(4).EQ.'III '.AND.
     1   IHARG(5).EQ.'GENE'.AND.IHARG(6).EQ.'LOGI')GOTO2362
C
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGI'.AND.
     1   IHARG(5).EQ.'TYPE'.AND.IHARG(6).EQ.'4   ')GOTO2364
C
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGI'.AND.
     1   IHARG(5).EQ.'TYPE'.AND.IHARG(6).EQ.'IV  ')GOTO2364
C
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'TYPE'.AND.IHARG(4).EQ.'4   '.AND.
     1   IHARG(5).EQ.'GENE'.AND.IHARG(6).EQ.'LOGI')GOTO2364
C
      IF(NUMARG.GE.8.AND.
     1   IHARG(3).EQ.'TYPE'.AND.IHARG(4).EQ.'IV  '.AND.
     1   IHARG(5).EQ.'GENE'.AND.IHARG(6).EQ.'LOGI')GOTO2364
C
CCCCC THE FOLLOWING LINES WERE ADDED     MARCH   2004
      IF(NUMARG.GE.6.AND.
     1   IHARG(3).EQ.'GENE'.AND.IHARG(4).EQ.'LOGI')GOTO2316
C
CCCCC THE FOLLOWING LINES WERE ADDED     FEBRUARY 2006
      IF(NUMARG.GE.5.AND.
     1   IHARG(3).EQ.'WAKE')GOTO2358
C
C  END OF SEARCH
C
      IFOUND='NO'
      GOTO9000
C
 1101 CONTINUE
      ICASRA='UNIF'
      GOTO1175
 1102 CONTINUE
      ICASRA='NORM'
      GOTO1175
 1103 CONTINUE
      ICASRA='LOGI'
      GOTO1175
 1104 CONTINUE
      ICASRA='DOUB'
      GOTO1176
 1105 CONTINUE
      ICASRA='CAUC'
      GOTO1175
 1106 CONTINUE
      ICASRA='LAMB'
      GOTO1175
 1107 CONTINUE
      ICASRA='LOGN'
      GOTO1175
 1108 CONTINUE
      ICASRA='HALF'
      GOTO1175
 1109 CONTINUE
      ICASRA='T'
      GOTO1175
 1110 CONTINUE
      ICASRA='CHIS'
      GOTO1175
 1111 CONTINUE
      ICASRA='F'
      GOTO1175
 1112 CONTINUE
      ICASRA='EXPO'
      GOTO1175
 1113 CONTINUE
      ICASRA='GAMM'
      GOTO1175
 1114 CONTINUE
      ICASRA='BETA'
      GOTO1175
 1115 CONTINUE
      ICASRA='WEIB'
      GOTO1175
 1116 CONTINUE
      ICASRA='EXV1'
      GOTO1178
 1117 CONTINUE
      ICASRA='EXV2'
      GOTO1178
 1118 CONTINUE
      ICASRA='PARE'
      GOTO1175
 1119 CONTINUE
      ICASRA='BINO'
      GOTO1175
 1120 CONTINUE
      ICASRA='GEOM'
      GOTO1175
 1121 CONTINUE
      ICASRA='POIS'
      GOTO1175
 1122 CONTINUE
      ICASRA='NEGB'
      GOTO1176
 1123 CONTINUE
      ICASRA='SEMI'
      GOTO1175
 1124 CONTINUE
      ICASRA='TRIA'
      GOTO1175
C
 1125 CONTINUE
      ICASRA='DIUN'
      GOTO1176
C
 1126 CONTINUE
      ICASRA='BOOT'
      GOTO1174
C
C1127 CONTINUE
CCCCC ICASRA='JACK'
CCCCC GOTO1174
C
 1131 CONTINUE
      ICASRA='PERM'
      GOTO1174
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
 1132 CONTINUE
      ICASRA='IG'
      GOTO1175
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
 1133 CONTINUE
      ICASRA='IG'
      GOTO1174
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
 1134 CONTINUE
      ICASRA='WALD'
      GOTO1174
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
 1135 CONTINUE
      ICASRA='RIG'
      GOTO1176
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
 1136 CONTINUE
      ICASRA='RIG'
      GOTO1174
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
 1137 CONTINUE
      ICASRA='RIG'
      GOTO1175
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
 1138 CONTINUE
      ICASRA='FL'
      GOTO1175
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
 1139 CONTINUE
      ICASRA='FL'
      GOTO1174
C
 1151 CONTINUE
      ICASRA='DOUB'
      GOTO1175
 1152 CONTINUE
      ICASRA='LAMB'
      GOTO1176
 1153 CONTINUE
      ICASRA='LOGN'
      GOTO1176
 1154 CONTINUE
      ICASRA='HALF'
      GOTO1176
 1155 CONTINUE
      ICASRA='T'
      GOTO1176
 1156 CONTINUE
      ICASRA='CHIS'
      GOTO1176
 1157 CONTINUE
      ICASRA='F'
      GOTO1176
 1158 CONTINUE
      ICASRA='EXV1'
      GOTO1177
 1159 CONTINUE
      ICASRA='EXV1'
      GOTO1176
 1160 CONTINUE
      ICASRA='EXV2'
      GOTO1177
 1161 CONTINUE
      ICASRA='SEMI'
      GOTO1176
C
CCCCC THE FOLLOWING 8 LINES WERE ADDED    MAY 1993
 1162 CONTINUE
      ICASRA='EXV1'
      GOTO1175
 1163 CONTINUE
      ICASRA='EXV2'
      GOTO1175
C
CCCCC THE FOLLOWING 8 LINES WERE ADDED    MAY 1993
 1164 CONTINUE
      ICASRA='GEP'
      GOTO1175
 1165 CONTINUE
      ICASRA='GEP'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED APRIL 1995
 1166 CONTINUE
      ICASRA='POWF'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED JUNE 1998
11166 CONTINUE
      ICASRA='POWL'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED AUGUST 1995
 1167 CONTINUE
      ICASRA='HYPE'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED AUGUST 1995
 1168 CONTINUE
      ICASRA='HYPE'
      GOTO1175
C
CCCCC FOLLOWING SECTION ADDED AUGUST 1995
 1169 CONTINUE
      ICASRA='NCCS'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED AUGUST 1995
 2169 CONTINUE
      ICASRA='NCCS'
      GOTO1177
C
CCCCC FOLLOWING SECTION ADDED AUGUST 1995
 3169 CONTINUE
      ICASRA='NCCS'
      GOTO1178
C
CCCCC FOLLOWING SECTION ADDED AUGUST 1995
 1170 CONTINUE
      ICASRA='NCF '
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED AUGUST 1995
 2170 CONTINUE
      ICASRA='NCF '
      GOTO1177
C
CCCCC FOLLOWING SECTION ADDED AUGUST 1995
 1171 CONTINUE
      ICASRA='DNCF'
      GOTO1177
C
CCCCC FOLLOWING SECTION ADDED AUGUST 1995
 2171 CONTINUE
      ICASRA='DNCF'
      GOTO1178
C
CCCCC FOLLOWING SECTION ADDED OCTOBER 1995
 2181 CONTINUE
      ICASRA='FNRM'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED OCTOBER 1995
 2191 CONTINUE
      ICASRA='HFCA'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED MAY 1998
 2201 CONTINUE
      ICASRA='NMRM'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED AUGUST 2001
 2211 CONTINUE
      ICASRA='GLAM'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED FEBRUARY 2006
 2212 CONTINUE
      ICASRA='GLAM'
      GOTO1177
C
CCCCC FOLLOWING SECTION ADDED SEPTEMBER 2001
 2221 CONTINUE
      ICASRA='IWEI'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED OCTOBER 2001
 2222 CONTINUE
      ICASRA='DWEI'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001
 2223 CONTINUE
      ICASRA='DGAM'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001
 2224 CONTINUE
      ICASRA='LGAM'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001
 2225 CONTINUE
      ICASRA='IGAM'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001
 2226 CONTINUE
      ICASRA='COSI'
      GOTO1175
C
CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001
 2227 CONTINUE
      ICASRA='ANGL'
      GOTO1175
C
CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001
 2228 CONTINUE
      ICASRA='HSEC'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001
 2229 CONTINUE
      ICASRA='ARCS'
      GOTO1175
C
CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001
 2230 CONTINUE
      ICASRA='LDEX'
      GOTO1177
C
CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001
 2231 CONTINUE
      ICASRA='GEVA'
      GOTO1177
C
CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001
 2232 CONTINUE
      ICASRA='EWEI'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001
 2233 CONTINUE
      ICASRA='GOMP'
      GOTO1175
C
CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001
 2234 CONTINUE
      ICASRA='HALO'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001
 2235 CONTINUE
      ICASRA='POEX'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001
 2236 CONTINUE
      ICASRA='ALPH'
      GOTO1175
C
CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001
 2237 CONTINUE
      ICASRA='BRAD'
      GOTO1175
C
CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001
 2238 CONTINUE
      ICASRA='RECI'
      GOTO1175
C
CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001
 2239 CONTINUE
      ICASRA='JOSB'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001
 2240 CONTINUE
      ICASRA='JOSU'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001
 2241 CONTINUE
      ICASRA='PNOR'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED OCTOOBER 2001
 2242 CONTINUE
      ICASRA='LLOG'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER 2001
 2244 CONTINUE
      ICASRA='GEEE'
      GOTO1177
C
CCCCC FOLLOWING SECTION ADDED NOVEMBER 2001
 2246 CONTINUE
      ICASRA='PLNO'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED DECEMBER 2001
 2248 CONTINUE
      ICASRA='BBIN'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED MARCH 2006
 2249 CONTINUE
      ICASRA='BNOR'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED MAY 2002
 2250 CONTINUE
      ICASRA='STSP'
      GOTO1177
C
CCCCC FOLLOWING SECTION ADDED MAY 2002
 2252 CONTINUE
      ICASRA='BIWE'
      GOTO1175
C
CCCCC FOLLOWING SECTION ADDED MAY 2002
 2254 CONTINUE
      ICASRA='BIWE'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED AUGUST 2002
 2256 CONTINUE
      ICASRA='LOGS'
      GOTO1176
C
CCCCC FOLLOWING SECTION ADDED JANUARY 2003
 2258 CONTINUE
      ICASRA='GH  '
      GOTO1175
C
CCCCC FOLLOWING SECTION ADDED JANUARY 2003
 2260 CONTINUE
      ICASRA='GH  '
      GOTO1177
C
CCCCC FOLLOWING SECTION ADDED JANUARY 2003
 2262 CONTINUE
      ICASRA='SLAS'
      GOTO1175
C
CCCCC FOLLOWING SECTION ADDED APRIL 2003
 2264 CONTINUE
      ICASRA='LAND'
      GOTO1175
C
 2266 CONTINUE
      ICASRA='IBET'
      GOTO1175
C
 2267 CONTINUE
      ICASRA='ERRO'
      GOTO1175
C
 2268 CONTINUE
      ICASRA='ERRO'
      GOTO1176
C
 2270 CONTINUE
      ICASRA='TRAP'
      GOTO1175
C
 2272 CONTINUE
      ICASRA='VONM'
      GOTO1176
C
 2274 CONTINUE
      ICASRA='WRCA'
      GOTO1176
C
 2276 CONTINUE
      ICASRA='PAR2'
      GOTO1177
C
 2278 CONTINUE
      ICASRA='GTRA'
      GOTO1176
C
 2280 CONTINUE
      ICASRA='TNOR'
      GOTO1176
C
 2282 CONTINUE
      ICASRA='CHI '
      GOTO1175
C
 2284 CONTINUE
      ICASRA='FCAU'
      GOTO1176
C
 2286 CONTINUE
      ICASRA='BKAP'
      GOTO1176
C
 2288 CONTINUE
      ICASRA='BKAP'
      GOTO1177
C
 2290 CONTINUE
      ICASRA='TEXP'
      GOTO1176
C
 2292 CONTINUE
      ICASRA='GEXP'
      GOTO1176
C
 2294 CONTINUE
      ICASRA='GGD '
      GOTO1176
C
 2296 CONTINUE
      ICASRA='FT  '
      GOTO1176
C
 2298 CONTINUE
      ICASRA='SKWT'
      GOTO1176
C
 2300 CONTINUE
      ICASRA='SKWN'
      GOTO1176
C
 2302 CONTINUE
      ICASRA='ZIPF'
      GOTO1176
C
 2304 CONTINUE
      ICASRA='GMAK'
      GOTO1177
C
 2306 CONTINUE
      ICASRA='GIG '
      GOTO1178
C
 2308 CONTINUE
      ICASRA='SKLT'
      GOTO1178
C
 2310 CONTINUE
      ICASRA='SKLN'
      GOTO1178
C
 2312 CONTINUE
      ICASRA='NCT '
      GOTO1177
C
 2313 CONTINUE
      ICASRA='NCT '
      GOTO1178
C
 2314 CONTINUE
      ICASRA='DNCT'
      GOTO1178
C
 2315 CONTINUE
      ICASRA='DNCT'
      GOTO1179
C
 2316 CONTINUE
      ICASRA='GLOG'
      GOTO1178
C
 2318 CONTINUE
      ICASRA='GHLO'
      GOTO1177
C
 2320 CONTINUE
      ICASRA='POLY'
      GOTO1175
C
 2322 CONTINUE
      ICASRA='HERM'
      GOTO1175
C
 2324 CONTINUE
      ICASRA='YULE'
      GOTO1175
C
 2326 CONTINUE
      ICASRA='WARI'
      GOTO1175
C
 2328 CONTINUE
      ICASRA='GWAR'
      GOTO1176
C
 2330 CONTINUE
      ICASRA='NCBE'
      GOTO1177
C
 2331 CONTINUE
      ICASRA='NCBE'
      GOTO1178
C
 2332 CONTINUE
      ICASRA='DNCB'
      GOTO1178
C
 2333 CONTINUE
      ICASRA='DNCB'
      GOTO1179
C
 2334 CONTINUE
      ICASRA='SKDE'
      GOTO1178
C
 2335 CONTINUE
      ICASRA='SKDE'
      GOTO1179
C
 2336 CONTINUE
      ICASRA='ASDE'
      GOTO1178
C
 2337 CONTINUE
      ICASRA='ASDE'
      GOTO1179
C
 2338 CONTINUE
      ICASRA='GASD'
      GOTO1179
C
 2339 CONTINUE
      ICASRA='GASD'
      GOTO1180
C
 2340 CONTINUE
      ICASRA='MAXW'
      GOTO1177
C
 2341 CONTINUE
      ICASRA='RAYL'
      GOTO1177
C
 2343 CONTINUE
      ICASRA='MCLE'
      GOTO1177
C
 2345 CONTINUE
      ICASRA='BESI'
      GOTO1179
C
 2346 CONTINUE
      ICASRA='BESI'
      GOTO1178
C
 2347 CONTINUE
      ICASRA='BESK'
      GOTO1179
C
 2348 CONTINUE
      ICASRA='BESK'
      GOTO1178
C
 2350 CONTINUE
      ICASRA='GMCL'
      GOTO1178
C
 2352 CONTINUE
      ICASRA='HBOL'
      GOTO1177
C
 2354 CONTINUE
      ICASRA='G5LO'
      GOTO1180
C
 2356 CONTINUE
      ICASRA='G5LO'
      GOTO1179
C
 2358 CONTINUE
      ICASRA='WAKE'
      GOTO1177
C
 2360 CONTINUE
      ICASRA='G2LO'
      GOTO1180
C
 2362 CONTINUE
      ICASRA='G3LO'
      GOTO1180
C
 2364 CONTINUE
      ICASRA='G4LO'
      GOTO1180
C
CCCCC FOLLOWING SECTION ADDED MARCH 2006
 2366 CONTINUE
      ICASRA='LDEX'
      GOTO1176
C
 2368 CONTINUE
      ICASRA='ALDE'
      GOTO1178
C
 2370 CONTINUE
      ICASRA='ALDE'
      GOTO1177
C
 1174 CONTINUE
      ILOCNU=4
      GOTO1190
 1175 CONTINUE
      ILOCNU=5
      GOTO1190
 1176 CONTINUE
      ILOCNU=6
      GOTO1190
 1177 CONTINUE
      ILOCNU=7
      GOTO1190
 1178 CONTINUE
      ILOCNU=8
      GOTO1190
 1179 CONTINUE
      ILOCNU=9
      GOTO1190
 1180 CONTINUE
      ILOCNU=10
      GOTO1190
C
 1190 CONTINUE
      IFOUND='YES'
      GOTO9000
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 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 ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE CKSTAT(IBUGA3,IFOUN8,ICASL8,ILOCV)
C
C     PURPOSE--CHECK TO SEE IF A TYPE 8 LET
C              COMMAND HAS BEEN GIVEN--
C                      NUMBER
C                      SIZE
C                      COUNT
C                      SAMPLE SIZE
C
C                      SUM
C                      PRODUCT
C                      INTEGRAL
C                      RATIO
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
C
C              SCALE STATISTICS (ONE RESPONSE VARIABLE)
C                      STANDARD DEVIATION (& SD)
C                      VARIANCE (& VAR)
C                      AVERAGE ABSOLUTE DEVIATION
C                      MAD (MEDIAN ABSOLUTE DEVIATION)
C                      SN
C                      QN
C                      GEOMETRIC STANDARD DEVIATION
C                      INTERQUARTILE RANGE
C                      BIWEIGHT SCALE
C                      BIWEIGHT MIDVARIANCE
C                      BIWEIGHT MIDCOVARIANCE
C                      BIWEIGHT MIDCORRELATION
C                      WINSORIZED VARIANCE
C                      WINSORIZED STANDARD DEVIATION (OR SD)
C                      PERCENTAGE BEND MIDVARIANCE
C                      PERCENTAGE BEND CORRELATION
C                      RELATIVE STANDARD DEVIATION
C                      RELATIVE VARIANCE
C
C              PERCENTILE STATISTICS (ONE RESPONSE VARIABLE)
C                      QUANTILE
C                      QUANTILE STANDARD ERROR
C                      <VALUE> PERCENTILE
C                      COEFFICIENT OF VARIATION
C                      RANGE
C                      MINIMUM
C                      MIN
C                      MAXIMUM
C                      MAX
C                      EXTREME
C
C              SKEWNESS/KURTOSIS STATISTICS (ONE RESPONSE VARIABLE)
C                      STANDARDIZED THIRD CENTRAL MOMENT
C                      SKEWNESS
C                      STANDARDIZED FOURTH CENTRAL MOMENT
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 (ONE RESPONSE VARIABLE)
C                      AUTOCORRELATION
C
C                QUALITY CONTROL STATISTICS (ONE RESPONSE VARIABLE)
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                 MISCELLANEOUS STATISTICS (ONE RESPONSE VARIABLE)
C                      NORMAL PPCC
C                      SIN FREQUENCY
C                      SIN AMPLITUDE
C                      COMMON DIGITS 
C                      NUMBER OF COMMON DIGITS 
C
C                 CO-RELATION (TWO RESPONSE VARIABLES)
C                      COVARIANCE
C                      CORRELATION
C                      RANK CORRELATION
C                      KENDELL TAU
C                      COMOVEMENT (LEIGH-PEARLMAN)
C                      RANK COMOVEMENT
C                      WINSORIZED COVARIANCE
C                      WINSORIZED CORRELATION
C
C                 SCALE (ONE RESPONSE VARIABLES, ONE GROUP-ID VARIABLE)
C                      REPEATABILITY STANDARD DEVIATION
C                      REPRODUCABILITY STANDARD DEVIATION
C
C                  FOLLOWING STATISTICS COMPUTE DIFFERENCE IN
C                  STATISTIC FOR TWO RESPONSE VARIABLES (USED FOR
C                  LOCATION AND SCALE STATISTICS):
C
C                  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
C                  SCALE:
C                      DIFFERENCE OF STANDARD DEVIATIONS
C                      DIFFERENCE OF VARIANCES
C                      DIFFERENCE OF AAD
C                      DIFFERENCE OF MAD
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
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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MARCH     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
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IFOUN8
      CHARACTER*4 ICASL8
C
      CHARACTER*4 IERROR
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 ISUBN0
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHO.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      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
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'NUMB'.AND.IHARG(4).EQ.'OF  '.AND.
     1IHARG(5).EQ.'COMM'.AND.IHARG(6).EQ.'DIGI')GOTO343
C
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'NUMB'.AND.IHARG2(3).EQ.'ER  ')GOTO201
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'COUN'.AND.IHARG2(3).EQ.'T   ')GOTO201
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'COUN'.AND.IHARG2(3).EQ.'TS  ')GOTO201
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'SIZE'.AND.IHARG2(3).EQ.'    ')GOTO201
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'SAMP'.AND.IHARG(4).EQ.'SIZE')GOTO202
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'SUM '.AND.IHARG2(3).EQ.'    ')GOTO203
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'PROD'.AND.IHARG2(3).EQ.'UCT ')GOTO204
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'INTE'.AND.IHARG2(3).EQ.'GRAL')GOTO205
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'MIDR'.AND.IHARG2(3).EQ.'ANGE')GOTO206
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'MEAN'.AND.IHARG2(3).EQ.'    ')GOTO207
C  SEPTEMBER, 1988: CHECK FOR "AVERAGE ABSOLUTE DEVIATION"
CCCCC IF(NUMARG.GE.3.AND.
CCCCC1IHARG(3).EQ.'AVER'.AND.IHARG2(3).EQ.'AGE ')GOTO208
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'AVER'.AND.IHARG2(3).EQ.'AGE '.AND.
     1IHARG(4).NE.'ABSO')GOTO208
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'MIDM'.AND.IHARG2(3).EQ.'EAN ')GOTO209
CCCCC MARCH 1995.  CHECK FOR MEDIAN ABSOLUTE DEVIATION.
CCCCC IF(NUMARG.GE.3.AND.
CCCCC1IHARG(3).EQ.'MEDI'.AND.IHARG2(3).EQ.'AN  ')GOTO210
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'MEDI'.AND.IHARG(4).NE.'ABSO')GOTO210
C
CCCCC THE FOLLOWING 8 LINES WERE ADDED     FEBRUARY 1994
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'VARI'.AND.IHARG(4).EQ.'OF  '.AND.
     1IHARG(5).EQ.'THE '.AND.IHARG(6).EQ.'MEAN')GOTO306
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'VARI'.AND.IHARG(4).EQ.'OF  '.AND.
     1IHARG(5).EQ.'MEAN')GOTO307
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'VARI'.AND.IHARG(4).EQ.'MEAN')GOTO308
C
CCCCC THE FOLLOWING 8 LINES WERE ADDED     FEBRUARY 1994
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'VAR '.AND.IHARG(4).EQ.'OF  '.AND.
     1IHARG(5).EQ.'THE '.AND.IHARG(6).EQ.'MEAN')GOTO306
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'VAR '.AND.IHARG(4).EQ.'OF  '.AND.
     1IHARG(5).EQ.'MEAN')GOTO307
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'VAR '.AND.IHARG(4).EQ.'MEAN')GOTO308
C
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'VARI'.AND.IHARG2(3).EQ.'ANCE')GOTO211
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED     FEBRUARY 1994
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'VARI'.AND.IHARG2(3).EQ.'    ')GOTO211
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'VAR '.AND.IHARG2(3).EQ.'    ')GOTO211
C
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'RELA'.AND.IHARG(4).EQ.'STAN'.AND.
     1IHARG(5).EQ.'DEVI')GOTO212
C
CCCCC THE FOLLOWING 6 LINES WERE ADDED     FEBRUARY 1994
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'RELA'.AND.IHARG(4).EQ.'SD  ')GOTO311
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'RELA'.AND.IHARG(4).EQ.'VARI')GOTO312
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'RELA'.AND.IHARG(4).EQ.'VAR ')GOTO312
C
C  SEPTEMBER, 1988.  ADD AVERAGE ABSOLUTE DEVIATION
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'AVER'.AND.IHARG(4).EQ.'ABSO'.AND.
     1IHARG(5).EQ.'DEVI')GOTO291
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'AAD ')GOTO287
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'MAD ')GOTO288
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'MEDI'.AND.IHARG(4).EQ.'ABSO'.AND.
     1IHARG(5).EQ.'DEVI')GOTO289
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'COEF'.AND.IHARG(4).EQ.'OF  '.AND.
     1IHARG(5).EQ.'VARI')GOTO212
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'COEF'.AND.IHARG(4).EQ.'VARI')GOTO214
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'RANG'.AND.IHARG2(3).EQ.'E   ')GOTO215
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'MINI'.AND.IHARG2(3).EQ.'MUM ')GOTO216
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'MIN '.AND.IHARG2(3).EQ.'    ')GOTO217
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'MAXI'.AND.IHARG2(3).EQ.'MUM ')GOTO218
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'MAX '.AND.IHARG2(3).EQ.'    ')GOTO219
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'THIR'.AND.
     1IHARG(5).EQ.'CENT'.AND.IHARG(6).EQ.'MOME')GOTO220
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'3RD '.AND.
     1IHARG(5).EQ.'CENT'.AND.IHARG(6).EQ.'MOME')GOTO221
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'SKEW'.AND.IHARG2(3).EQ.'NESS')GOTO222
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'FOUR'.AND.
     1IHARG(5).EQ.'CENT'.AND.IHARG(6).EQ.'MOME')GOTO223
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'4TH '.AND.
     1IHARG(5).EQ.'CENT'.AND.IHARG(6).EQ.'MOME')GOTO224
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'KURT'.AND.IHARG2(3).EQ.'OSIS')GOTO225
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'AUTO'.AND.IHARG2(3).EQ.'COVA')GOTO226
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'AUTO'.AND.IHARG2(3).EQ.'CORR')GOTO227
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'LOWE'.AND.IHARG(4).EQ.'HING')GOTO228
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'UPPE'.AND.IHARG(4).EQ.'HING')GOTO229
      IF(NUMARG.GE.7.AND.
     1IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'DEVI'.AND.
     1IHARG(5).EQ.'OF  '.AND.IHARG(6).EQ.'THE '.AND.
     1IHARG(7).EQ.'MEAN')GOTO230
C
CCCCC THE FOLLOWING 8 LINES WERE ADDED     FEBRUARY 1994
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'SD  '.AND.IHARG(4).EQ.'OF  '.AND.
     1IHARG(5).EQ.'THE '.AND.IHARG(6).EQ.'MEAN')GOTO301
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'SD  '.AND.IHARG(4).EQ.'OF  '.AND.
     1IHARG(5).EQ.'MEAN')GOTO302
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'SD  '.AND.IHARG(4).EQ.'MEAN')GOTO303
C
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'DEVI'.AND.
     1IHARG(5).EQ.'OF  '.AND.IHARG(6).EQ.'MEAN')GOTO231
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'DEVI'.AND.
     1IHARG(5).EQ.'MEAN')GOTO232
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'DEVI')GOTO233
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED     FEBRUARY 1994
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'SD  ')GOTO304
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'LOWE'.AND.IHARG(4).EQ.'QUAR')GOTO234
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'FIRS'.AND.IHARG(4).EQ.'QUAR')GOTO234
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'SECO'.AND.IHARG(4).EQ.'QUAR')GOTO235
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'UPPE'.AND.IHARG(4).EQ.'QUAR')GOTO236
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'THIR'.AND.IHARG(4).EQ.'QUAR')GOTO236
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'TRIM'.AND.IHARG(4).EQ.'MEAN'.AND.
     1(IHARG(5).NE.'STAN'.AND.IHARG(6).NE.'ERRO'))GOTO237
      IF(NUMARG.GE.4.AND.
CCCCC THE FOLLOWING LINE WAS FIXED SEPTEMBER 1990
CCCCC1IHARG(3).EQ.'WIND'.AND.IHARG(4).EQ.'MEAN')GOTO238
     1IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'MEAN')GOTO238
CCCCC JULY 2002: ADD WINSORIZED VARIANCE, WINSORIZED SD,
C     WINSORIZED COVARIANCE, WINSORIZED CORRELATION
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'VARI')GOTO352
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'SD  ')GOTO354
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'STAN'.AND.
     1IHARG(5).EQ.'DEVI')GOTO356
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'COVA')GOTO364
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'CORR')GOTO366
CCCCC JULY 2002: ADD HODGES LEHMAN
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'HODG'.AND.IHARG(4).EQ.'LEHM'.AND.
     1IHARG(5).EQ.'LOCA')GOTO358
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'HODG'.AND.IHARG(4).EQ.'LEHM')GOTO360
CCCCC JULY 2002: ADD PERCENTAGE BEND MIDVARIANCE
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'PERC'.AND.IHARG(4).EQ.'BEND'.AND.
     1IHARG(5).EQ.'MIDV')GOTO362
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'PERC'.AND.IHARG(4).EQ.'BEND'.AND.
     1IHARG(5).EQ.'CORR')GOTO363
CCCCC JULY 2002: ADD BIWEIGHT MIDVARIANCE AND BIWEIGHT MIDCOVARIANCE
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'BIWE'.AND.IHARG(4).EQ.'MIDV')GOTO368
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'BIWE'.AND.
     1IHARG(4).EQ.'MIDC'.AND.IHARG2(4).EQ.'ORRE')GOTO369
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'BIWE'.AND.IHARG(4).EQ.'MIDC')GOTO370
CCCCC JULY 2002: ADD QUANTILE, QUANTILE STANDARD ERROR, TRIMEED MEAN
CCCCC            STANDARD ERROR
      IF(NUMARG.GE.6.AND.IHARG(4).EQ.'QUAN'.AND.IHARG(5).EQ.'STAN'.AND.
     1   IHARG(6).EQ.'ERRO')THEN
        P100=ARG(3)
        IH='P100'
        IH2='    '
        VALUE0=P100
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
        GOTO372
      ENDIF
      IF(NUMARG.GE.4.AND.IHARG(4).EQ.'QUAN')THEN
        P100=ARG(3)
        IH='P100'
        IH2='    '
        VALUE0=P100
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
        GOTO374
      ENDIF
C
      IF(NUMARG.GE.6.AND.
     1IHARG(3).EQ.'TRIM'.AND.IHARG(4).EQ.'MEAN'.AND.
     1IHARG(5).EQ.'STAN'.AND.IHARG(6).EQ.'ERRO')GOTO376
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED SEPTEMBER 1990
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'SD'.AND.IHARG2(3).EQ.'    ')GOTO239
C
CCCCC THE FOLLOWING SECTION WAS CHANGED AND ADDED TO   AUGUST 1991
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'COVA'.AND.IHARG2(3).EQ.'RIAN')GOTO250
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'CORR'.AND.IHARG(4).EQ.'COEF')GOTO251
CCCCC THE FOLLOWING 2 LINES WERE CHANGED   MAY 1993
CCCCC IF(NUMARG.GE.3.AND.
CCCCC1IHARG(3).EQ.'CORR'.AND.IHARG2(3).EQ.'ELAT')GOTO252
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CORR')GOTO252
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'COMO'.AND.IHARG(4).EQ.'COEF')GOTO253
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'COMO'.AND.IHARG(4).EQ.'INDE')GOTO253
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'COMO'.AND.IHARG2(3).EQ.'VEME')GOTO254
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'RANK'.AND.IHARG(4).EQ.'COVA')GOTO255
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'RANK'.AND.IHARG(4).EQ.'CORR'.AND.
     1IHARG(5).EQ.'COEF')GOTO256
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'RANK'.AND.IHARG(4).EQ.'CORR')GOTO257
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'RANK'.AND.IHARG(4).EQ.'COMO'.AND.
     1IHARG(5).EQ.'COEF')GOTO258
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'RANK'.AND.IHARG(4).EQ.'COMO'.AND.
     1IHARG(5).EQ.'INDE')GOTO258
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'RANK'.AND.IHARG(4).EQ.'COMO')GOTO259
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'KEND'.AND.IHARG(4).EQ.'TAU '.AND.
     1IHARG(5).EQ.'COEF')GOTO480
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'KEND'.AND.IHARG(4).EQ.'TAU ')GOTO481
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'REPE'.AND.IHARG(4).EQ.'STAN'.AND.
     1IHARG(5).EQ.'DEVI')GOTO486
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'REPE'.AND.IHARG(4).EQ.'SD  ')GOTO487
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'REPE')GOTO488
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'REPR'.AND.IHARG(4).EQ.'STAN'.AND.
     1IHARG(5).EQ.'DEVI')GOTO491
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'REPR'.AND.IHARG(4).EQ.'SD  ')GOTO492
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'REPR')GOTO493
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'RATI')GOTO494
C
      IF(NUMARG.GE.4.AND.IHARG(4).EQ.'DECI')GOTO111
      GOTO119
  111 CONTINUE
      IF(IHARG(3).EQ.'FIRS')GOTO261
      IF(IHARG(3).EQ.'SECO')GOTO262
      IF(IHARG(3).EQ.'THIR')GOTO263
      IF(IHARG(3).EQ.'FOUR')GOTO264
      IF(IHARG(3).EQ.'FIFT')GOTO265
      IF(IHARG(3).EQ.'SIXT')GOTO266
      IF(IHARG(3).EQ.'SEVE')GOTO267
      IF(IHARG(3).EQ.'EIGH')GOTO268
      IF(IHARG(3).EQ.'NINT')GOTO269
  119 CONTINUE
C
      IF(NUMARG.GE.4.AND.IHARG(4).EQ.'PERC')THEN
        P100=ARG(3)
        IH='P100'
        IH2='    '
        VALUE0=P100
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        GOTO270
      ENDIF
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'WEIG'.AND.IHARG(4).EQ.'MEAN')GOTO271
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'WEIG'.AND.IHARG(4).EQ.'MEDI')GOTO272
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'WEIG'.AND.IHARG(4).EQ.'STAN'.AND.
     1IHARG(5).EQ.'DEVI')GOTO273
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'WEIG'.AND.IHARG(4).EQ.'VARI')GOTO274
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED    FEBRUARY 1994
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'WEIG'.AND.IHARG(4).EQ.'VAR ')GOTO274
C
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'WEIG'.AND.IHARG(4).EQ.'TRIM'.AND.
     1IHARG(5).EQ.'MEAN')GOTO1274
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'GEOM'.AND.IHARG(4).EQ.'MEAN')GOTO339
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'GEOM'.AND.IHARG(4).EQ.'STAN'.AND.
     1IHARG(5).EQ.'DEVI')GOTO340
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'GEOM'.AND.IHARG(4).EQ.'SD  ')GOTO3340
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'HARM'.AND.IHARG(4).EQ.'MEAN')GOTO341
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'INTE'.AND.IHARG(4).EQ.'RANG')GOTO344
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'IQ  '.AND.IHARG(4).EQ.'RANG')GOTO344
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED APRIL 1990
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'EXTR'.AND.IHARG2(3).EQ.'EME ')GOTO292
C
CCCCC THE FOLLOWING 12 LINES WERE ADDED APRIL 1990
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CP')GOTO281
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CPL')GOTO275
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CPU')GOTO276
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CPK')GOTO282
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CNPK')GOTO278
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'PERC'.AND.IHARG(4).EQ.'DEFE')GOTO283
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'ACTU'.AND.IHARG(4).EQ.'PERC'.AND.
     1IHARG(5).EQ.'DEFE')GOTO284
      IF(NUMARG.GE.5.AND.
     1IHARG(3).EQ.'THEO'.AND.IHARG(4).EQ.'PERC'.AND.
     1IHARG(5).EQ.'DEFE')GOTO285
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'EXPE'.AND.IHARG(4).EQ.'LOSS')GOTO286
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CPM')GOTO280
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'CC')GOTO279
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED     FEBRUARY 1994
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'NORM'.AND.IHARG(4).EQ.'PPCC')GOTO321
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED     MARCH 2003
      IF(NUMARG.GE.4.AND.
     1IHARG(3)(1:3).EQ.'SIN'.AND.IHARG(4).EQ.'FREQ')GOTO293
      IF(NUMARG.GE.4.AND.
     1IHARG(3)(1:3).EQ.'SIN'.AND.IHARG(4)(1:3).EQ.'AMP')GOTO294
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'LINE'.AND.IHARG(4).EQ.'INTE')GOTO295
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'LINE'.AND.IHARG(4).EQ.'SLOP')GOTO296
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'LINE'.AND.IHARG(4).EQ.'RESS')GOTO297
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'LINE'.AND.IHARG(4).EQ.'CORR')GOTO298
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'SN  '.AND.IHARG(4).EQ.'SCAL')GOTO378
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'QN  '.AND.IHARG(4).EQ.'SCAL')GOTO380
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED     FEBRUARY 1994
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'TAGU'.AND.IHARG(4).EQ.'SN- ')GOTO331
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'TAGU'.AND.IHARG(4).EQ.'SN0 ')GOTO332
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'TAGU'.AND.IHARG(4).EQ.'SN+ ')GOTO333
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'TAGU'.AND.IHARG(4).EQ.'SN00')GOTO334
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'SN- ')GOTO335
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'SN0 ')GOTO336
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'SN+ ')GOTO337
      IF(NUMARG.GE.3.AND.
     1IHARG(3).EQ.'SN00')GOTO338
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'COMM'.AND.IHARG(4).EQ.'DIGI')GOTO342
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'BIWE'.AND.IHARG(4).EQ.'LOCA')GOTO346
C
      IF(NUMARG.GE.4.AND.
     1IHARG(3).EQ.'BIWE'.AND.IHARG(4).EQ.'SCAL')GOTO348
C
CCCCC MARCH 2003: ADD 35 "DIFFERENCE OF" STATISTICS
C
      IF(NUMARG.GE.5.AND.IHARG(3).EQ.'DIFF'.AND.IHARG(4).EQ.'OF')THEN
        IF(IHARG(5).EQ.'AVER'.AND.IHARG(6).EQ.'ABSO'.AND.
     1     IHARG(7).EQ.'DEVI')GOTO523
        IF(IHARG(5).EQ.'AAD')GOTO423
        IF(IHARG(5).EQ.'MEAN' .OR. IHARG(5).EQ.'AVER')GOTO401
        IF(IHARG(5).EQ.'MIDM')GOTO402
        IF(IHARG(5).EQ.'MEDI'.AND.IHARG(6).EQ.'ABSO'.AND.
     1     IHARG(7).EQ.'DEVI')GOTO524
        IF(IHARG(5).EQ.'MAD')GOTO424
        IF(IHARG(5).EQ.'MEDI')GOTO403
        IF(IHARG(5).EQ.'TRIM'.AND.IHARG(6).EQ.'MEAN')GOTO404
        IF(IHARG(5).EQ.'WINS'.AND.IHARG(6).EQ.'MEAN')GOTO405
        IF(IHARG(5).EQ.'GEOM'.AND.IHARG(6).EQ.'MEAN')GOTO406
        IF(IHARG(5).EQ.'HARM'.AND.IHARG(6).EQ.'MEAN')GOTO407
        IF(IHARG(5).EQ.'HODG'.AND.IHARG(6).EQ.'LEHM')GOTO408
        IF(IHARG(5).EQ.'BIWE'.AND.IHARG(6).EQ.'LOCA')GOTO409
        IF(IHARG(5).EQ.'SD'.AND.IHARG(6).EQ.'OF'.AND.
     1     IHARG(7).EQ.'THE'.AND.IHARG(8).EQ.'MEAN')GOTO638
        IF(IHARG(5).EQ.'SD'.AND.IHARG(6).EQ.'OF'.AND.
     1     IHARG(7).EQ.'MEAN')GOTO538
        IF(IHARG(5).EQ.'SD'.AND.IHARG(6).EQ.'MEAN')GOTO438
        IF(IHARG(5).EQ.'SD')GOTO420
        IF(IHARG(5).EQ.'STAN'.AND.IHARG(6).EQ.'DEVI')GOTO421
        IF(IHARG(5).EQ.'VARI'.AND.IHARG(6).EQ.'OF'.AND.
     1     IHARG(7).EQ.'THE'.AND.IHARG(8).EQ.'MEAN')GOTO640
        IF(IHARG(5).EQ.'VARI'.AND.IHARG(6).EQ.'OF'.AND.
     1     IHARG(7).EQ.'MEAN')GOTO540
        IF(IHARG(5).EQ.'VARI'.AND.IHARG(6).EQ.'MEAN')GOTO440
        IF(IHARG(5).EQ.'VARI')GOTO422
        IF(IHARG(5).EQ.'INTE'.AND.IHARG(6).EQ.'RANG')GOTO425
        IF(IHARG(5).EQ.'IQ  '.AND.IHARG(6).EQ.'RANG')GOTO425
        IF(IHARG(5).EQ.'WINS'.AND.IHARG(6).EQ.'STAN'.AND.
     1     IHARG(7).EQ.'DEVI')GOTO526
        IF(IHARG(5).EQ.'WINS'.AND.IHARG(6).EQ.'SD')GOTO426
        IF(IHARG(5).EQ.'WINS'.AND.IHARG(6).EQ.'VARI')GOTO427
        IF(IHARG(5).EQ.'BIWE'.AND.IHARG(6).EQ.'MIDV')GOTO428
        IF(IHARG(5).EQ.'BIWE'.AND.IHARG(6).EQ.'SCAL')GOTO429
        IF(IHARG(5).EQ.'PERC'.AND.IHARG(6).EQ.'BEND'.AND.
     1     IHARG(7).EQ.'MIDV')GOTO430
        IF(IHARG(5).EQ.'GEOM'.AND.IHARG(6).EQ.'STAN'.AND.
     1     IHARG(7).EQ.'DEVI')GOTO531
        IF(IHARG(5).EQ.'GEOM'.AND.IHARG(6).EQ.'SD')GOTO431
        IF(IHARG(5).EQ.'RANG')GOTO432
        IF(IHARG(5).EQ.'MIDR')GOTO433
        IF(IHARG(5).EQ.'QUAN')GOTO434
        IF(IHARG(5).EQ.'SKEW')GOTO435
        IF(IHARG(5).EQ.'KURT')GOTO436
        IF(IHARG(5).EQ.'RELA'.AND.IHARG(6).EQ.'SD')GOTO437
        IF(IHARG(5).EQ.'RELA'.AND.IHARG(6).EQ.'VARI')GOTO439
        IF(IHARG(5).EQ.'RELA'.AND.IHARG(6).EQ.'VARI')GOTO439
        IF(IHARG(5).EQ.'MINI')GOTO441
        IF(IHARG(5).EQ.'MAXI')GOTO442
        IF(IHARG(5).EQ.'EXTR')GOTO443
        IF(IHARG(5).EQ.'COEF'.AND.IHARG(6).EQ.'OF'.AND.
     1     IHARG(7).EQ.'VARI')GOTO544
        IF(IHARG(5).EQ.'COEF'.AND.IHARG(6).EQ.'VARI')GOTO444
        IF(IHARG(5).EQ.'SN')GOTO545
        IF(IHARG(5).EQ.'SN'.AND.IHARG(6).EQ.'SCAL')GOTO445
        IF(IHARG(5).EQ.'QN')GOTO546
        IF(IHARG(5).EQ.'QN'.AND.IHARG(6).EQ.'SCAL')GOTO446
        IF(IHARG(5).EQ.'SUM')GOTO451
        IF(IHARG(5).EQ.'SUMS')GOTO451
        IF(IHARG(5).EQ.'SIZE')GOTO452
        IF(IHARG(5).EQ.'NUMB')GOTO452
        IF(IHARG(5).EQ.'COUN')GOTO452
      ENDIF
C
      IFOUN8='NO'
      GOTO9000
C
C               **********************
C               **  STEP 2--        **
C               **  DEFINE ICASL8.  **
C               **********************
C
  201 CONTINUE
      ICASL8='NUMB'
      GOTO704
C
  202 CONTINUE
      ICASL8='NUMB'
      GOTO705
C
  203 CONTINUE
      ICASL8='SUM'
      GOTO704
C
  204 CONTINUE
      ICASL8='PROD'
      GOTO704
C
  205 CONTINUE
      ICASL8='INTE'
      GOTO704
C
  206 CONTINUE
      ICASL8='MIDR'
      GOTO704
C
  207 CONTINUE
      ICASL8='MEAN'
      GOTO704
C
  208 CONTINUE
      ICASL8='MEAN'
      GOTO704
C
  209 CONTINUE
      ICASL8='MIDM'
      GOTO704
C
  210 CONTINUE
      ICASL8='MEDI'
      GOTO704
C
  211 CONTINUE
      ICASL8='VARI'
      GOTO704
C
  212 CONTINUE
CCCCC NOVEMBER 1994.  DISTINGUISH RELATIVE SD AND COEF OF VARIATION.
CCCCC ICASL8='RESD'
      ICASL8='CVAR'
      GOTO706
C
  214 CONTINUE
CCCCC NOVEMBER 1994.  DISTINGUISH RELATIVE SD AND COEF OF VARIATION.
CCCCC ICASL8='RESD'
      ICASL8='CVAR'
      GOTO705
C
  215 CONTINUE
      ICASL8='RANG'
      GOTO704
C
  216 CONTINUE
      ICASL8='MINI'
      GOTO704
C
  217 CONTINUE
      ICASL8='MINI'
      GOTO704
C
  218 CONTINUE
      ICASL8='MAXI'
      GOTO704
C
  219 CONTINUE
      ICASL8='MAXI'
      GOTO704
C
  220 CONTINUE
      ICASL8='SKEW'
      GOTO707
C
  221 CONTINUE
      ICASL8='SKEW'
      GOTO707
C
  222 CONTINUE
      ICASL8='SKEW'
      GOTO704
C
  223 CONTINUE
      ICASL8='KURT'
      GOTO707
C
  224 CONTINUE
      ICASL8='KURT'
      GOTO707
C
  225 CONTINUE
      ICASL8='KURT'
      GOTO704
C
  226 CONTINUE
      ICASL8='AUCV'
      GOTO704
C
  227 CONTINUE
      ICASL8='AUCR'
      GOTO704
C
  228 CONTINUE
      ICASL8='LOWH'
      GOTO705
C
  229 CONTINUE
      ICASL8='UPPH'
      GOTO705
C
  230 CONTINUE
      ICASL8='SDME'
      GOTO708
C
  231 CONTINUE
      ICASL8='SDME'
      GOTO707
C
  232 CONTINUE
      ICASL8='SDME'
      GOTO706
C
  233 CONTINUE
      ICASL8='SD'
      GOTO705
C
  234 CONTINUE
      ICASL8='LOWQ'
      GOTO705
C
  235 CONTINUE
      ICASL8='MIDQ'
      GOTO705
C
  236 CONTINUE
      ICASL8='UPPQ'
      GOTO705
C
  237 CONTINUE
      ICASL8='TRIM'
      GOTO705
C
  238 CONTINUE
      ICASL8='WINM'
      GOTO705
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED SEPTEMBER 1990
  239 CONTINUE
      ICASL8='SD'
      GOTO704
C
CCCCC THE FOLLOWING 40 LINES WERE CHANGED AND ADDED TO   AUGUST 1991
  250 CONTINUE
      ICASL8='COVA'
      GOTO704
C
  251 CONTINUE
      ICASL8='CORR'
      GOTO705
C
  252 CONTINUE
      ICASL8='CORR'
      GOTO704
C
  253 CONTINUE
      ICASL8='COMO'
      GOTO705
C
  254 CONTINUE
      ICASL8='COMO'
      GOTO704
C
  255 CONTINUE
      ICASL8='RACV'
      GOTO705
C
  256 CONTINUE
      ICASL8='RACR'
      GOTO706
C
  257 CONTINUE
      ICASL8='RACR'
      GOTO705
C
  258 CONTINUE
      ICASL8='RACM'
      GOTO706
C
  259 CONTINUE
      ICASL8='RACM'
      GOTO705
C
  261 CONTINUE
      ICASL8='1DEC'
      GOTO705
C
  262 CONTINUE
      ICASL8='2DEC'
      GOTO705
C
  263 CONTINUE
      ICASL8='3DEC'
      GOTO705
C
  264 CONTINUE
      ICASL8='4DEC'
      GOTO705
C
  265 CONTINUE
      ICASL8='5DEC'
      GOTO705
C
  266 CONTINUE
      ICASL8='6DEC'
      GOTO705
C
  267 CONTINUE
      ICASL8='7DEC'
      GOTO705
C
  268 CONTINUE
      ICASL8='8DEC'
      GOTO705
C
  269 CONTINUE
      ICASL8='9DEC'
      GOTO705
C
  270 CONTINUE
      ICASL8='PERC'
      GOTO705
C
  271 CONTINUE
      ICASL8='WEME'
      GOTO705
C
  272 CONTINUE
      ICASL8='WEMD'
      GOTO705
C
  273 CONTINUE
      ICASL8='WESD'
      GOTO706
C
  274 CONTINUE
      ICASL8='WEVA'
      GOTO705
C
 1274 CONTINUE
      ICASL8='WETM'
      GOTO706
C
  275 CONTINUE
      ICASL8='CPL'
      GOTO704
C
  276 CONTINUE
      ICASL8='CPU'
      GOTO704
C
  278 CONTINUE
      ICASL8='CNPK'
      GOTO704
C
  279 CONTINUE
      ICASL8='CC'
      GOTO704
C
  280 CONTINUE
      ICASL8='CPM'
      GOTO704
C
CCCCC THE FOLLOWING 6 SECTIONS WERE ADDED SEPTEMBER 1990
  281 CONTINUE
      ICASL8='CP'
      GOTO704
C
  282 CONTINUE
      ICASL8='CPK'
      GOTO704
C
  283 CONTINUE
      ICASL8='ACPD'
      GOTO705
C
  284 CONTINUE
      ICASL8='ACPD'
      GOTO706
C
  285 CONTINUE
      ICASL8='THPD'
      GOTO706
C
  286 CONTINUE
      ICASL8='EXPL'
      GOTO705
C
  287 CONTINUE
      ICASL8='AAD '
      GOTO704
C
  288 CONTINUE
      ICASL8='MAD '
      GOTO704
C
  289 CONTINUE
      ICASL8='MAD '
      GOTO706
C
  291 CONTINUE
      ICASL8='AAD '
      GOTO706
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    FEBRUARY 1994
  292 CONTINUE
      ICASL8='EXTR'
      GOTO704
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    MARCH 2003
  293 CONTINUE
      ICASL8='SIFR'
      GOTO705
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    MARCH 2003
  294 CONTINUE
      ICASL8='SIAM'
      GOTO705
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    MARCH 2003
  295 CONTINUE
      ICASL8='LIIN'
      GOTO705
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    MARCH 2003
  296 CONTINUE
      ICASL8='LISL'
      GOTO705
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    MARCH 2003
  297 CONTINUE
      ICASL8='LIRE'
      GOTO705
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    MARCH 2003
  298 CONTINUE
      ICASL8='LICO'
      GOTO705
C
CCCCC THE FOLLOWING 7 SECTIONS WERE ADDED    FEBRUARY 1994
  301 CONTINUE
      ICASL8='SDME'
      GOTO707
C
  302 CONTINUE
      ICASL8='SDME'
      GOTO706
C
  303 CONTINUE
      ICASL8='SDME'
      GOTO705
C
  304 CONTINUE
      ICASL8='SD'
      GOTO704
C
  306 CONTINUE
      ICASL8='VAME'
      GOTO707
C
  307 CONTINUE
      ICASL8='VAME'
      GOTO706
C
  308 CONTINUE
      ICASL8='VAME'
      GOTO705
C
  311 CONTINUE
      ICASL8='RESD'
      GOTO705
C
  312 CONTINUE
      ICASL8='REVA'
      GOTO705
C
  321 CONTINUE
      ICASL8='NOPP'
      GOTO705
C
CCCCC THE FOLLOWING 6 SECTIONS WERE ADDED    FEBRUARY 1994
  331 CONTINUE
      ICASL8='SN-'
      GOTO705
C
  332 CONTINUE
      ICASL8='SN0'
      GOTO705
C
  333 CONTINUE
      ICASL8='SN+'
      GOTO705
C
  334 CONTINUE
      ICASL8='SN00'
      GOTO705
C
  335 CONTINUE
      ICASL8='SN-'
      GOTO704
C
  336 CONTINUE
      ICASL8='SN0'
      GOTO704
C
  337 CONTINUE
      ICASL8='SN+'
      GOTO704
C
  338 CONTINUE
      ICASL8='SN00'
      GOTO704
C
  339 CONTINUE
      ICASL8='GEME'
      GOTO705
C
 3340 CONTINUE
      ICASL8='GESD'
      GOTO705
C
  340 CONTINUE
      ICASL8='GESD'
      GOTO706
C
  341 CONTINUE
      ICASL8='HAME'
      GOTO705
C
  342 CONTINUE
      ICASL8='CDIG'
      GOTO705
C
  343 CONTINUE
      ICASL8='NCDI'
      GOTO707
C
  344 CONTINUE
      ICASL8='IQRA'
      GOTO705
C
  346 CONTINUE
      ICASL8='BILO'
      GOTO705
C
  348 CONTINUE
      ICASL8='BISC'
      GOTO705
C
  352 CONTINUE
      ICASL8='WIVA'
      GOTO705
C
  354 CONTINUE
      ICASL8='WISD'
      GOTO705
C
  356 CONTINUE
      ICASL8='WISD'
      GOTO706
C
  358 CONTINUE
      ICASL8='HLEH'
      GOTO706
C
  360 CONTINUE
      ICASL8='HLEH'
      GOTO705
C
  362 CONTINUE
      ICASL8='PBMV'
      GOTO706
C
  363 CONTINUE
      ICASL8='PBCR'
      GOTO706
C
  364 CONTINUE
      ICASL8='WICV'
      GOTO705
C
  366 CONTINUE
      ICASL8='WICR'
      GOTO705
C
  368 CONTINUE
      ICASL8='BIMV'
      GOTO705
C
  369 CONTINUE
      ICASL8='BICR'
      GOTO705
C
  370 CONTINUE
      ICASL8='BIMC'
      GOTO705
C
  372 CONTINUE
      ICASL8='QUSE'
      GOTO707
C
  374 CONTINUE
      ICASL8='QUAN'
      GOTO705
C
  376 CONTINUE
      ICASL8='TMSE'
      GOTO707
C
  378 CONTINUE
      ICASL8='SNSC'
      GOTO705
C
  380 CONTINUE
      ICASL8='QNSC'
      GOTO705
C
  401 CONTINUE
      ICASL8='DMEA'
      GOTO706
C
  402 CONTINUE
      ICASL8='DMDM'
      GOTO706
C
  403 CONTINUE
      ICASL8='DMED'
      GOTO706
C
  404 CONTINUE
      ICASL8='DTRM'
      GOTO707
C
  405 CONTINUE
      ICASL8='DWNM'
      GOTO707
C
  406 CONTINUE
      ICASL8='DGEO'
      GOTO707
C
  407 CONTINUE
      ICASL8='DHAR'
      GOTO707
C
  408 CONTINUE
      ICASL8='DHDL'
      GOTO707
C
  409 CONTINUE
      ICASL8='DBIW'
      GOTO707
C
  420 CONTINUE
      ICASL8='DSD '
      GOTO706
C
  421 CONTINUE
      ICASL8='DSD '
      GOTO707
C
  422 CONTINUE
      ICASL8='DVAR'
      GOTO706
C
  523 CONTINUE
      ICASL8='DAAD'
      GOTO708
C
  423 CONTINUE
      ICASL8='DAAD'
      GOTO706
C
  524 CONTINUE
      ICASL8='MAAD'
      GOTO708
C
  424 CONTINUE
      ICASL8='DMAD'
      GOTO706
C
  425 CONTINUE
      ICASL8='DIQR'
      GOTO707
C
  526 CONTINUE
      ICASL8='DWSD'
      GOTO708
C
  426 CONTINUE
      ICASL8='DWSD'
      GOTO707
C
  427 CONTINUE
      ICASL8='DWVA'
      GOTO707
C
  428 CONTINUE
      ICASL8='DBIM'
      GOTO707
C
  429 CONTINUE
      ICASL8='DBIS'
      GOTO707
C
  430 CONTINUE
      ICASL8='DPBN'
      GOTO708
C
  531 CONTINUE
      ICASL8='DGSD'
      GOTO708
C
  431 CONTINUE
      ICASL8='DGSD'
      GOTO707
C
  432 CONTINUE
      ICASL8='DRAN'
      GOTO706
C
  433 CONTINUE
      ICASL8='DMDR'
      GOTO706
C
  434 CONTINUE
      ICASL8='DQUA'
      GOTO706
C
  435 CONTINUE
      ICASL8='DSKE'
      GOTO706
C
  436 CONTINUE
      ICASL8='DKUR'
      GOTO706
C
  437 CONTINUE
      ICASL8='DRSD'
      GOTO707
C
  638 CONTINUE
      ICASL8='DSDM'
      GOTO709
C
  538 CONTINUE
      ICASL8='DSDM'
      GOTO708
C
  438 CONTINUE
      ICASL8='DSDM'
      GOTO707
C
  439 CONTINUE
      ICASL8='DRVA'
      GOTO707
C
  640 CONTINUE
      ICASL8='DVAM'
      GOTO709
C
  540 CONTINUE
      ICASL8='DVAM'
      GOTO708
C
  440 CONTINUE
      ICASL8='DVAM'
      GOTO707
C
  441 CONTINUE
      ICASL8='DMIN'
      GOTO706
C
  442 CONTINUE
      ICASL8='DMAX'
      GOTO706
C
  443 CONTINUE
      ICASL8='DEXT'
      GOTO706
C
  544 CONTINUE
      ICASL8='DCVA'
      GOTO708
C
  444 CONTINUE
      ICASL8='DCVA'
      GOTO707
C
  545 CONTINUE
      ICASL8='DSN'
      GOTO706
C
  445 CONTINUE
      ICASL8='DSN'
      GOTO707
C
  546 CONTINUE
      ICASL8='DQN'
      GOTO706
C
  446 CONTINUE
      ICASL8='DQN'
      GOTO707
C
  451 CONTINUE
      ICASL8='DSUM'
      GOTO706
C
  452 CONTINUE
      ICASL8='DCOU'
      GOTO706
C
  480 CONTINUE
      ICASL8='KTAU'
      GOTO706
C
  481 CONTINUE
      ICASL8='KTAU'
      GOTO705
C
  486 CONTINUE
      ICASL8='REPE'
      GOTO706
C
  487 CONTINUE
      ICASL8='REPE'
      GOTO705
C
  488 CONTINUE
      ICASL8='REPE'
      GOTO704
C
  491 CONTINUE
      ICASL8='REPR'
      GOTO706
C
  492 CONTINUE
      ICASL8='REPR'
      GOTO705
C
  493 CONTINUE
      ICASL8='REPR'
      GOTO704
C
  494 CONTINUE
      ICASL8='RATI'
      GOTO704
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               **  DEFINE ILOCV.                                  **
C               *****************************************************
C
  704 CONTINUE
      ILOCV=4
      GOTO720
C
  705 CONTINUE
      ILOCV=5
      GOTO720
C
  706 CONTINUE
      ILOCV=6
      GOTO720
C
  707 CONTINUE
      ILOCV=7
      GOTO720
C
  708 CONTINUE
      ILOCV=8
      GOTO720
C
  709 CONTINUE
      ILOCV=9
      GOTO720
C
  720 CONTINUE
      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
  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           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='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'
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
CCCCC DATA 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
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C***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'
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      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 = -0.30*ALOG(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
C
 30   N = 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 (ALOG(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  (ALOG(R), CARG(1+Z))
C                 = CMPLX  (0.5*ALOG(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'
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      EXTERNAL CARG
      DATA SQEPS /0.0/
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,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  REFERENCE: GROSS, HECKERT, LECHNER, AND SIMIU (1995).  "EXTREME
C             WIND ESTIMATES BY THE CONDITIONAL MEAN EXCEEDANCE
C             PROCEDURE", NISTIT 5531.
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
      NM1=N-1
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
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
      RETURN
      END
      SUBROUTINE CMPSTA(
     1TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,
     1MAXNXT,NS2,NSZ,NUMV2,ICASPL,
     1ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1IQUAME,IQUASE,
     1RIGHT,
     1ISUBRO,IBUGG3,IERROR)
C
C     PURPOSE--COMPUTE THE VALUE OF ONE OF 90+ STATISTICS.  THIS
C              IS A COMMON ROUTINE CALLED BY:
C                1) DPSTAC  = LET A = <STAT>
C                2) DPSP2   = <STAT> STATISTIC PLOT
C                3) DPCRP2  = CROSS TABULATE <STAT> PLOT
C                4) DPBLO2  = <STAT> BLOCK PLOT
C                5) DPJBS2  = BOOTSTRAP/JACKNIFE <STAT> PLOT
C                6) DPDEX2  = DEX <STAT> PLOT
C                7) DPINF2  = <STAT> INFLUENCE CURVE
C                8) DPTAB2  = TABULATE <MEAN>
C                9) DPCRT2  = CROSS TABULATE <STAT>
C               10) MATAR3  = MATRIX <COLUMN/ROW> <STAT>
C               11) DPMATC  = LET ... = CROSS TABULATE <STAT>
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              FOLLOWING STATISTICS REQUIRE ONE RESPONSE VARIABLE:
C                 NUMBER (OR COUNT OR SIZE)
C                 SUM
C                 PRODUCT
C                 INTEGRAL
C
C                 MIDRANGE
C                 MEAN (OR AVERAGE)
C                 MIDMEAN
C                 MEDIAN
C                 TRIMMED MEAN
C                 WINSORIZED MEAN
C                 BIWEIGHT LOCATION
C                 GEOMETRIC MEAN
C                 HODGES-LEHMAN
C
C                 SD (OR STANDARD DEVIATION)
C                 VARIANCE
C                 AERAGE ABSOLUTE DEVIATION (AAD)
C                 MEDIAN ABSOLUTE DEVIATION (MAD)
C                 SN
C                 QN
C                 GEOMETRIC STANDARD DEVIATION
C                 BIWEIGHT SCALE
C                 WINSORIZED VARIANCE
C                 WINSORIZED SD
C                 BIWEIGHT MIDVARIANCE
C                 PERCENTAGE BEND MIDVARIANCE
C                 COEFFICIENT OF VARIATION
C                 RELATIVE SD
C                 SD OF THE MEAN
C                 RELATIVE VARIANCE
C                 VARIANCE OF THE MEAN
C                 TRIMMED MEAN STANDARD ERROR
C                 RANGE
C
C                 SKEWNESS
C                 KURTOSIS
C                 AUTOCORRELATION
C                 AUTOCOVARIANCE
C                 LOWER HINGE
C                 UPPER HINGE
C                 LOWER QUARTILE
C                 UPPER QUARTILE
C                 INTERQUARTILE RANGE
C                 MINIMUM
C                 MAXIMUM
C                 EXTREME
C                 FIRST/SECOND/THIRD/FOURTH/FIFTH/SIXTH/SEVENTH/
C                 EIGHTH/NINTH DECILE
C                 PERCENTILE
C                 QUANTILE
C                 QUANTILE STANDARD ERROR
C                 SINE FREQUENCY
C                 SINE AMPLITUDE
C                 TAGUCHI SIGNAL-TO-NOISE (SN+, SN-, SN0, SN00)
C                 CP
C                 CPK
C                 CNPK
C                 CPM
C                 CC
C                 CPL
C                 CPU
C                 PERCENT DEFECTIVE
C                 EXPECTED LOSS
C                 NORMAL PPCC
C                 COMMON DIGITS
C                 NUMBER OF DIGITS
C
C                 FOLLOWING STATISTICS REQUIRE TWO RESPONSE VARIABLES:
C                 COVARIANCE
C                 RANK COVARIANCE
C                 CORRELATION
C                 RANK CORRELATION
C                 COMOVEMENT
C                 RANK COMOVEMENT
C                 WINSORIZED COVARIANCE
C                 WINSORIZED CORRELATION
C                 BIWEIGHT MIDCOVARIANCE
C                 BIWEIGHT MIDCORRELATION
C                 PERCENTAGE BEND CORRELATION
C                 KENDELLS TAU
C                 RATIO (= SUM1/SUM2)
C
C                 FOLLOWING STATISTICS REQUIRE ONE RESPONSE
C                 AND ONE GROUP OR WEIGHT VARIABLE:
C                 LINEAR INTERCEPT
C                 LINEAR SLOPE
C                 LINEAR RESSD
C                 LINEAR CORRELATION
C                 REPEATABILITY SD
C                 REPRODUCABILITY SD
C                 WEIGHTED MEAN
C                 WEIGHTED MEDIAN (NOT YET IMPLEMENTED)
C                 WEIGHTED STANDARD DEVIATION
C                 WEIGHTED VARIANCE
C                 WEIGHTED TRIMMED MEAN
C
C                 FOLLOWING STATISTICS COMPUTE DIFFERENCE IN
C                 STATISTIC FOR TWO RESPONSE VARIABLES (USED FOR
C                 LOCATION AND SCALE STATISTICS):
C
C                 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
C                 SCALE:
C                 DIFFERENCE OF STANDARD DEVIATIONS
C                 DIFFERENCE OF VARIANCES
C                 DIFFERENCE OF AAD
C                 DIFFERENCE OF MAD
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 COEFFICIENT OF VARIATION
C
C                 MISCELLANEOUS:
C                 DIFFERENCE OF COUNTS
C                 DIFFERENCE OF SUMS
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     REFERENCE--ASTM MANUAL STP-15D, PAGES 78-84, 100-105
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
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      EXTERNAL SUM
      EXTERNAL RANGE
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 IWRITE
      CHARACTER*4 IFLAG
      CHARACTER*4 IQUAME
      CHARACTER*4 IQUASE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION TEMP(*)
      DIMENSION TEMPZ(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
      DIMENSION XTEMP3(*)
C
      INTEGER ITEMP1(*)
      INTEGER ITEMP2(*)
      INTEGER ITEMP3(*)
      INTEGER ITEMP4(*)
      INTEGER ITEMP5(*)
      INTEGER ITEMP6(*)
C
      EXTERNAL REPEAT
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='CMPS'
      ISUBN2='TA  '
C
      IWRITE='OFF'
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(NS2.GE.1)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN CMPSTA--THE NUMBER OF OBSERVATIONS MUST ',
     1       '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
   39 CONTINUE
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'PSTA')GOTO90
      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,ICASPL
   72 FORMAT('NS2,ICASPL = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO73I=1,NS2
      WRITE(ICOUT,74)I,TEMP(I),TEMPZ(I)
   74 FORMAT('I, TEMP(I),TEMPZ(I) = ',I8,2F15.7)
      CALL DPWRST('XXX','BUG ')
   73 CONTINUE
   90 CONTINUE
C
      IF(ICASPL.EQ.'NUMB')GOTO11310
      IF(ICASPL.EQ.'COUN')GOTO11310
      IF(ICASPL.EQ.'SIZE')GOTO11310
      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.'MIDM')GOTO11370
      IF(ICASPL.EQ.'MEDI')GOTO11380
      IF(ICASPL.EQ.'SD')GOTO11390
      IF(ICASPL.EQ.'VARI')GOTO11400
      IF(ICASPL.EQ.'RESD')GOTO11410
      IF(ICASPL.EQ.'REVA')GOTO11415
      IF(ICASPL.EQ.'CVAR')GOTO11418
      IF(ICASPL.EQ.'RANG')GOTO11420
      IF(ICASPL.EQ.'MINI')GOTO11430
      IF(ICASPL.EQ.'MAXI')GOTO11440
      IF(ICASPL.EQ.'SKEW')GOTO11450
      IF(ICASPL.EQ.'KURT')GOTO11460
      IF(ICASPL.EQ.'AUCR')GOTO11470
      IF(ICASPL.EQ.'COVA')GOTO11480
      IF(ICASPL.EQ.'CORR')GOTO11490
      IF(ICASPL.EQ.'RACR')GOTO11500
      IF(ICASPL.EQ.'SDME')GOTO11510
      IF(ICASPL.EQ.'AUCV')GOTO11520
      IF(ICASPL.EQ.'RACV')GOTO11530
      IF(ICASPL.EQ.'COMO')GOTO31480
      IF(ICASPL.EQ.'RACM')GOTO31530
      IF(ICASPL.EQ.'KTAU')GOTO31540
      IF(ICASPL.EQ.'RATI')GOTO31550
C
      IF(ICASPL.EQ.'LOWH')GOTO11540
      IF(ICASPL.EQ.'UPPH')GOTO11550
      IF(ICASPL.EQ.'LOWQ')GOTO11560
      IF(ICASPL.EQ.'UPPQ')GOTO11570
C
      IF(ICASPL.EQ.'TRIM')GOTO11580
      IF(ICASPL.EQ.'WINM')GOTO11590
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.'WEMD')GOTO11630
      IF(ICASPL.EQ.'WESD')GOTO11640
      IF(ICASPL.EQ.'WEVA')GOTO11650
      IF(ICASPL.EQ.'WETM')GOTO11660
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.'LISL')GOTO11740
      IF(ICASPL.EQ.'LIRE')GOTO11750
      IF(ICASPL.EQ.'LICO')GOTO11760
      IF(ICASPL.EQ.'REPE')GOTO11770
      IF(ICASPL.EQ.'REPR')GOTO11780
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.'PEDE')GOTO11900
      IF(ICASPL.EQ.'EXLO')GOTO11900
C
      IF(ICASPL.EQ.'NOPP')GOTO11910
C
      IF(ICASPL.EQ.'EXTR')GOTO11920
      IF(ICASPL.EQ.'AAD ')GOTO11930
      IF(ICASPL.EQ.'MAD ')GOTO11940
      IF(ICASPL.EQ.'GEME')GOTO11950
      IF(ICASPL.EQ.'GESD')GOTO11960
      IF(ICASPL.EQ.'HAME')GOTO11970
      IF(ICASPL.EQ.'IQRA')GOTO11980
      IF(ICASPL.EQ.'BILO')GOTO11990
      IF(ICASPL.EQ.'BISC')GOTO12000
      IF(ICASPL.EQ.'WIVA')GOTO12010
      IF(ICASPL.EQ.'WISD')GOTO12030
      IF(ICASPL.EQ.'WICV')GOTO12050
      IF(ICASPL.EQ.'WICR')GOTO12070
      IF(ICASPL.EQ.'BIMV')GOTO12090
      IF(ICASPL.EQ.'BIMC')GOTO12100
      IF(ICASPL.EQ.'PBMV')GOTO12110
      IF(ICASPL.EQ.'PBCR')GOTO12115
      IF(ICASPL.EQ.'HLEH')GOTO12120
      IF(ICASPL.EQ.'QUAN')GOTO12130
      IF(ICASPL.EQ.'QUSE')GOTO12140
      IF(ICASPL.EQ.'TMSE')GOTO12150
      IF(ICASPL.EQ.'BICR')GOTO12160
      IF(ICASPL.EQ.'PBCR')GOTO12170
      IF(ICASPL.EQ.'CDIG')GOTO12172
      IF(ICASPL.EQ.'NCDI')GOTO12174
      IF(ICASPL.EQ.'SNSC')GOTO12176
      IF(ICASPL.EQ.'QNSC')GOTO12178
C
      IF(ICASPL.EQ.'DMEA')GOTO12180
      IF(ICASPL.EQ.'DMDM')GOTO12190
      IF(ICASPL.EQ.'DMED')GOTO12200
      IF(ICASPL.EQ.'DTRM')GOTO12210
      IF(ICASPL.EQ.'DWNM')GOTO12220
      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.'DVAR')GOTO12280
      IF(ICASPL.EQ.'DAAD')GOTO12290
      IF(ICASPL.EQ.'DMAD')GOTO12300
      IF(ICASPL.EQ.'DIQR')GOTO12310
      IF(ICASPL.EQ.'DWSD')GOTO12320
      IF(ICASPL.EQ.'DWVA')GOTO12330
      IF(ICASPL.EQ.'DBIM')GOTO12340
      IF(ICASPL.EQ.'DBIS')GOTO12350
      IF(ICASPL.EQ.'DPBN')GOTO12360
      IF(ICASPL.EQ.'DGSD')GOTO12370
      IF(ICASPL.EQ.'DRAN')GOTO12380
      IF(ICASPL.EQ.'DMDR')GOTO12390
      IF(ICASPL.EQ.'DQUA')GOTO12400
      IF(ICASPL.EQ.'DSKE')GOTO12410
      IF(ICASPL.EQ.'DKUR')GOTO12420
      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.'DSN')GOTO12520
      IF(ICASPL.EQ.'DQN')GOTO12530
C
80000 CONTINUE
      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
11320 CONTINUE
      CALL SUM(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
11380 CONTINUE
      CALL MEDIAN(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR)
      GOTO79000
11390 CONTINUE
      CALL SD(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
11400 CONTINUE
      CALL VAR(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      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
      GOTO79000
11420 CONTINUE
      CALL RANGE(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      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
11460 CONTINUE
      CALL STMOM4(TEMP,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      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)
      GOTO79000
11500 CONTINUE
      CALL RANKCR(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT,
     1IBUGG3,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,MAXNXT,RIGHT,
     1IBUGG3,IERROR)
      GOTO79000
31530 CONTINUE
      CALL RANKCM(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT,
     1IBUGG3,IERROR)
      GOTO79000
31540 CONTINUE
      CALL KENTAU(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT,
     1IBUGG3,IERROR)
      GOTO79000
31550 CONTINUE
      CALL SUM(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL SUM(TEMPZ,NS2,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=0.0
      IF(RIGH2.NE.0.0)RIGHT=RIGH1/RIGH2
      GOTO79000
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
C
11580 CONTINUE
C
      IHP='P1  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP1=VALUE(ILOCP)
C
      IHP='P2  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP2=VALUE(ILOCP)
C
      IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO11589
      IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO11589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11581)
11581 FORMAT('***** ERROR IN CMPSTA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11582)
11582 FORMAT('THE PROPORTION TO BE TRIMMED BELOW AND ABOVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11583)
11583 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11584)PROP1
11584 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11585)PROP2
11585 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11586)
11586 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11587)
11587 FORMAT('      LET P1 = 25')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11588)
11588 FORMAT('      LET P2 = 10')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
11589 CONTINUE
      CALL TRIMME(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,RIGHT,
     1IBUGG3,IERROR)
      GOTO79000
C
11590 CONTINUE
      IHP='P1  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP1=VALUE(ILOCP)
C
      IHP='P2  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP2=VALUE(ILOCP)
C
      IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO11599
      IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO11599
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11591)
11591 FORMAT('***** ERROR IN CMPSTA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11592)
11592 FORMAT('THE PROPORTION TO BE WINSORIZED BELOW AND ABOVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11593)
11593 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11594)PROP1
11594 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11595)PROP2
11595 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11596)
11596 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11597)
11597 FORMAT('      LET P1 = 25')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11598)
11598 FORMAT('      LET P2 = 10')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
11599 CONTINUE
      CALL WINDME(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,RIGHT,
     1IBUGG3,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
      IHP='P100'
      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
      P100=VALUE(ILOCP)
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
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
11660 CONTINUE
C
      IHP='P1  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP1=VALUE(ILOCP)
      IF(PROP1.GE.0.0 .AND. PROP1.LT.1.0)PROP1=PROP1/100.0
C
      IHP='P2  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP2=VALUE(ILOCP)
      IF(PROP2.GE.0.0 .AND. PROP2.LT.1.0)PROP2=PROP2/100.0
C
      IF(PROP1.LT.0.0 .OR. PROP1.GT.100.0 .OR.
     1   PROP2.LT.0.0 .OR. PROP2.GT.100.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11661)
11661   FORMAT('***** ERROR IN THE WEIGHTED TRIMMED MEAN--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11662)
11662   FORMAT('THE PROPORTION TO BE TRIMMED BELOW AND ABOVE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11663)
11663   FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11664)PROP1
11664   FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11665)PROP2
11665   FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11666)
11666   FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11667)
11667   FORMAT('      LET P1 = 25')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11668)
11668   FORMAT('      LET P2 = 10')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      CALL WETRME(TEMP,TEMPZ,NS2,PROP1,PROP2,IWRITE,XTEMP1,XTEMP2,
     1            MAXNXT,RIGHT,
     1            IBUGG3,ISUBRO,IERROR)
      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
11740 CONTINUE
      CALL LINFIT(TEMP,TEMPZ,NS2,
     1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1ISUBRO,IBUGG3,IERROR)
      RIGHT=BETA
      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 REPEAT(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
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
      ENDIF
C
      IF(ICASPL.EQ.'CPK')THEN
         CALL CPK(TEMP,NS2,ENGLSL,ENGUSL,IWRITE,
     1   RIGHT,XLCL,XUCL,IBUGG3,IERROR)
         GOTO79000
      ENDIF
C
      IF(ICASPL.EQ.'CNPK')THEN
         CALL CNPK(TEMP,NS2,TEMP,NS2,ENGLSL,ENGUSL,IWRITE,
     1   RIGHT,IBUGG3,IERROR)
         GOTO79000
      ENDIF
C
      IF(ICASPL.EQ.'CPL')THEN
         CALL CPL(TEMP,NS2,ENGLSL,ENGUSL,IWRITE,
     1   RIGHT,XLCL,XUCL,IBUGG3,IERROR)
         GOTO79000
      ENDIF
C
      IF(ICASPL.EQ.'CPU')THEN
         CALL CPU(TEMP,NS2,ENGLSL,ENGUSL,IWRITE,
     1   RIGHT,XLCL,XUCL,IBUGG3,IERROR)
         GOTO79000
      ENDIF
C
      IF(ICASPL.EQ.'CPM')THEN
        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)
         CALL CPM(TEMP,NS2,ENGLSL,ENGUSL,TARGET,IWRITE,
     1   RIGHT,XLCL,XUCL,IBUGG3,IERROR)
         GOTO79000
      ENDIF
C
      IF(ICASPL.EQ.'CC')THEN
        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)
         CALL CC(TEMP,NS2,ENGLSL,ENGUSL,TARGET,IWRITE,
     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
11910 CONTINUE
      CALL NORPPC(TEMP,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT,
     1IBUGG3,IERROR)
      GOTO79000
C
11920 CONTINUE
      CALL MINIM(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL MAXIM(TEMP,NS2,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGH1=ABS(RIGH1)
      RIGH2=ABS(RIGH2)
      RIGHT=RIGH1
      IF(RIGH2.GT.RIGH1)RIGHT=RIGH2
      GOTO79000
11930 CONTINUE
      CALL AAD(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR)
      GOTO79000
11940 CONTINUE
      CALL MAD(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,IBUGG3,IERROR)
      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
      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
      IHP='P1  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP1=VALUE(ILOCP)
C
      IHP='P2  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP2=VALUE(ILOCP)
C
      IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO12029
      IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO12029
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12021)
12021 FORMAT('***** ERROR IN CMPSTA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12022)
12022 FORMAT('THE PROPORTION TO BE WINSORIZED BELOW AND ABOVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12023)
12023 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12024)PROP1
12024 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12025)PROP2
12025 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12026)
12026 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12027)
12027 FORMAT('      LET P1 = 25')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12028)
12028 FORMAT('      LET P2 = 10')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
12029 CONTINUE
      CALL WINSOR(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,XTEMP2,
     1IBUGG3,IERROR)
      CALL VAR(XTEMP2,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
C
12030 CONTINUE
      IHP='P1  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP1=VALUE(ILOCP)
C
      IHP='P2  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP2=VALUE(ILOCP)
C
      IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO12049
      IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO12049
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12041)
12041 FORMAT('***** ERROR IN CMPSTA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12042)
12042 FORMAT('THE PROPORTION TO BE WINSORIZED BELOW AND ABOVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12043)
12043 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12044)PROP1
12044 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12045)PROP2
12045 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12046)
12046 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12047)
12047 FORMAT('      LET P1 = 25')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12048)
12048 FORMAT('      LET P2 = 10')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
12049 CONTINUE
      CALL WINSOR(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,XTEMP2,
     1IBUGG3,IERROR)
      CALL SD(XTEMP2,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
C
12050 CONTINUE
      IHP='P1  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP1=VALUE(ILOCP)
C
      IHP='P2  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP2=VALUE(ILOCP)
C
      IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO12069
      IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO12069
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12061)
12061 FORMAT('***** ERROR IN CMPSTA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12062)
12062 FORMAT('THE PROPORTION TO BE WINSORIZED BELOW AND ABOVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12063)
12063 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12064)PROP1
12064 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12065)PROP2
12065 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12066)
12066 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12067)
12067 FORMAT('      LET P1 = 25')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12068)
12068 FORMAT('      LET P2 = 10')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
12069 CONTINUE
      CALL WINSOR(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,XTEMP2,
     1IBUGG3,IERROR)
      DO12052I=1,NS2
        TEMP(I)=XTEMP2(I)
12052 CONTINUE
      CALL WINSOR(TEMPZ,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,XTEMP2,
     1IBUGG3,IERROR)
      DO12054I=1,NS2
        TEMPZ(I)=XTEMP2(I)
12054 CONTINUE
      CALL COV(TEMP,TEMPZ,NS2,IWRITE,RIGHT,IBUGG3,IERROR)
      GOTO79000
C
12070 CONTINUE
      IHP='P1  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP1=VALUE(ILOCP)
C
      IHP='P2  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP2=VALUE(ILOCP)
C
      IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO12089
      IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO12089
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12081)
12081 FORMAT('***** ERROR IN CMPSTA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12082)
12082 FORMAT('THE PROPORTION TO BE WINSORIZED BELOW AND ABOVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12083)
12083 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12084)PROP1
12084 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12085)PROP2
12085 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12086)
12086 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12087)
12087 FORMAT('      LET P1 = 25')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12088)
12088 FORMAT('      LET P2 = 10')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
12089 CONTINUE
      CALL WINSOR(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,XTEMP2,
     1IBUGG3,IERROR)
      DO12072I=1,NS2
        TEMP(I)=XTEMP2(I)
12072 CONTINUE
      CALL WINSOR(TEMPZ,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,XTEMP2,
     1IBUGG3,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
C
      IHP='BETA'
      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
        BETA=0.1
      ELSE
        BETA=VALUE(ILOCP)
      ENDIF
C
      CALL PBNMDV(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGHT,BETA,
     1IBUGG3,IERROR)
      GOTO79000
C
12115 CONTINUE
C
      IHP='BETA'
      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
        BETA=0.1
      ELSE
        BETA=VALUE(ILOCP)
      ENDIF
C
      CALL PBNCOR(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,
     1RIGHT,BETA,
     1IBUGG3,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
      IHP='XQ  '
      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
      XQ=VALUE(ILOCP)
C
      CALL QUANT(XQ,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,
     1IQUAME,
     1RIGHT,IBUGG3,IERROR)
      GOTO79000
C
12140 CONTINUE
      IHP='XQ  '
      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
      XQ=VALUE(ILOCP)
C
      CALL QUANSE(XQ,TEMP,NS2,IWRITE,XTEMP1,MAXNXT,
     1IQUASE,
     1RIGHT,IBUGG3,IERROR)
      GOTO79000
C
12150 CONTINUE
      IHP='P1  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP1=VALUE(ILOCP)
C
      IHP='P2  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP2=VALUE(ILOCP)
C
      IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO12159
      IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO12159
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12151)
12151 FORMAT('***** ERROR IN CMPSTA (TRIMMED MEAN STANDARD ERROR)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12152)
12152 FORMAT('THE PROPORTION TO BE TRIMMED BELOW AND ABOVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12153)
12153 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12154)PROP1
12154 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12155)PROP2
12155 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12156)
12156 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12157)
12157 FORMAT('      LET P1 = 25')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12158)
12158 FORMAT('      LET P2 = 10')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
12159 CONTINUE
      CALL TRIMSE(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,XTEMP2,MAXNXT,
     1RIGHT,IBUGG3,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
12170 CONTINUE
C
      IHP='BETA'
      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
        BETA=0.1
      ELSE
        BETA=VALUE(ILOCP)
      ENDIF
C
      CALL PBNCOR(TEMP,TEMPZ,NS2,IWRITE,XTEMP1,XTEMP2,MAXNXT,RIGHT,
     1BETA,
     1IBUGG3,IERROR)
      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
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
      IHP='P1  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP1=VALUE(ILOCP)
C
      IHP='P2  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP2=VALUE(ILOCP)
C
      IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO12199
      IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO12199
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12191)
12191 FORMAT('***** ERROR IN CMPSTA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12192)
12192 FORMAT('THE PROPORTION TO BE TRIMMED BELOW AND ABOVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12193)
12193 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12194)PROP1
12194 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12195)PROP2
12195 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12196)
12196 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12197)
12197 FORMAT('      LET P1 = 25')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12198)
12198 FORMAT('      LET P2 = 10')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
12199 CONTINUE
      CALL TRIMME(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,RIGH1,
     1IBUGG3,IERROR)
      CALL TRIMME(TEMPZ,NSZ,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,RIGH2,
     1IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12220 CONTINUE
      IHP='P1  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP1=VALUE(ILOCP)
C
      IHP='P2  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP2=VALUE(ILOCP)
C
      IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO12299
      IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO12299
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12291)
12291 FORMAT('***** ERROR IN CMPSTA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12292)
12292 FORMAT('THE PROPORTION TO BE WINSORIZED BELOW AND ABOVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12293)
12293 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12294)PROP1
12294 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12295)PROP2
12295 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12296)
12296 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12297)
12297 FORMAT('      LET P1 = 25')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12298)
12298 FORMAT('      LET P2 = 10')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
12299 CONTINUE
      CALL WINDME(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,RIGH1,
     1IBUGG3,IERROR)
      CALL WINDME(TEMPZ,NSZ,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,RIGH2,
     1IBUGG3,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
12280 CONTINUE
      CALL VAR(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL VAR(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12290 CONTINUE
      CALL AAD(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL AAD(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12300 CONTINUE
      CALL MAD(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,IBUGG3,IERROR)
      CALL MAD(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,IBUGG3,IERROR)
      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
      CALL LOWQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH5,IBUGG3,IERROR)
      CALL UPPQUA(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH6,IBUGG3,IERROR)
      RIGH2=RIGH6-RIGH5
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12320 CONTINUE
      IHP='P1  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP1=VALUE(ILOCP)
C
      IHP='P2  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP2=VALUE(ILOCP)
C
      IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO12229
      IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO12229
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12221)
12221 FORMAT('***** ERROR IN CMPSTA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12222)
12222 FORMAT('THE PROPORTION TO BE WINSORIZED BELOW AND ABOVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12223)
12223 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12224)PROP1
12224 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12225)PROP2
12225 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12226)
12226 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12227)
12227 FORMAT('      LET P1 = 25')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12228)
12228 FORMAT('      LET P2 = 10')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
12229 CONTINUE
      CALL WINSOR(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,XTEMP2,
     1IBUGG3,IERROR)
      CALL SD(XTEMP2,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL WINSOR(TEMPZ,NSZ,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,XTEMP2,
     1IBUGG3,IERROR)
      CALL SD(XTEMP2,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      GOTO79000
C
12330 CONTINUE
      IHP='P1  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP1=VALUE(ILOCP)
C
      IHP='P2  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP2=VALUE(ILOCP)
C
      IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO12329
      IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO12329
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12321)
12321 FORMAT('***** ERROR IN CMPSTA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12322)
12322 FORMAT('THE PROPORTION TO BE WINSORIZED BELOW AND ABOVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12323)
12323 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12324)PROP1
12324 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12325)PROP2
12325 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12326)
12326 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12327)
12327 FORMAT('      LET P1 = 25')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12328)
12328 FORMAT('      LET P2 = 10')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
12329 CONTINUE
      CALL WINSOR(TEMP,NS2,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,XTEMP2,
     1IBUGG3,IERROR)
      CALL VAR(XTEMP2,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL WINSOR(TEMPZ,NSZ,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,XTEMP2,
     1IBUGG3,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
      IHP='BETA'
      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
        BETA=0.1
      ELSE
        BETA=VALUE(ILOCP)
      ENDIF
C
      CALL PBNMDV(TEMP,NS2,IWRITE,XTEMP1,MAXNXT,RIGH1,BETA,
     1IBUGG3,IERROR)
      CALL PBNMDV(TEMPZ,NSZ,IWRITE,XTEMP1,MAXNXT,RIGH2,BETA,
     1IBUGG3,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 RANGE(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL RANGE(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
      IHP='XQ  '
      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
      XQ=VALUE(ILOCP)
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
12410 CONTINUE
      CALL STMOM3(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL STMOM3(TEMPZ,NSZ,IWRITE,RIGH2,IBUGG3,IERROR)
      RIGHT=RIGH1-RIGH2
      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
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 SUM(TEMP,NS2,IWRITE,RIGH1,IBUGG3,IERROR)
      CALL SUM(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
C     ---------------------------
C
79000 CONTINUE
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'PSTA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF CMPSTA--')
      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 ')
 9090 CONTINUE
C
      RETURN
      END
