      SUBROUTINE AUTOCO(X,N,IWRITE,XAUTOC)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT AUTOCO
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SAMPLE AUTOCORRELATION COEFFICIENT 
C              OF THE DATA IN THE INPUT VECTOR X. 
C              THE SAMPLE AUTOCORRELATION COEFFICIENT =  THE CORRELATION
C              BETWEEN X(I) AND X(I+1) OVER THE ENTIRE SAMPLE.
C              THE AUTOCORRELATION COEFFICIENT COEFFICIENT WILL BE A
C              SINGLE PRECISION VALUE BETWEEN -1.0 AND 1.0
C              (INCLUSIVELY). 
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                                (UNSORTED) OBSERVATIONS.
C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR X. 
C                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SAMPLE AUTOCORRELATION COEFFICIENT
C                                AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SAMPLE AUTOCORRELATION COEFFICIENT
C                                AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--XAUTOC = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE AUTOCORRELATION
C                                COEFFICIENT.
C                                THIS SINGLE PRECISION VALUE
C                                WILL BE BETWEEN -1.0 AND 1.0
C                                (INCLUSIVELY).
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE AUTOCORRELATION COEFFICIENT. 
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--JENKINS AND WATTS, SPECTRAL ANALYSIS AND
C                 ITS APPLICATIONS, 1968, PAGES 5, 182.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION (714)
C                 NATIONAL BUREAU OF STANDARDS
C                 GAITHERSBURG, MD  20899
C                 PHONE:  301-921-3651
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      AN=N
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      XAUTOC=0.0
      GOTO201
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XAUTOC=0.0
      GOTO201
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE AUTOCO SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 AUTOCO SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE AUTOCO SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      XBAR=0.0
      DO100I=1,N
      XBAR=XBAR+X(I)
  100 CONTINUE
      XBAR1=XBAR-X(N)
      XBAR1=XBAR1/(AN-1.0)
      XBAR2=XBAR-X(1)
      XBAR2=XBAR2/(AN-1.0)
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      NM1=N-1
      DO200I=1,NM1
      IP1=I+1
      SUM1=SUM1+(X(I)-XBAR1)*(X(IP1)-XBAR2)
      SUM2=SUM2+(X(I)-XBAR1)**2
      SUM3=SUM3+(X(IP1)-XBAR2)**2
  200 CONTINUE
      XAUTOC=SUM1/(SQRT(SUM2*SUM3))
C
  201 IF(IWRITE.EQ.0)RETURN
      WRITE(IPR,999)
      WRITE(IPR,205)N,XAUTOC
  205 FORMAT(1H ,53HTHE LINEAR AUTOCORRELATION COEFFICIENT OF THE SET OF
     1 ,I6,17H OBSERVATIONS IS ,F14.6)
  999 FORMAT(1H )
      RETURN
      END 
      SUBROUTINE BETRAN(N,ALPHA,BETA,ISEED,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT BETRAN
C     ***** STILL NEEDS ALGORITHM WORK ******
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE BETA DISTRIBUTION
C          WITH SINGLE PRECISION SHAPE
C          PARAMETERS = ALPHA AND BETA.
C              THE PROTOTYPE BETA DISTRIBUTION USED
C              HEREIN HAS MEAN = ALPHA/(ALPHA+BETA)
C              AND STANDARD DEVIATION =
C              SQRT((ALPHA*BETA) / ((ALPHA+BETA)**2)*(ALPHA+BETA+1))
C              THIS DISTRIBUTION IS DEFINED FOR ALL X
C              BETWEEN 0.0 (INCLUSIVELY) AND 1.0 (INCLUSIVELY).
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = (1/CONSTANT) * X**(ALPHA-1) * (1.0-X)**(BETA-1)
C              WHERE THE CONSTANT = THE BETA FUNCTION EVALUATED
C              AT THE VALUES ALPHA AND BETA.
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
C                                OF RANDOM NUMBERS TO BE
C                                GENERATED.
C                     --ALPHA  = THE SINGLE PRECISION VALUE OF THE
C                                FIRST  SHAPE PARAMETER.
C                                ALPHA SHOULD BE GREATER THAN
C                                OR EQUAL TO 1.0.
C                     --BETA   = THE SINGLE PRECISION VALUE OF THE
C                                SECOND SHAPE PARAMETER.
C                                BETA  SHOULD BE GREATER THAN
C                                OR EQUAL TO 1.0.
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 BETA DISTRIBUTION
C             WITH SHAPE PARAMETER VALUES = ALPHA AND BETA.
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                 --ALPHA SHOULD BE GREATER THAN
C                   OR EQUAL TO 1.0.
C                 --BETA  SHOULD BE GREATER THAN
C                   OR EQUAL TO 1.0.
C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN, NORRAN.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, EXP.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--GREENWOOD, 'A FAST GENERATOR FOR
C                 BETA-DISTRIBUTED RANDOM VARIABLES',
C                 COMPSTAT 1974, PROCEEDINGS IN
C                 COMPUTATIONAL STATISTICS, VIENNA,
C                 SEPTEMBER, 1974, PAGES 19-27.
C               --TOCHER, THE ART OF SIMULATION,
C                 1963, PAGES 24-27.
C               --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS,
C                 1964, PAGES 36-37.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--2, 1970, PAGES 37-56.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGES 30-35.
C               --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 952.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLARITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82.3
C     ORIGINAL VERSION--NOVEMBER  1975.
C     UPDATED         --FEBRUARY  1976.
C     UPDATED         --JUNE      1978.
C     UPDATED         --DECEMBER  1981.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
C
      DIMENSION U(10)
C
C---------------------------------------------------------------------
C
CCCCC CHARACTER*4 IFEEDB
CCCCC CHARACTER*4 IPRINT
C
CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
CCCCC COMMON /PRINT/IFEEDB,IPRINT
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA ATHIRD/0.33333333/
      DATA SQRT3 /1.73205081/
C
      IPR=6
C
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(ALPHA.LT.1.0)GOTO60
      IF(BETA.LT.1.0)GOTO65
      GOTO90
   50 WRITE(IPR, 5)
      WRITE(IPR,47)N
      RETURN
   60 WRITE(IPR,16)
      WRITE(IPR,46)ALPHA
      RETURN
   65 WRITE(IPR,26)
      WRITE(IPR,46)BETA
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 BETRAN SUBROUTINE IS NON-POSITIVE *****)
   16 FORMAT(1H , 95H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 BETRAN SUBROUTINE IS SMALLER THAN 1.0 *****)
   26 FORMAT(1H , 95H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 BETRAN SUBROUTINE IS SMALLER THAN 1.0 *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C     GENERATE N BETA RANDOM NUMBERS
C     BY USING THE FACT THAT
C     IF X1 IS A GAMMA VARIATE WITH PARAMETER ALPHA
C     AND IF X2 IS A GAMMA VARIATE WITH PARAMETER BETA,
C     THEN THE RATIO X1/(X1+X2) IS A BETA VARIATE
C     WITH PARAMETERS ALPHA AND BETA.
C
C     TO GENERATE N GAMMA DISTRIBUTION RANDOM NUMBERS,
C     USE GREENWOOD'S REJECTION ALGORITHM--
C     1) GENERATE A NORMAL RANDOM NUMBER;
C     2) TRANSFORM THE NORMAL VARIATE TO AN APPROXIMATE
C        GAMMA VARIATE USING THE WILSON-HILFERTY
C        APPROXIMATION (SEE THE JOHNSON AND KOTZ
C        REFERENCE, PAGE 176);
C     3) FORM THE REJECTION FUNCTION VALUE, BASED
C        ON THE PROBABILITY DENSITY FUNCTION VALUE
C        OF THE ACTUAL DISTRIBUTION OF THE PSEUDO-GAMMA
C        VARIATE, AND THE PROBABILITY DENSITY FUNCTION VALUE
C        OF A TRUE GAMMA VARIATE.
C     4) GENERATE A UNIFORM RANDOM NUMBER;
C     5) IF THE UNIFORM RANDOM NUMBER IS LESS THAN
C        THE REJECTION FUNCTION VALUE, THEN ACCEPT
C        THE PSEUDO-RANDOM NUMBER AS A GAMMA VARIATE;
C        IF THE UNIFORM RANDOM NUMBER IS LARGER THAN
C        THE REJECTION FUNCTION VALUE, THEN REJECT
C        THE PSEUDO-RANDOM NUMBER AS A GAMMA VARIATE.
C
      A1=1.0/(9.0*ALPHA)
      B1=SQRT(A1)
      XN01=-SQRT3+B1
      XG01=ALPHA*(1.0-A1+B1*XN01)**3
      A2=1.0/(9.0*BETA)
      B2=SQRT(A2)
      XN02=-SQRT3+B2
      XG02=BETA*(1.0-A2+B2*XN02)**3
C
      DO100I=1,N
C
  150 CALL NORRAN(1,ISEED,XN)
      XG=ALPHA*(1.0-A1+B1*XN)**3
      IF(XG.LT.0.0)GOTO150
      TERM=(XG/XG01)**(ALPHA-ATHIRD)
      ARG=0.5*XN*XN-XG-0.5*XN01*XN01+XG01
      FUNCT=TERM*EXP(ARG)
      CALL UNIRAN(1,ISEED,U)
      IF(U(1).LE.FUNCT)GOTO170
      GOTO150
  170 XG1=XG
C
  250 CALL NORRAN(1,ISEED,XN)
      XG=BETA*(1.0-A2+B2*XN)**3
      IF(XG.LT.0.0)GOTO250
      TERM=(XG/XG02)**(BETA-ATHIRD)
      ARG=0.5*XN*XN-XG-0.5*XN02*XN02+XG02
      FUNCT=TERM*EXP(ARG)
      CALL UNIRAN(1,ISEED,U)
      IF(U(1).LE.FUNCT)GOTO270
      GOTO250
  270 XG2=XG
C
      X(I)=XG1/(XG1+XG2)
C
  100 CONTINUE
C
      RETURN
      END
      SUBROUTINE BINCDF(X,P,N,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT BINCDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE AT THE SINGLE PRECISION VALUE X
C              FOR THE BINOMIAL DISTRIBUTION
C              WITH SINGLE PRECISION 'BERNOULLI PROBABILITY'
C              PARAMETER = P, 
C              AND INTEGER 'NUMBER OF BERNOULLI TRIALS'
C              PARAMETER = N. 
C              THE BINOMIAL DISTRIBUTION USED
C              HEREIN HAS MEAN = N*P
C              AND STANDARD DEVIATION = SQRT(N*P*(1-P)).
C              THIS DISTRIBUTION IS DEFINED FOR ALL
C              DISCRETE INTEGER X BETWEEN 0 (INCLUSIVELY)
C              AND N (INCLUSIVELY).
C              THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION
C              F(X) = C(N,X) * P**X * (1-P)**(N-X).
C              WHERE C(N,X) IS THE COMBINATORIAL FUNCTION
C              EQUALING THE NUMBER OF COMBINATIONS OF N ITEMS
C              TAKEN X AT A TIME.
C              THE BINOMIAL DISTRIBUTION IS THE
C              DISTRIBUTION OF THE NUMBER OF
C              SUCCESSES IN N BERNOULLI (0,1)
C              TRIALS WHERE THE PROBABILITY OF SUCCESS
C              IN A SINGLE TRIAL = P.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE 
C                                AT WHICH THE CUMULATIVE DISTRIBUTION 
C                                FUNCTION IS TO BE EVALUATED.
C                                X SHOULD BE INTEGRAL-VALUED,
C                                AND BETWEEN 0.0 (INCLUSIVELY)
C                                AND N (INCLUSIVELY).
C                     --P      = THE SINGLE PRECISION VALUE 
C                                OF THE 'BERNOULLI PROBABILITY'
C                                PARAMETER FOR THE BINOMIAL 
C                                DISTRIBUTION.
C                                P SHOULD BE BETWEEN
C                                0.0 (EXCLUSIVELY) AND
C                                1.0 (EXCLUSIVELY).
C                     --N      = THE INTEGER VALUE
C                                OF THE 'NUMBER OF BERNOULLI TRIALS'
C                                PARAMETER.
C                                N SHOULD BE A POSITIVE INTEGER.
C     OUTPUT ARGUMENTS--CDF    = THE SINGLE PRECISION CUMULATIVE
C                                DISTRIBUTION FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION
C             FUNCTION VALUE CDF
C             FOR THE BINOMIAL DISTRIBUTION
C             WITH 'BERNOULLI PROBABILITY' PARAMETER = P
C             AND 'NUMBER OF BERNOULLI TRIALS' PARAMETER = N.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--X SHOULD BE INTEGRAL-VALUED,
C                   AND BETWEEN 0.0 (INCLUSIVELY) 
C                   AND N (INCLUSIVELY).
C                 --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C                 --N SHOULD BE A POSITIVE INTEGER.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DATAN.
C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--NOTE THAT EVEN THOUGH THE INPUT
C              TO THIS CUMULATIVE
C              DISTRIBUTION FUNCTION SUBROUTINE
C              FOR THIS DISCRETE DISTRIBUTION
C              SHOULD (UNDER NORMAL CIRCUMSTANCES) BE A
C              DISCRETE INTEGER VALUE,
C              THE INPUT VARIABLE X IS SINGLE
C              PRECISION IN MODE.
C              X HAS BEEN SPECIFIED AS SINGLE
C              PRECISION SO AS TO CONFORM WITH THE DATAPAC
C              CONVENTION THAT ALL INPUT ****DATA****
C              (AS OPPOSED TO SAMPLE SIZE, FOR EXAMPLE)
C              VARIABLES TO ALL
C              DATAPAC SUBROUTINES ARE SINGLE PRECISION.
C              THIS CONVENTION IS BASED ON THE BELIEF THAT
C              1) A MIXTURE OF MODES (FLOATING POINT
C              VERSUS INTEGER) IS INCONSISTENT AND
C              AN UNNECESSARY COMPLICATION
C              IN A DATA ANALYSIS; AND
C              2) FLOATING POINT MACHINE ARITHMETIC
C              (AS OPPOSED TO INTEGER ARITHMETIC) 
C              IS THE MORE NATURAL MODE FOR DOING 
C              DATA ANALYSIS. 
C     REFERENCES--HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGE 38.
C               --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 945, FORMULAE 26.5.24 AND
C                 26.5.28, AND PAGE 929.
C               --JOHNSON AND KOTZ, DISCRETE
C                 DISTRIBUTIONS, 1969, PAGES 50-86,
C                 ESPECIALLY PAGES 63-64.
C               --FELLER, AN INTRODUCTION TO PROBABILITY
C                 THEORY AND ITS APPLICATIONS, VOLUME 1,
C                 EDITION 2, 1957, PAGES 135-142. 
C               --KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 120-125.
C               --MOOD AND GRABLE, INTRODUCTION TO THE THEORY
C                 OF STATISTICS, EDITION 2, 1963, PAGES 64-69.
C               --OWEN, HANDBOOK OF STATISTICAL
C                 TABLES, 1962, PAGES 264-272.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C     UPDATED         --MAY       1977. 
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DX,PI,ANU1,ANU2,Z,SUM,TERM,AI,COEF1,COEF2,ARG
      DOUBLE PRECISION COEF
      DOUBLE PRECISION THETA,SINTH,COSTH,A,B
      DOUBLE PRECISION DSQRT,DATAN
      DATA PI/3.14159265358979D0/
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      AN=N
      IF(P.LT.0.0.OR.P.GT.1.0)GOTO50
      IF(N.LT.1)GOTO55
      IF(X.LT.0.0.OR.X.GT.AN)GOTO60
      INTX=X+0.0001 
      FINTX=INTX
      DEL=X-FINTX
      IF(DEL.LT.0.0)DEL=-DEL
      IF(DEL.GT.0.001)GOTO65
      GOTO90
   50 WRITE(IPR,11) 
      WRITE(IPR,46)P
      CDF=0.0
      RETURN
   55 WRITE(IPR,25) 
      WRITE(IPR,47)N
      CDF=0.0
      RETURN
   60 WRITE(IPR,4)N 
      WRITE(IPR,46)X
      IF(X.LT.0.0)CDF=0.0
      IF(X.GT.AN)CDF=1.0
      RETURN
   65 WRITE(IPR,5)
      WRITE(IPR,46)X
   90 CONTINUE
    4 FORMAT(1H ,111H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE BINCDF SUBROUTINE IS OUTSIDE THE USUAL (0,N) = (0,,I7,
     1 11H,INTERVAL *)
    5 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE BINCDF SUBROUTINE IS NON-INTEGRAL *****)
   11 FORMAT(1H ,115H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 BINCDF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 BINCDF SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
C     TREAT IMMEDIATELY THE SPECIAL CASE OF X = N,
C     IN WHICH CASE CDF = 1.0.
C     ALSO TREAT IMMEDIATELY THE SPECIAL CASE OF P = 0.0
C     IN WHICH CASE CDF = 1.0 FOR ALL X.
C     THIRDLY, TREAT THE SPECIAL CASE IN WHICH P = 1.0
C     IN WHICH CASE CDF = 0.0 FOR ALL X SMALLER THAN N
C     AND CDF = 1.0 FOR ALL X EQUAL TO OR LARGER
C     THAN N.
C
      INTX=X+0.0001 
      CDF=1.0
      IF(INTX.EQ.N)RETURN
      IF(P.EQ.0.0)RETURN
      IF(P.EQ.1.0.AND.INTX.GE.N)RETURN
      IF(P.EQ.1.0.AND.INTX.LT.N)CDF=0.0 
      IF(P.EQ.1.0.AND.INTX.LT.N)RETURN
C
C     EXPRESS THE BINOMIAL CUMULATIVE DISTRIBUTION
C     FUNCTION IN TERMS OF THE EQUIVALENT F
C     CUMULATIVE DISTRIBUTION FUNCTION, 
C     AND THEN EVALUATE THE LATTER.
C
      AN=N
      DX=(P/(1.0-P))*((AN-X)/(X+1.0))
      NU1=2.0*(X+1.0)+0.1
      NU2=2.0*(AN-X)+0.1
      ANU1=NU1
      ANU2=NU2
      Z=ANU2/(ANU2+ANU1*DX)
C
C     DETERMINE IF NU1 AND NU2 ARE EVEN OR ODD
C
      IFLAG1=NU1-2*(NU1/2)
      IFLAG2=NU2-2*(NU2/2)
      IF(IFLAG1.EQ.0)GOTO120
      IF(IFLAG2.EQ.0)GOTO150
      GOTO250
C
C     DO THE NU1 EVEN AND NU2 EVEN OR ODD CASE
C
  120 SUM=0.0D0
      TERM=1.0D0
      IMAX=(NU1-2)/2
      IF(IMAX.LE.0)GOTO110
      DO100I=1,IMAX 
      AI=I
      COEF1=2.0D0*(AI-1.0D0)
      COEF2=2.0D0*AI
      TERM=TERM*((ANU2+COEF1)/COEF2)*(1.0D0-Z)
      SUM=SUM+TERM
  100 CONTINUE
C
  110 SUM=SUM+1.0D0 
      SUM=(Z**(ANU2/2.0D0))*SUM
      CDF=SUM
      RETURN
C
C     DO THE NU1 ODD AND NU2 EVEN CASE
C
  150 SUM=0.0D0
      TERM=1.0D0
      IMAX=(NU2-2)/2
      IF(IMAX.LE.0)GOTO210
      DO200I=1,IMAX 
      AI=I
      COEF1=2.0D0*(AI-1.0D0)
      COEF2=2.0D0*AI
      TERM=TERM*((ANU1+COEF1)/COEF2)*Z
      SUM=SUM+TERM
  200 CONTINUE
C
  210 SUM=SUM+1.0D0 
      CDF=1.0D0-((1.0D0-Z)**(ANU1/2.0D0))*SUM
      RETURN
C
C     DO THE NU1 ODD AND NU2 ODD CASE
C
  250 SUM=0.0D0
      TERM=1.0D0
      ARG=DSQRT((ANU1/ANU2)*DX)
      THETA=DATAN(ARG)
      SINTH=ARG/DSQRT(1.0D0+ARG*ARG)
      COSTH=1.0D0/DSQRT(1.0D0+ARG*ARG)
      IF(NU2.EQ.1)GOTO320
      IF(NU2.EQ.3)GOTO310
      IMAX=NU2-2
      DO300I=3,IMAX,2
      AI=I
      COEF1=AI-1.0D0
      COEF2=AI
      TERM=TERM*(COEF1/COEF2)*(COSTH*COSTH)
      SUM=SUM+TERM
  300 CONTINUE
C
  310 SUM=SUM+1.0D0 
      SUM=SUM*SINTH*COSTH
C
  320 A=(2.0D0/PI)*(THETA+SUM)
      SUM=0.0D0
      TERM=1.0D0
      IF(NU1.EQ.1)B=0.0D0
      IF(NU1.EQ.1)GOTO450
      IF(NU1.EQ.3)GOTO410
      IMAX=NU1-3
      DO400I=1,IMAX,2
      AI=I
      COEF1=AI
      COEF2=AI+2.0D0
      TERM=TERM*((ANU2+COEF1)/COEF2)*(SINTH*SINTH)
      SUM=SUM+TERM
  400 CONTINUE
C
  410 SUM=SUM+1.0D0 
      SUM=SUM*SINTH*(COSTH**N)
      COEF=1.0D0
      IEVODD=NU2-2*(NU2/2)
      IMIN=3
      IF(IEVODD.EQ.0)IMIN=2
      IF(IMIN.GT.NU2)GOTO420
      DO430I=IMIN,NU2,2
      AI=I
      COEF=((AI-1.0D0)/AI)*COEF
  430 CONTINUE
C
  420 COEF=COEF*ANU2
      IF(IEVODD.EQ.0)GOTO440
      COEF=COEF*(2.0D0/PI)
C
  440 B=COEF*SUM
C
  450 CDF=1.0D0-(A-B)
      RETURN
C
      END 
      SUBROUTINE BINPPF(P,PPAR,N,PPF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT BINPPF

C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE AT THE SINGLE PRECISION VALUE P
C              FOR THE BINOMIAL DISTRIBUTION
C              WITH SINGLE PRECISION 'BERNOULLI PROBABILITY'
C              PARAMETER = PPAR,
C              AND INTEGER 'NUMBER OF BERNOULLI TRIALS'
C              PARAMETER = N. 
C              THE BINOMIAL DISTRIBUTION USED
C              HEREIN HAS MEAN = N*PPAR 
C              AND STANDARD DEVIATION = SQRT(N*PPAR*(1-PPAR)).
C              THIS DISTRIBUTION IS DEFINED FOR ALL
C              DISCRETE INTEGER X BETWEEN 0 (INCLUSIVELY)
C              AND N (INCLUSIVELY).
C              THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION
C              F(X) = C(N,X) * PPAR**X * (1-PPAR)**(N-X).
C              WHERE C(N,X) IS THE COMBINATORIAL FUNCTION
C              EQUALING THE NUMBER OF COMBINATIONS OF N ITEMS
C              TAKEN X AT A TIME.
C              THE BINOMIAL DISTRIBUTION IS THE
C              DISTRIBUTION OF THE NUMBER OF
C              SUCCESSES IN N BERNOULLI (0,1)
C              TRIALS WHERE THE PROBABILITY OF SUCCESS
C              IN A SINGLE TRIAL = PPAR.
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 (INCLUSIVELY))
C                                AT WHICH THE PERCENT POINT 
C                                FUNCTION IS TO BE EVALUATED.
C                     --PPAR   = THE SINGLE PRECISION VALUE 
C                                OF THE 'BERNOULLI PROBABILITY'
C                                PARAMETER FOR THE BINOMIAL 
C                                DISTRIBUTION.
C                                PPAR SHOULD BE BETWEEN
C                                0.0 (EXCLUSIVELY) AND
C                                1.0 (EXCLUSIVELY).
C                     --N      = THE INTEGER VALUE
C                                OF THE 'NUMBER OF BERNOULLI TRIALS'
C                                PARAMETER.
C                                N SHOULD BE A POSITIVE INTEGER.
C     OUTPUT ARGUMENTS--PPF    = THE SINGLE PRECISION PERCENT
C                                POINT FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION PERCENT POINT  .
C             FUNCTION VALUE PPF
C             FOR THE BINOMIAL DISTRIBUTION
C             WITH 'BERNOULLI PROBABILITY' PARAMETER = PPAR 
C             AND 'NUMBER OF BERNOULLI TRIALS' PARAMETER = N.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--PPAR SHOULD BE BETWEEN 0.0 (EXCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C                 --N SHOULD BE A POSITIVE INTEGER.
C                 --P SHOULD BE BETWEEN 0.0 (INCLUSIVELY)
C                   AND 1.0 (INCLUSIVELY).
C     OTHER DATAPAC   SUBROUTINES NEEDED--NORPPF, BINCDF.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION AND DOUBLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--NOTE THAT EVEN THOUGH THE OUTPUT
C              FROM THIS DISCRETE DISTRIBUTION
C              PERCENT POINT FUNCTION
C              SUBROUTINE MUST NECESSARILY BE A
C              DISCRETE INTEGER VALUE,
C              THE OUTPUT VARIABLE PPF IS SINGLE
C              PRECISION IN MODE.
C              PPF HAS BEEN SPECIFIED AS SINGLE
C              PRECISION SO AS TO CONFORM WITH THE DATAPAC
C              CONVENTION THAT ALL OUTPUT VARIABLES FROM ALL
C              DATAPAC SUBROUTINES ARE SINGLE PRECISION.
C              THIS CONVENTION IS BASED ON THE BELIEF THAT
C              1) A MIXTURE OF MODES (FLOATING POINT
C              VERSUS INTEGER) IS INCONSISTENT AND
C              AN UNNECESSARY COMPLICATION
C              IN A DATA ANALYSIS; AND
C              2) FLOATING POINT MACHINE ARITHMETIC
C              (AS OPPOSED TO INTEGER ARITHMETIC) 
C              IS THE MORE NATURAL MODE FOR DOING 
C              DATA ANALYSIS. 
C     REFERENCES--JOHNSON AND KOTZ, DISCRETE
C                 DISTRIBUTIONS, 1969, PAGES 50-86,
C                 ESPECIALLY PAGE 64, FORMULA 36. 
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGES 36-41.
C               --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 929.
C               --FELLER, AN INTRODUCTION TO PROBABILITY
C                 THEORY AND ITS APPLICATIONS, VOLUME 1,
C                 EDITION 2, 1957, PAGES 135-142. 
C               --KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 120-125.
C               --MOOD AND GRABLE, INTRODUCTION TO THE THEORY
C                 OF STATISTICS, EDITION 2, 1963, PAGES 64-69.
C               --OWEN, HANDBOOK OF STATISTICAL
C                 TABLES, 1962, PAGES 264-272.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DPPAR
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LT.0.0.OR.P.GT.1.0)GOTO50
      IF(PPAR.LE.0.0.OR.PPAR.GE.1.0)GOTO55
      IF(N.LT.1)GOTO60
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      PPF=0.0
      RETURN
   55 WRITE(IPR,11) 
      WRITE(IPR,46)PPAR
      PPF=0.0
      RETURN
   60 WRITE(IPR,25) 
      WRITE(IPR,47)N
      PPF=0.0
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 BINPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   11 FORMAT(1H ,115H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 BINPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 BINPPF SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
      DPPAR=PPAR
      PPF=0.0
      IX0=0
      IX1=0
      IX2=0
      P0=0.0
      P1=0.0
      P2=0.0
C
C     TREAT CERTAIN SPECIAL CASES IMMEDIATELY--
C     1) P = 0.0 OR 1.0
C     2) P = 0.5 AND PPAR = 0.5
C     3) PPF = 0 OR N
C
      IF(P.EQ.0.0)GOTO110
      IF(P.EQ.1.0)GOTO120
      IF(P.EQ.0.5.AND.PPAR.EQ.0.5)GOTO130
      PF0=(1.0D0-DPPAR)**N
      QFN=1.0D0-(DPPAR**N)
      IF(P.LE.PF0)GOTO110
      IF(P.GT.QFN)GOTO120
      GOTO190
  110 PPF=0.0
      RETURN
  120 PPF=N
      RETURN
  130 PPF=N/2
      RETURN
  190 CONTINUE
C
C     DETERMINE AN INITIAL APPROXIMATION TO THE BINOMIAL
C     PERCENT POINT BY USE OF THE NORMAL APPROXIMATION
C     TO THE BINOMIAL.
C     (SEE JOHNSON AND KOTZ, DISCRETE DISTRIBUTIONS,
C     PAGE 64, FORMULA 36).
C
      AMEAN=AN*PPAR 
      SD=SQRT(AN*PPAR*(1.0-PPAR))
      CALL NORPPF(P,ZPPF)
      X2=AMEAN-0.5+ZPPF*SD
      IX2=X2
C
C     CHECK AND MODIFY (IF NECESSARY) THIS INITIAL
C     ESTIMATE OF THE PERCENT POINT
C     TO ASSURE THAT IT BE IN THE CLOSED INTERVAL 0 TO N.
C
      IF(IX2.LT.0)IX2=0
      IF(IX2.GT.N)IX2=N
C
C     DETERMINE UPPER AND LOWER BOUNDS ON THE DESIRED
C     PERCENT POINT BY ITERATING OUT (BOTH BELOW AND ABOVE) 
C     FROM THE ORIGINAL APPROXIMATION AT STEPS
C     OF 1 STANDARD DEVIATION.
C     THE RESULTING BOUNDS WILL BE AT MOST
C     1 STANDARD DEVIATION APART.
C
      IX0=0
      IX1=N
      ISD=SD+1.0
      X2=IX2
      CALL BINCDF(X2,PPAR,N,P2)
C
      IF(P2.LT.P)GOTO210
      GOTO250
C
  210 IX0=IX2
      DO220I=1,100000
      IX2=IX0+ISD
      IF(IX2.GE.IX1)GOTO275
      X2=IX2
      CALL BINCDF(X2,PPAR,N,P2)
      IF(P2.GE.P)GOTO230
      IX0=IX2
  220 CONTINUE
      WRITE(IPR,249)
      WRITE(IPR,222)
      GOTO950
  230 IX1=IX2
      GOTO275
C
  250 IX1=IX2
      DO260I=1,100000
      IX2=IX1-ISD
      IF(IX2.LE.IX0)GOTO275
      X2=IX2
      CALL BINCDF(X2,PPAR,N,P2)
      IF(P2.LT.P)GOTO270
      IX1=IX2
  260 CONTINUE
      WRITE(IPR,249)
      WRITE(IPR,262)
      GOTO950
  270 IX0=IX2
C
  275 IF(IX0.EQ.IX1)GOTO280
      GOTO295
  280 IF(IX0.EQ.0)GOTO285
      IF(IX0.EQ.N)GOTO290
      WRITE(IPR,249)
      WRITE(IPR,282)
      GOTO950
  285 IX1=IX1+1
      GOTO295
  290 IX0=IX0-1
  295 CONTINUE
C
C     COMPUTE BINOMIAL PROBABILITIES FOR THE
C     DERIVED LOWER AND UPPER BOUNDS.
C
      X0=IX0
      X1=IX1
      CALL BINCDF(X0,PPAR,N,P0)
      CALL BINCDF(X1,PPAR,N,P1)
C
C     CHECK THE PROBABILITIES FOR PROPER ORDERING 
C
      IF(P0.LT.P.AND.P.LE.P1)GOTO490
      IF(P0.EQ.P)GOTO410
      IF(P1.EQ.P)GOTO420
      IF(P0.GT.P1)GOTO430
      IF(P0.GT.P)GOTO440
      IF(P1.LT.P)GOTO450
      WRITE(IPR,249)
      WRITE(IPR,401)
      GOTO950
  410 PPF=IX0
      RETURN
  420 PPF=IX1
      RETURN
  430 WRITE(IPR,249)
      WRITE(IPR,431)
      GOTO950
  440 WRITE(IPR,249)
      WRITE(IPR,441)
      GOTO950
  450 WRITE(IPR,249)
      WRITE(IPR,451)
      GOTO950
  490 CONTINUE
C
C     THE STOPPING CRITERION IS THAT THE LOWER BOUND
C     AND UPPER BOUND ARE EXACTLY 1 UNIT APART.
C     CHECK TO SEE IF IX1 = IX0 + 1;
C     IF SO, THE ITERATIONS ARE COMPLETE;
C     IF NOT, THEN BISECT, COMPUTE PROBABILIIES,
C     CHECK PROBABILITIES, AND CONTINUE ITERATING 
C     UNTIL IX1 = IX0 + 1.
C
  300 IX0P1=IX0+1
      IF(IX1.EQ.IX0P1)GOTO690 
      IX2=(IX0+IX1)/2
      IF(IX2.EQ.IX0)GOTO610
      IF(IX2.EQ.IX1)GOTO620
      X2=IX2
      CALL BINCDF(X2,PPAR,N,P2)
      IF(P0.LT.P2.AND.P2.LT.P1)GOTO630
      IF(P2.LE.P0)GOTO640
      IF(P2.GE.P1)GOTO650
  610 WRITE(IPR,249)
      WRITE(IPR,611)
      GOTO950
  620 WRITE(IPR,249)
      WRITE(IPR,611)
      GOTO950
  630 IF(P2.LE.P)GOTO635
      IX1=IX2
      P1=P2
      GOTO300
  635 IX0=IX2
      P0=P2
      GOTO300
  640 WRITE(IPR,249)
      WRITE(IPR,641)
      GOTO950
  650 WRITE(IPR,249)
      WRITE(IPR,651)
      GOTO950
  690 PPF=IX1
      IF(P0.EQ.P)PPF=IX0
      RETURN
C
  950 WRITE(IPR,240)IX0,P0
      WRITE(IPR,241)IX1,P1
      WRITE(IPR,242)IX2,P2
      WRITE(IPR,244)P
      WRITE(IPR,245)PPAR,N
      RETURN
C
  222 FORMAT(1H ,43HNO UPPER BOUND FOUND AFTER 10**7 ITERATIONS)
  240 FORMAT(1H ,7HIX0  = ,I8,10X,5HP0 = ,F14.7)
  241 FORMAT(1H ,7HIX1  = ,I8,10X,5HP1 = ,F14.7)
  242 FORMAT(1H ,7HIX2  = ,I8,10X,5HP2 = ,F14.7)
  244 FORMAT(1H ,7HP    = ,F14.7)
  245 FORMAT(1H ,7HPPAR = ,F14.7,10X,5HN  = ,I8)
  249 FORMAT(1H ,47H***** INTERNAL ERROR IN BINPPF SUBROUTINE *****)
  262 FORMAT(1H ,43HNO LOWER BOUND FOUND AFTER 10**7 ITERATIONS)
  282 FORMAT(1H ,31HLOWER AND UPPER BOUND IDENTICAL)
  401 FORMAT(1H ,39HIMPOSSIBLE BRANCH CONDITION ENCOUNTERED)
  431 FORMAT(1H ,42HLOWER BOUND PROBABILITY (P0) GREATER THAN ,
     1 28HUPPER BOUND PROBABILITY (P1)) 
  441 FORMAT(1H ,42HLOWER BOUND PROBABILITY (P0) GREATER THAN ,
     1 21HINPUT PROBABILITY (P))
  451 FORMAT(1H ,42HUPPER BOUND PROBABILITY (P1) LESS    THAN ,
     1 21HINPUT PROBABILITY (P))
  611 FORMAT(1H ,39HBISECTION VALUE (X2) = LOWER BOUND (X0))
  621 FORMAT(1H ,39HBISECTION VALUE (X2) = UPPER BOUND (X1))
  641 FORMAT(1H ,33HBISECTION VALUE PROBABILITY (P2) ,
     1 38HLESS THAN LOWER BOUND PROBABILITY (P0)) 
  651 FORMAT(1H ,33HBISECTION VALUE PROBABILITY (P2) ,
     1 41HGREATER THAN UPPER BOUND PROBABILITY (P1))
C
      END 
      SUBROUTINE BINRAN(N,P,NPAR,ISEED,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT BINRAN
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE BINOMIAL DISTRIBUTION
C              WITH SINGLE PRECISION 'BERNOULLI PROBABILITY'
C              PARAMETER = P,
C              AND INTEGER 'NUMBER OF BERNOULLI TRIALS'
C              PARAMETER = NPAR.
C              THE BINOMIAL DISTRIBUTION USED
C              HEREIN HAS MEAN = NPAR*P
C              AND STANDARD DEVIATION = SQRT(NPAR*P*(1-P)).
C              THIS DISTRIBUTION IS DEFINED FOR ALL
C              DISCRETE INTEGER X BETWEEN 0 (INCLUSIVELY)
C              AND NPAR (INCLUSIVELY).
C              THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION
C              F(X) = C(NPAR,X) * P**X * (1-P)**(NPAR-X).
C              WHERE C(NPAR,X) IS THE COMBINATORIAL FUNCTION
C              EQUALING THE NUMBER OF COMBINATIONS OF NPAR ITEMS
C              TAKEN X AT A TIME.
C              THE BINOMIAL DISTRIBUTION IS THE
C              DISTRIBUTION OF THE NUMBER OF
C              SUCCESSES IN NPAR BERNOULLI (0,1)
C              TRIALS WHERE THE PROBABILITY OF SUCCESS
C              IN A SINGLE TRIAL = P.
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
C                                OF RANDOM NUMBERS TO BE
C                                GENERATED.
C                     --P      = THE SINGLE PRECISION VALUE
C                                OF THE 'BERNOULLI PROBABILITY'
C                                PARAMETER FOR THE BINOMIAL
C                                DISTRIBUTION.
C                                P SHOULD BE BETWEEN
C                                0.0 (EXCLUSIVELY) AND
C                                1.0 (EXCLUSIVELY).
C                     --NPAR   = THE INTEGER VALUE
C                                OF THE 'NUMBER OF BERNOULLI TRIALS'
C                                PARAMETER.
C                                NPAR 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 BINOMIAL DISTRIBUTION
C             WITH 'BERNOULLI PROBABILITY' PARAMETER = P
C             AND 'NUMBER OF BERNOULLI TRIALS' PARAMETER = NPAR.
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                 --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C                 --NPAR SHOULD BE A POSITIVE INTEGER.
C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN, GEORAN.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     COMMENT--NOTE THAT EVEN THOUGH THE OUTPUT
C              FROM THIS DISCRETE RANDOM NUMBER
C              GENERATOR MUST NECESSARILY BE A
C              SEQUENCE OF ***INTEGER*** VALUES,
C              THE OUTPUT VECTOR X IS SINGLE
C              PRECISION IN MODE.
C              X HAS BEEN SPECIFIED AS SINGLE
C              PRECISION SO AS TO CONFORM WITH THE DATAPAC
C              CONVENTION THAT ALL OUTPUT VECTORS FROM ALL
C              DATAPAC SUBROUTINES ARE SINGLE PRECISION.
C              THIS CONVENTION IS BASED ON THE BELIEF THAT
C              1) A MIXTURE OF MODES (FLOATING POINT
C              VERSUS INTEGER) IS INCONSISTENT AND
C              AN UNNECESSARY COMPLICATION
C              IN A DATA ANALYSIS; AND
C              2) FLOATING POINT MACHINE ARITHMETIC
C              (AS OPPOSED TO INTEGER ARITHMETIC)
C              IS THE MORE NATURAL MODE FOR DOING
C              DATA ANALYSIS.
C     REFERENCES--JOHNSON AND KOTZ, DISCRETE
C                 DISTRIBUTIONS, 1969, PAGES 50-86.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGE 41.
C               --FELLER, AN INTRODUCTION TO PROBABILITY
C                 THEORY AND ITS APPLICATIONS, VOLUME 1,
C                 EDITION 2, 1957, PAGES 135-142.
C               --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 929.
C               --KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 120-125.
C               --MOOD AND GRABLE, INTRODUCTION TO THE THEORY
C                 OF STATISTICS, EDITION 2, 1963, PAGES 64-69.
C               --TOCHER, THE ART OF SIMULATION,
C                 1963, PAGES 39-40.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--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
CCCCC CHARACTER*4 IFEEDB
CCCCC CHARACTER*4 IPRINT
C
CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
CCCCC COMMON /PRINT/IFEEDB,IPRINT
C
      IPR=6
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(P.LE.0.0.OR.P.GE.1.0)GOTO55
      IF(NPAR.LT.1)GOTO60
      GOTO90
   50 WRITE(IPR, 5)
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,11)
      WRITE(IPR,46)P
      RETURN
   60 WRITE(IPR,25)
      WRITE(IPR,47)NPAR
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 BINRAN SUBROUTINE IS NON-POSITIVE *****)
   11 FORMAT(1H ,115H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 BINRAN SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 BINRAN SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C     CHECK ON THE MAGNITUDE OF P,
C     AND BRANCH TO THE FASTER
C     GENERATION METHOD ACCORDINGLY.
C
      IF(P.LT.0.1)GOTO450
C
C     IF P IS MODERATE OR LARGE,
C     GENERATE N BINOMIAL RANDOM NUMBERS
C     USING THE REJECTION METHOD.
C
      DO100I=1,N
      ISUM=0
      DO200J=1,NPAR
      CALL UNIRAN(1,ISEED,U)
      IF(U.LE.P)ISUM=ISUM+1
  200 CONTINUE
      X(I)=ISUM
  100 CONTINUE
      RETURN
C
C     IF P IS SMALL,
C     GENERATE N BINOMIAL NUMBERS
C     USING THE FACT THAT THE
C     WAITING TIME FOR 1 SUCCESS IN
C     BERNOULLI TRIALS HAS A
C     GEOMETRIC DISTRIBUTION.
C
  450 DO500I=1,N
      ISUM=0
      J=1
  550 CALL GEORAN(1,P,ISEED,G)
      IG=G+0.5
      ISUM=ISUM+IG+1
      IF(ISUM.GT.NPAR)GOTO650
      J=J+1
      GOTO550
  650 X(I)=J-1
  500 CONTINUE
      RETURN
C
      END
      SUBROUTINE CAUCDF(X,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT CAUCDF
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 BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DATA PI/3.14159265358979/
C
      IPR=6
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)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT CAUPDF
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 BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DATA C/.31830988618379/ 
C
      IPR=6
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 CAUPLT(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT CAUPLT
C
C     PURPOSE--THIS SUBROUTINE GENERATES A CAUCHY 
C              PROBABILITY PLOT.
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--A ONE-PAGE CAUCHY PROBABILITY PLOT. 
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, PLOT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, SIN, COS.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
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 LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(7500),W(7500)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501))
C
      DATA PI/3.14159265358979/
      DATA TAU/10.02040649/
C
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE CAUPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 CAUPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE CAUPLT SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     SORT THE DATA 
C
      CALL SORT(X,N,Y)
C
C     GENERATE UNIFORM ORDER STATISTIC MEDIANS
C
      CALL UNIMED(N,W)
C
C     COMPUTE CAUCHY ORDER STATISTIC MEDIANS
C
      DO100I=1,N
      ARG=PI*W(I)
      W(I)=-COS(ARG)/SIN(ARG) 
  100 CONTINUE
C
C     PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS.
C     WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION 
C     AND THE SAMPLE SIZE.
C
      CALL PLOT(Y,W,N)
      WRITE(IPR,105)TAU,N
C
C     COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. 
C     COMPUTE LOCATION AND SCALE ESTIMATES
C     FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. 
C     THEN WRITE THEM OUT.
C
      SUM1=0.0
      DO200I=1,N
      SUM1=SUM1+Y(I)
  200 CONTINUE
      YBAR=SUM1/AN
      WBAR=0.0
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO300I=1,N
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) 
      SUM2=SUM2+W(I)*Y(I)
      SUM3=SUM3+W(I)*W(I)
  300 CONTINUE
      CC=SUM2/SQRT(SUM3*SUM1) 
      YSLOPE=SUM2/SUM3
      YINT=YBAR-YSLOPE*WBAR
      WRITE(IPR,305)CC,YINT,YSLOPE
C
  105 FORMAT(1H ,31HCAUCHY PROBABILITY PLOT (TAU = ,E15.8,1H),56X,20HTHE
     1 SAMPLE SIZE N = ,I7)
  305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X,
     122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) 
C
      RETURN
      END 
      SUBROUTINE CAUPPF(P,PPF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT CAUPPF
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. 
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 BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DATA PI/3.14159265358979/
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LE.0.0.OR.P.GE.1.0)GOTO50
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 CAUPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      ARG=PI*P
      PPF=-COS(ARG)/SIN(ARG)
C
      RETURN
      END 
      SUBROUTINE CAURAN(N,ISEED,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT CAUPPF
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                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--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
CCCCC CHARACTER*4 IFEEDB
CCCCC CHARACTER*4 IPRINT
C
CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
CCCCC COMMON /PRINT/IFEEDB,IPRINT
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA PI/3.14159265359/
C
      IPR=6
C
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      GOTO90
   50 WRITE(IPR, 5)
      WRITE(IPR,47)N
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 CAURAN SUBROUTINE IS NON-POSITIVE *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
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)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT CAUSF
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 BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DATA PI/3.14159265358979/
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LE.0.0.OR.P.GE.1.0)GOTO50
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 CAUSF  SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      ARG=PI*P
      SF=PI/((SIN(ARG))**2)
C
      RETURN
      END 
      SUBROUTINE CHSCDF(X,NU,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT CHSCDF
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. 
C     REFERENCES--NATIONAL BUREAU OF STANDARDS 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 LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --MAY       1974. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --OCTOBER   1976. 
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
      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
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(NU.LE.0)GOTO50
      IF(X.LT.0.0)GOTO55
      GOTO90
   50 WRITE(IPR,15) 
      WRITE(IPR,47)NU
      CDF=0.0
      RETURN
   55 WRITE(IPR,4)
      WRITE(IPR,46)X
      CDF=0.0
      RETURN
   90 CONTINUE
    4 FORMAT(1H , 96H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE CHSCDF SUBROUTINE IS NEGATIVE *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 CHSCDF SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
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(IPR,99)IBRAN
   99 FORMAT(1H ,42H*****INTERNAL ERROR IN CHSCDF SUBROUTINE--,
     146HIMPOSSIBLE BRANCH CONDITION AT BRANCH POINT = ,I8) 
      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 CHSPLT(X,N,NU)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT CHSPLT
C
C     PURPOSE--THIS SUBROUTINE GENERATES A CHI-SQUARED
C              PROBABILITY PLOT (WITH INTEGER
C              DEGREES OF FREEDOM PARAMETER VALUE = NU).
C              THE PROTOTYPE CHI-SQUARED DISTRIBUTION USED
C              HEREIN IS DEFINED FOR ALL NON-NEGATIVE X,
C              AND ITS PROBABILITY DENSITY FUNCTION IS GIVEN
C              IN THE REFERENCES BELOW. 
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 CHI-SQUARED 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  CHI-SQUARED DISTRIBUTION
C              WITH DEGREES OF FREEDOM PARAMETER VALUE = NU.
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                     --NU     = THE INTEGER NUMBER OF DEGREES
C                                OF FREEDOM.
C                                NU SHOULD BE POSITIVE.
C     OUTPUT--A ONE-PAGE CHI-SQUARED PROBABILITY PLOT.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C                 --NU SHOULD BE POSITIVE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, CHSPPF, PLOT. 
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--WILK, GNANADESIKAN, AND HUYETT, 'PROBABILITY
C                 PLOTS FOR THE GAMMA DISTRIBUTION',
C                 TECHNOMETRICS, 1962, PAGES 1-15.
C               --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 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 LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C     UPDATED         --FEBRUARY  1977. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(7500),W(7500)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501))
C
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      IF(NU.LE.0)GOTO60
      HOLD=X(1)
      DO65I=2,N
      IF(X(I).NE.HOLD)GOTO90
   65 CONTINUE
      WRITE(IPR, 9)HOLD
      RETURN
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   60 WRITE(IPR,25) 
      WRITE(IPR,47)NU
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE CHSPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 CHSPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE CHSPLT SUBROUTINE HAS THE VALUE 1 *****)
   25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 CHSPLT SUBROUTINE IS NON-POSITIVE *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     SORT THE DATA 
C
      CALL SORT(X,N,Y)
C
C     GENERATE UNIFORM ORDER STATISTIC MEDIANS
C
      CALL UNIMED(N,W)
C
C     COMPUTE CHI-SQUARED DISTRIBUTION ORDER STATISTIC MEDIANS
C
      DO100I=1,N
      CALL CHSPPF(W(I),NU,W(I))
  100 CONTINUE
C
C     PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS.
C     COMPUTE THE TAIL LENGTH MEASURE OF THE DISTRIBUTION.
C     WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION 
C     AND THE SAMPLE SIZE.
C
      CALL PLOT(Y,W,N)
      Q=.9975
      CALL CHSPPF(Q,NU,PP9975)
      Q=.0025
      CALL CHSPPF(Q,NU,PP0025)
      Q=.975
      CALL CHSPPF(Q,NU,PP975) 
      Q=.025
      CALL CHSPPF(Q,NU,PP025) 
      TAU=(PP9975-PP0025)/(PP975-PP025) 
      WRITE(IPR,105)NU,TAU,N
C
C     COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. 
C     COMPUTE LOCATION AND SCALE ESTIMATES
C     FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. 
C     THEN WRITE THEM OUT.
C
      SUM1=0.0
      SUM2=0.0
      DO200I=1,N
      SUM1=SUM1+Y(I)
      SUM2=SUM2+W(I)
  200 CONTINUE
      YBAR=SUM1/AN
      WBAR=SUM2/AN
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO300I=1,N
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) 
      SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) 
      SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 
  300 CONTINUE
      CC=SUM2/SQRT(SUM3*SUM1) 
      YSLOPE=SUM2/SUM3
      YINT=YBAR-YSLOPE*WBAR
      WRITE(IPR,305)CC,YINT,YSLOPE
C
  105 FORMAT(1H ,55HCHI-SQUARED PROBABILITY PLOT WITH DEGREES OF FREEDOM
     1 = ,I8,1X,7H(TAU = ,E15.8,1H),11X,20HTHE SAMPLE SIZE N = ,I7)
  305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X,
     122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) 
C
      RETURN
      END 
      SUBROUTINE CHSPPF(P,NU,PPF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT CHSPPF
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. 
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 BUREAU OF STANDARDS 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 LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DP,DGAMMA
      DOUBLE PRECISION Z,Z2,Z3,Z4,Z5,DEN,A,B,C,D,G
      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 DEXP,DLOG
      DIMENSION D(10)
      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
      IPR=6
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(IPR,1)
      WRITE(IPR,46)P
      PPF=0.0
      RETURN
   55 WRITE(IPR,15) 
      WRITE(IPR,47)NU
      PPF=0.0
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 CHSPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 CHSPPF SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
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
      ANU=NU
      GAMMA=ANU/2.0 
      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
      Z3=Z*Z2
      Z4=Z2*Z2
      Z5=Z2*Z3
      A=(Z-0.5D0)*DLOG(Z)-Z+C 
      B=D(1)/Z+D(2)/Z3+D(3)/Z5+D(4)/(Z2*Z5)+D(5)/(Z4*Z5)+
     1D(6)/(Z*Z5*Z5)+D(7)/(Z3*Z5*Z5)+D(8)/(Z5*Z5*Z5)+D(9)/(Z2*Z5*Z5*Z5)
      G=DEXP(A+B)/DEN
C
C     DETERMINE LOWER AND UPPER LIMITS ON THE DESIRED 100P
C     PERCENT POINT.
C
      ILOOP=1
      XMIN0=(DP*DGAMMA*G)**(1.0D0/DGAMMA)
      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(IPR,705)MAXIT
      WRITE(IPR,706)P
      WRITE(IPR,707)NU
      WRITE(IPR,708)
      PPF=0.0
      RETURN
C
  750 T=SUM
      PCALC=(DX**DGAMMA)*(DEXP(-DX))*T/G
      IF(ILOOP.EQ.1)GOTO360
      GOTO560
C
  705 FORMAT(1H ,48H*****ERROR IN INTERNAL OPERATIONS IN THE CHSPPF , 
     1 45HSUBROUTINE--THE NUMBER OF ITERATIONS EXCEEDS ,I7) 
  706 FORMAT(1H ,33H     THE INPUT VALUE OF P     IS ,E15.8)
  707 FORMAT(1H ,33H     THE INPUT VALUE OF NU    IS ,I8)
  708 FORMAT(1H ,48H     THE OUTPUT VALUE OF PPF HAS BEEN SET TO 0.0) 
C
      END 
      SUBROUTINE CHSRAN(N,NU,ISEED,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT CHSRAN
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                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--FEBRUARY  1975.
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(*)
      DIMENSION Y(2),Z(2)
C
C---------------------------------------------------------------------
C
CCCCC CHARACTER*4 IFEEDB
CCCCC CHARACTER*4 IPRINT
C
CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
CCCCC COMMON /PRINT/IFEEDB,IPRINT
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA PI/3.14159265359/
C
      IPR=6
C
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(NU.LE.0)GOTO60
      GOTO90
   50 WRITE(IPR,5)
      WRITE(IPR,47)N
      RETURN
   60 WRITE(IPR,15)
      WRITE(IPR,47)NU
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 CHSRAN SUBROUTINE IS NON-POSITIVE *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 CHSRAN SUBROUTINE IS NON-POSITIVE *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
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
      RETURN
      END
      SUBROUTINE CODE(X,N,Y)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT CODE
C
C     PURPOSE--THIS SUBROUTINE CODES THE ELEMENTS 
C              OF THE INPUT VECTOR X
C              AND PUTS THE CODED VALUES INTO THE OUTPUT VECTOR Y.
C              THE CODING IS AS FOLLOWS--
C              THE MINIMUM IS CODED AS 1.0.
C              THE NEXT LARGER VALUE AS 2.0,
C              THE NEXT LARGER VALUE AS 3.0,
C              ETC. 
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR
C                                OF OBSERVATIONS TO BE CODED.
C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR X. 
C     OUTPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR
C                                INTO WHICH THE CODED VALUES
C                                WILL BE PLACED.
C     OUTPUT--THE SINGLE PRECISION VECTOR Y
C             WHICH WILL CONTAIN THE CODED VALUES 
C             CORRESPONDING TO THE OBSERVATIONS IN
C             THE VECTOR X.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 15000. 
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--ALL OCCURRANCES OF THE MINIMUM ARE CODED AS 1.0;
C              ALL OCCURANCES OF THE NEXT LARGER VALUE
C              ARE CODED AS 2.0;
C              ALL OCCURANCES OF THE NEXT LARGER VALUE
C              ARE CODED AS 3.0, ETC.
C     COMMENT--THE INPUT VECTOR X REMAINS UNALTERED.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--OCTOBER  1975.
C     UPDATED         --NOVEMBER 1975.
C     UPDATED         --JUNE     1977.
C
C---------------------------------------------------------------------
C
      DIMENSION X(1),Y(1)
      DIMENSION DIST(15000)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (DIST(1),WS(1))
C
      IPR=6
      IUPPER=15000
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      DO61I=1,N
      Y(I)=I
   61 CONTINUE
      RETURN
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      Y(1)=1.0
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE CODE   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 CODE   SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE CODE   SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
C     PERFORM THE CODING--
C     PULL OUT THE DISTINCT VALUES,
C     THEN SORT (AND ESSENTIALLY RANK) THE DISTINCT VALUES, 
C     THEN APPLY THE RANKS TO ALL THE VALUES.
C
      NUMDIS=1
      DIST(NUMDIS)=X(1)
      DO100I=2,N
      DO200J=1,NUMDIS
      IF(X(I).EQ.DIST(J))GOTO100
  200 CONTINUE
      NUMDIS=NUMDIS+1
      DIST(NUMDIS)=X(I)
  100 CONTINUE
C
      CALL SORT(DIST,NUMDIS,DIST)
C
      DO600I=1,N
      DO700J=1,NUMDIS
      IF(X(I).EQ.DIST(J))GOTO750
  700 CONTINUE
      WRITE(IPR,705)
      WRITE(IPR,710)I,X(I)
  705 FORMAT(1H ,'*****INTERNAL ERROR IN CODE SUBROUTINE')
  710 FORMAT(1H ,'NO CODE FOUND FOR ELEMENT NUMBER ',I5,' = ',F15.7)
      RETURN
  750 Y(I)=J
  600 CONTINUE
C
C     WRITE OUT A FEW LINES OF SUMMARY INFORMATION ABOUT THE CODING.
C
      WRITE(IPR,999)
      WRITE(IPR,905)
      WRITE(IPR,906)NUMDIS
      WRITE(IPR,999)
      WRITE(IPR,910)
      DO900I=1,NUMDIS
      AI=I
      WRITE(IPR,915)DIST(I),AI
  900 CONTINUE
  905 FORMAT(1H ,'OUTPUT FROM THE CODE SUBROUTINE')
  906 FORMAT(1H ,'NUMBER OF DISTINCT CODE VALUES = ',I8)
  999 FORMAT(1H )
  910 FORMAT(1H ,8X,'VALUE     CODED VALUE')
  915 FORMAT(1H ,F15.7,6X,F6.0)
C
      RETURN
      END 
      SUBROUTINE COPY(X,N,Y)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT COPY
C
C     PURPOSE--THIS SUBROUTINE COPIES THE CONTENTS
C              OF THE SINGLE PRECISION VECTOR X INTO THE
C              SINGLE PRECISION VECTOR Y.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                                OBSERVATIONS TO BE COPIED. 
C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR X. 
C     OUTPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR
C                                INTO WHICH THE COPIED DATA VALUES
C                                FROM X WILL BE SEQUENTIALLY PLACED.
C     OUTPUT--THE SINGLE PRECISION VECTOR Y.
C             WHICH WILL HAVE ITS
C             FIRST N ELEMENTS IDENTICAL
C             TO THE SINGLE PRECISION VECTOR X.
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--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--THE FIRST ELEMENT OF X IS COPIED INTO THE FIRST
C              ELEMENT OF Y; THE SECOND ELEMENT OF X IS COPIED INTO
C              THE SECOND ELEMENT OF Y, ETC.
C     COMMENT--THE INPUT VECTOR X REMAINS UNALTERED.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1972. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1),Y(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE COPY   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 COPY   SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE COPY   SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      DO100I=1,N
      Y(I)=X(I)
  100 CONTINUE
C
      RETURN
      END 
      SUBROUTINE CORR(X,Y,N,IWRITE,C)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT CORR
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SAMPLE CORRELATION COEFFICIENT
C              BETWEEN THE 2 SETS OF DATA IN THE INPUT VECTORS X AND Y.
C              THE SAMPLE CORRELATION COEFFICIENT WILL BE A SINGLE
C              PRECISION VALUE BETWEEN -1.0 AND 1.0 (INCLUSIVELY).
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                                (UNSORTED) OBSERVATIONS
C                                WHICH CONSTITUTE THE FIRST SET
C                                OF DATA.
C                     --Y      = THE SINGLE PRECISION VECTOR OF
C                                (UNSORTED) OBSERVATIONS
C                                WHICH CONSTITUTE THE SECOND SET
C                                OF DATA.
C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR X, OR EQUIVALENTLY,
C                                THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR Y. 
C                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SAMPLE CORRELATION COEFFICIENT
C                                AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SAMPLE CORRELATION COEFFICIENT
C                                AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--C      = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE CORRELATION COEFFICIENT
C                                BETWEEN THE 2 SETS OF DATA 
C                                IN THE INPUT VECTORS X AND Y.
C                                THIS SINGLE PRECISION VALUE
C                                WILL BE BETWEEN -1.0 AND 1.0
C                                (INCLUSIVELY).
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE CORRELATION COEFFICIENT BETWEEN THE 2 SETS
C             OF DATA IN THE INPUT VECTORS X AND Y.
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 235-236.
C               --KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 2, EDITION 1, 1961, PAGES 292-293.
C               --SNEDECOR AND COCHRAN, STATISTICAL METHODS,
C                 EDITION 6, 1967, PAGES 172-198. 
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1),Y(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      AN=N
      C=0.0
      IFLAG=0
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO65
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      IFLAG=1
   65 HOLD=Y(1)
      DO70I=2,N
      IF(Y(I).NE.HOLD)GOTO80
   70 CONTINUE
      WRITE(IPR,19)HOLD
      IFLAG=1
   80 IF(IFLAG.EQ.1)RETURN
      GOTO90
   50 WRITE(IPR,25) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,28) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE CORR   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   19 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT (A VECTOR) TO THE CORR   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 CORR   SUBROUTINE IS NON-POSITIVE *****)
   28 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE THIRD  INPUT ARGUME
     1NT TO THE CORR   SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      XBAR=0.0
      YBAR=0.0
      DO100I=1,N
      XBAR=XBAR+X(I)
      YBAR=YBAR+Y(I)
  100 CONTINUE
      XBAR=XBAR/AN
      YBAR=YBAR/AN
C
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO200I=1,N
      SUM1=SUM1+(X(I)-XBAR)*(Y(I)-YBAR) 
      SUM2=SUM2+(X(I)-XBAR)**2
      SUM3=SUM3+(Y(I)-YBAR)**2
  200 CONTINUE
      SUM2=SQRT(SUM2)
      SUM3=SQRT(SUM3)
      C   =SUM1/(SUM2*SUM3)
C
      IF(IWRITE.NE.0)WRITE(IPR,205)N,C
  205 FORMAT(1H ,59HTHE LINEAR        CORRELATION COEFFICIENT OF THE 2 S
     1ETS OF ,I6,17H OBSERVATIONS IS ,F14.5)
      RETURN
      END 
      SUBROUTINE COUNT(X,N,XMIN,XMAX,IWRITE,XCOUNT)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT COUNT
C
C     PURPOSE--THIS SUBROUTINE COMPUTES 
C              THE NUMBER OF OBSERVATIONS
C              BETWEEN XMIN AND XMAX (INCLUSIVELY)
C              IN THE INPUT VECTOR X.
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                     --XMIN   = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES THE LOWER LIMIT
C                                (INCLUSIVELY) OF THE REGION
C                                OF INTEREST.
C                     --XMAX   = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES THE UPPER LIMIT
C                                (INCLUSIVELY) OF THE REGION
C                                OF INTEREST.
C                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SAMPLE COUNT
C                                AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SAMPLE COUNT
C                                AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--XCOUNT = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE COUNT.
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE COUNT.
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--SNEDECOR AND COCHRAN, STATISTICAL METHODS,
C                 EDITION 6, 1967, PAGES 207-213. 
C               --DIXON AND MASSEY, INTRODUCTION TO STATISTICAL
C                 ANALYSIS, EDITION 2, 1957, PAGES 81-82, 228-231.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      IF(XMIN.EQ.XMAX)GOTO80
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      XCOUNT=0.0
      RETURN
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XCOUNT=0.0
      RETURN
   80 WRITE(IPR,26) 
      WRITE(IPR,49)XMIN
      XCOUNT=0.0
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE COUNT  SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 COUNT  SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE COUNT  SUBROUTINE HAS THE VALUE 1 *****)
   26 FORMAT(1H ,46H***** FATAL ERROR--THE THIRD AND FOURTH INPUT ,
     1 48HARGUMENTS TO THE COUNT  SUBROUTINE ARE IDENTICAL) 
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
   49 FORMAT(1H , 37H***** THE VALUE OF THE ARGUMENTS ARE ,E15.7   ,6H *
     1****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
      XCOUNT=0.0
      ISUM=0
      DO100I=1,N
      IF(X(I).LT.XMIN.OR.XMAX.LT.X(I))GOTO100
      ISUM=ISUM+1
  100 CONTINUE
      XCOUNT=ISUM
C
  101 IF(IWRITE.EQ.0)RETURN
      WRITE(IPR,999)
      WRITE(IPR,105)N,XMIN,XMAX,XCOUNT
  105 FORMAT(1H ,23HTHE NUMBER (OUT OF THE ,I6,31H OBSERVATIONS) IN THE
     1INTERVAL ,E15.7,4H TO ,E15.7,4H IS ,E15.7)
  999 FORMAT(1H )
      RETURN
      END 
      SUBROUTINE DECOMP(N,K,ETA,TOL,IRANK,INSING) 
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT DECOMP
      EXTERNAL DOT
C
C     PURPOSE--THIS SUBROUTINE DECOMPOSES THE WEIGHTED DATA 
C     MATRIX Q WHICH ORIGINALLY = THE N BY K DATA MATRIX X
C     TIMES THE SQUARE ROOT OF THE WEIGHTS (IN W).
C     THE ORIGINAL Q IS DECOMPOSED INTO A NEW Q TIMES THE
C     INVERSE OF A DIAGONAL MATRIX D TIMES THE DIAGONAL MATRIX D
C     TIMES AN UPPER TRIANGULAR MATRIX R.
C     THE NEW N BY K Q HAS ORTHOGONAL COLUMNS.
C     A SECOND OUTPUT FROM THIS SUBROUTINE IS THE RANK AND
C     STATUS (NON-SINGULAR OR SINGULAR) OF THE DATA MATRIX X.
C     A THIRD OURPUT FROM THIS SUBROUTINE IS THE NUMERICALLY
C     OPTIMAL PIVOT POINTS FOR THE DECOMPOSITION. 
C     X--NOT USED
C     Q--USED AND CHANGED
C     R--DEFINED
C     D--PERMANENTLY DEFINED
C     IPIVOT--PERMANENTLY DEFINED
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      LOGICAL FSUM
      DIMENSION Q(10000),R(2500),D(50),IPIVOT(50) 
      COMMON /BLOCK2/ WS(15000)
      COMMON /BLOCK3/ DUM1(3000),DUM2(3000)
      EQUIVALENCE (Q(1),WS(1))
      EQUIVALENCE (R(1),WS(10001))
      EQUIVALENCE (D(1),WS(12501))
      EQUIVALENCE (IPIVOT(1),WS(12551)) 
C
C-----START POINT-----------------------------------------------------
C
C     ZERO-OUT SOME VARIABLES, VECTORS, AND ARRAYS
C
      INSING=0
      IRANK=0
      DO 5 J=1,K
      D(J) = 0.0
      DO 6 I=1,K
      IRARG=(I-1)*K+J
      R(IRARG)=0.0
    6 CONTINUE
    5 CONTINUE
C
      TOL2=TOL*TOL
      DO 10    J=1,K
10    IPIVOT(J)=J
      DO 200   IS=1,K
C
C     BEGIN STEP NUMBER      IS      IN THE DECOMPOSITION
C
      IF (IS.EQ.1) GO TO 20
      GO TO 30
20    FSUM=.TRUE.
30    DIS=0.0
      IP=IS
C
C     BEGIN THE PIVOT SEARCH
C
      DO 80    J=IS,K
      M=IPIVOT(J)
      IF (FSUM) GO TO 40
      GO TO 60
40    DO 50    L=1,N
      IQARG=(L-1)*K+M
      DUM1(L)=Q(IQARG)
50    DUM2(L)=Q(IQARG)
C
      CALL DOT(DUM1,DUM2,1,N,0.0,D(J))
C
60    IF (DIS.LT.D(J)) GO TO 70
      GO TO 80
70    DIS=D(J)
      IP=J
80    CONTINUE
C
C     END THE PIVOT SEARCH
C
      M=IPIVOT(IP)
      IF (FSUM) DN=DIS
      IF (DIS.LT.ETA*DN) GO TO 90
      FSUM=.FALSE.
      GO TO 100
90    FSUM=.TRUE.
100   IF (FSUM) GO TO 30
      IF (IP.NE.IS) GO TO 110 
      GO TO 130
C
C     BEGIN COLUMN INTERCHANGES
C
110   D(IP)=D(IS)
      IPIVOT(IP)=IPIVOT(IS)
      IPIVOT(IS)=M
      IF (IS.EQ.1) GO TO 130
      ISM1=IS-1
      DO 120   I=1,ISM1
      IRARG1=(I-1)*K+IP
      IRARG2=(I-1)*K+IS
      HOLD=R(IRARG1)
      R(IRARG1)=R(IRARG2)
120   R(IRARG2)=HOLD
C
C     END COLUMN INTERCHANGES 
C
130   DO 140   L=1,N
      IQARG=(L-1)*K+M
      DUM1(L)=Q(IQARG)
140   DUM2(L)=Q(IQARG)
C
      CALL DOT(DUM1,DUM2,1,N,0.0,D(IS)) 
C
      DIS=D(IS)
      IF (DIS.LE.TOL2*D(1)) RETURN
      IF(DIS.NE.0.0)GOTO150
      INSING=0
      RETURN
150   ISP1=IS+1
      IF (ISP1.GT.K) GO TO 190
C
C     BEGIN ORTHOGONALIZATION 
C
      DO 180   J=ISP1,K
      IP=IPIVOT(J)
      DO 160   L=1,N
      IQARG1=(L-1)*K+M
      IQARG2=(L-1)*K+IP
      DUM1(L)=Q(IQARG1)
160   DUM2(L)=Q(IQARG2)
C
      IRARG=(IS-1)*K+J
      CALL DOT(DUM1,DUM2,1,N,0.0,R(IRARG))
      R(IRARG)=R(IRARG)/DIS
C
      RISJ=R(IRARG) 
      DO 170   I=1,N
      IQARG1=(I-1)*K+IP
      IQARG2=(I-1)*K+M
170   Q(IQARG1)=Q(IQARG1)-RISJ*Q(IQARG2)
180   D(J)=D(J)-DIS*RISJ*RISJ 
C
C     END ORTHOGONALIZATION
C
190   IRANK=IS
200   CONTINUE
C
C     END STEP NUMBER     IS     INTHE DECOMPOSITION
C
      INSING=1
      RETURN
      END 
      SUBROUTINE DEFINE(X,N,XNEW)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT DEFINE
C
C     PURPOSE--THIS SUBROUTINE SETS ALL OF THE ELEMENTS
C              IN THE SINGLE PRECISION VECTOR X
C              EQUAL TO XNEW. 
C              THIS SUBROUTINE IS USEFUL IN DEFINING A
C              VECTOR OF CONSTANTS.
C              FOR EXAMPLE, IF THE DATA ANALYST WISHES
C              TO TREAT THE EQUAL WEIGHTS CASE IN DOING
C              A POLYNOMIAL REGRESSION, THIS COULD
C              BE DONE BY DEFINING AS, SAY, 1.0
C              THE INPUT WEIGHT VECTOR W TO THE
C              DATAPAC POLY SUBROUTINE; 
C              SUCH DEFINING COULD BE DONE
C              BY USE OF THE DEFINE SUBROUTINE
C              WITH XNEW = 1.0.
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                     --XNEW   = THE SINGLE PRECISION VALUE 
C                                TO WHICH ALL OF THE
C                                OBSERVATIONS IN THE VECTOR X
C                                WILL BE SET.
C     OUTPUT--THE SINGLE PRECISION VECTOR X
C             EVERY ELEMENT OF WHICH
C             WILL BE EQUAL TO XNEW.
C             ALSO, 3 LINES OF SUMMARY INFORMATION
C             WILL BE GENERATED INDICATING
C             1) WHAT THE SAMPLE SIZE WAS (N);
C             2) WHAT THE DEFINING CONSTANT WAS (XNEW);
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C     UPDATED  VERSION--JULY      1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      GOTO90
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
   90 CONTINUE
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 DEFINE SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE DEFINE SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      DO100I=1,N
      X(I)=XNEW
  100 CONTINUE
C
C     WRITE OUT A BRIEF SUMMARY
C
      WRITE(IPR,999)
      WRITE(IPR,101)
      WRITE(IPR,110)N
      WRITE(IPR,111)XNEW
  101 FORMAT(1H ,35HOUTPUT FROM THE DEFINE SUBROUTINE--)
  110 FORMAT(1H ,7X,38HTHE INPUT  NUMBER OF OBSERVATIONS  IS ,I6)
  111 FORMAT(1H ,7X,25HTHE DEFINING CONSTANT IS ,E15.8)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE DELETE(X,N,XMIN,XMAX,NEWN)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT DELETE
C
C     PURPOSE--THIS SUBROUTINE DELETES ALL OBSERVATIONS IN THE
C              SINGLE PRECISION VECTOR X WHICH ARE INSIDE
C              THE CLOSED (INCLUSIVE) INTERVAL
C              DEFINED BY XMIN AND XMAX,
C              WHILE RETAINING ALL OBSERVATIONS OUTSIDE OF
C              THIS INTERVAL. 
C              THUS ALL OBSERVATIONS IN X WHICH ARE LARGER
C              THAN OR EQUAL TO XMIN AND SMALLER THAN OR
C              EQUAL TO XMAX ARE DELETED FROM X.
C              THIS SUBROUTINE (AND THE 
C              REPLAC AND RETAIN SUBROUTINES)
C              GIVES THE DATA ANALYST THE ABILITY TO
C              EASILY 'CLEAN UP' A DATA SET WHICH HAS
C              MISSING AND/OR OUTLYING OBSERVATIONS
C              SO THAT A MORE APPROPRIATE SUBSEQUENT
C              DATA ANALYSIS MAY BE PERFORMED.
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                     --XMIN   = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES THE LOWER LIMIT
C                                (INCLUSIVELY) OF THE PARTICULAR
C                                INTERVAL OF INTEREST TO BE DELETED.
C                     --XMAX   = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES THE UPPER LIMIT
C                                (INCLUSIVELY) OF THE PARTICULAR
C                                INTERVAL OF INTEREST TO BE DELETED.
C     OUTPUT ARGUMENTS--NEWN   = THE INTEGER NUMBER OF OBSERVATIONS
C                                REMAINING IN X AFTER ALL
C                                OF THE OBSERVATIONS INSIDE 
C                                (INCLUSIVELY) THE INTERVAL 
C                                OF INTEREST HAVE BEEN DELETED.
C     OUTPUT--THE SINGLE PRECISION VECTOR X
C             IN WHICH ALL THOSE VALUES INSIDE
C             (INCLUSIVELY) THE INTERVAL OF INTEREST
C             HAVE BEEN DELETED, AND
C             THE INTEGER VALUE NEWN
C             WHICH GIVES THE NUMBER OF 
C             OBSERVATIONS REMAINING IN X.
C             ALSO, 6 LINES OF SUMMARY INFORMATION
C             WILL BE GENERATED INDICATING
C             1) WHAT THE INTERVAL OF INTEREST WAS;
C             2) HOW MANY OBSERVATIONS WERE DELETED;
C             3) WHAT THE OLD (ORIGINAL) SAMPLE SIZE WAS (N);
C             4) WHAT THE NEW SAMPLE SIZE IS (NEWN).
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--IN THE END, AFTER THIS SUBROUTINE HAS
C              MADE WHATEVER DELETIONS ARE APPROPRIATE,
C              THE OUTPUT VECTOR X WILL BE 'PACKED';
C              THAT IS, NO 'HOLES' WILL EXIST IN THE
C              VECTOR X--ALL OF THE RETAINED ELEMENTS
C              OF X WILL BE PACKED INTO THE FIRST AVAILABLE 
C              LOCATIONS IN X, WHILE THE REMAINDER
C              OF THE N LOCATIONS IN X WILL BE ZERO-FILLED. 
C     COMMENT--IN THE MAIN (CALLING) ROUTINE, IT IS
C              PERMISSABLE (IF THE ANALYST SO DESIRES)
C              TO USE THE SAME VARIABLE NAME
C              IN THE FIFTH ARGUMENT AS USED IN THE SECOND
C              ARGUMENT IN THE CALLING SEQUENCE TO THIS
C              DELETE SUBROUTINE--NO CONFLICT WILL RESULT
C              IN THE INTERNAL OPERATION OF THE     DELETE
C              SUBROUTINE.  FOR EXAMPLE, IT IS PERMISSIBLE
C              TO HAVE     CALL DELETE(X,N,-10.0,10.0,N)
C              IN WHICH THE VARIABLE NAME      N    IS USED 
C              AS BOTH THE SECOND AND FIFTH ARGUMENTS.
C     COMMENT--THIS IS ONE OF THE FEW SUBROUTINES IN DATAPAC
C              IN WHICH THE INPUT VECTOR X IS ALTERED.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JULY      1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE DELETE SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 DELETE SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE DELETE SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      POINTL=XMIN
      POINTU=XMAX
      IF(XMIN.GT.XMAX)POINTL=XMAX
      IF(XMIN.GT.XMAX)POINTU=XMIN
C
      NOLD=N
      K=0 
      DO100I=1,NOLD 
      IF(POINTL.LE.X(I).AND.X(I).LE.POINTU)GOTO100
      K=K+1
      X(K)=X(I)
  100 CONTINUE
      NEWN=K
      NDEL=NOLD-NEWN
C
      NEWNP1=NEWN+1 
      IF(NEWNP1.GT.NOLD)GOTO250
      DO200I=NEWNP1,NOLD
      X(I)=0.0
  200 CONTINUE
  250 CONTINUE
C
C     WRITE OUT A BRIEF SUMMARY
C
      WRITE(IPR,999)
      WRITE(IPR,101)
      WRITE(IPR,105)POINTL,POINTU
      WRITE(IPR,106)
      WRITE(IPR,107)
      WRITE(IPR,108)
      WRITE(IPR,110)NOLD
      WRITE(IPR,115)NEWN
      WRITE(IPR,120)NDEL
  101 FORMAT(1H ,35HOUTPUT FROM THE DELETE SUBROUTINE--)
  105 FORMAT(1H ,7X,25HALL OBSERVATIONS BETWEEN ,E15.8,5H AND ,E15.8) 
  106 FORMAT(1H ,7X,30H(INCLUSIVE) HAVE BEEN DELETED.)
  107 FORMAT(1H ,7X,41HALL OBSERVATIONS OUTSIDE OF THIS INTERVAL)
  108 FORMAT(1H ,7X,19HHAVE BEEN RETAINED.)
  110 FORMAT(1H ,7X,44HTHE INPUT  NUMBER OF OBSERVATIONS (IN X) IS ,I6)
  115 FORMAT(1H ,7X,44HTHE OUTPUT NUMBER OF OBSERVATIONS (IN X) IS ,I6)
  120 FORMAT(1H ,7X,44HTHE NUMBER OF OBSERVATIONS DELETED       IS ,I6)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE DEMOD(X,N,F) 
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT DEMOD
C
C     PURPOSE--THIS SUBROUTINE PERFORMS A COMPLEX DEMODULATION
C              ON THE DATA IN THE INPUT VECTOR X
C              AT THE INPUT DEMODULATION FREQUENCY = F.
C              THE COMPLEX DEMODULATION CONSISTS OF THE FOLLOWING--
C              1) AN AMPLITUDE VERSUS TIME PLOT;
C              2) A PHASE VERSUS TIME PLOT;
C              3) AN UPDATED DEMODULATION FREQUENCY ESTIMATE
C                 TO ASSIST THE ANALYST IN DETERMINING A
C                 MORE APPROPRIATE FREQUENCY AT WHICH
C                 TO DEMODULATE IN CASE THE SPECIFIED
C                 INPUT DEMODULATION FREQUENCY F
C                 DOES NOT FLATTEN SUFFICIENTLY THE
C                 PHASE PLOT. 
C
C              THE ALLOWABLE RANGE OF THE INPUT DEMODULATION
C              FREQUENCY F IS 0.0 TO 0.5 (EXCLUSIVELY).
C              THE INPUT DEMODULATION FREQUENCY F IS MEASURED  OF
C              IN UNITS OF CYCLES PER 'DATA POINT' OR,
C              MORE PRECISELY, IN CYCLES PER UNIT TIME WHERE
C              'UNIT TIME' IS DEFINED AS THE
C              ELAPSED TIME BETWEEN ADJACENT OBSERVATIONS.
C
C     INPUT ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED) OBSERVATIONS.
C                      N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR X.
C                      F      = THE SINGLE PRECISION
C                               DEMODULATION FREQUENCY.
C                               F IS IN UNITS OF CYCLES PER DATA POINT.
C                               F IS BETWEEN 0.0 AND 0.5 (EXCLUSIVELY).
C     OUTPUT--2 PAGES OF AUTOMATIC PRINTOUT--
C             1) AN AMPLITUDE PLOT;
C             2) A PHASE PLOT; AND
C             3) AN UPDATED DEMODULATION FREQUENCY ESTIMATE.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 5000.
C                 --THE SAMPLE SIZE N MUST BE GREATER
C                   THAN OR EQUAL TO 3. 
C                 --THE INPUT FREQUENCY F MUST BE 
C                   GREATER THAN OR EQUAL TO 2/(N-2).
C                 --THE INPUT FREQUENCY F MUST BE 
C                   SMALLER THAN 0.5.
C     OTHER DATAPAC   SUBROUTINES NEEDED--PLOTX.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, SIN, COS, ATAN.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--IN ORDER THAT THE RESULTS OF THE COMPLEX DEMODULATION
C              BE VALID AND PROPERLY INTERPRETED, THE INPUT DATA
C              IN X SHOULD BE EQUI-SPACED IN TIME 
C              (OR WHATEVER VARIABLE CORRESPONDS TO TIME).
C            --IF THE INPUT OBSERVATIONS IN X ARE CONSIDERED
C              TO HAVE BEEN COLLECTED 1 SECOND APART IN TIME,
C              THEN THE DEMODULATION FREQUENCY F
C              WOULD BE IN UNITS OF HERTZ
C              (= CYCLES PER SECOND).
C            --A FREQUENCY OF 0.0 CORRESPONDS TO A CYCLE
C              IN THE DATA OF INFINITE (= 1/(0.0))
C              LENGTH OR PERIOD.
C              A FREQUENCY OF 0.5 CORRESPONDS TO A CYCLE
C              IN THE DATA OF LENGTH = 1/(0.5) = 2 DATA POINTS.
C            --IN EXAMINING THE AMPLITUDE AND PHASE PLOTS,
C              ATTENTION SHOULD BE PAID NOT ONLY TO THE
C              STRUCTURE OF THE PHASE PLOT
C              (NEAR-ZERO SLOPE VERSUS NON-ZERO SLOPE)
C              BUT ALSO TO THE RANGE
C              OF VALUES ON THE VERTICAL AXIS.
C              A PLOT WITH MUCH STRUCTURE BUT
C              WITH A SMALL RANGE ON THE VERTICAL AXIS
C              IS USUALLY MORE INDICATIVE OF A
C              DEFINITE CYCLIC COMPONENT AT THE
C              SPECIFIED INPUT DEMODULATION FREQUENCY,
C              THAN IS A PLOT WITH LESS STRUCTURE BUT
C              A WIDER RANGE ON THE VERTICAL AXIS.
C            --INTERNAL TO THIS SUBROUTINE, 2 MOVING
C              AVERAGES ARE APPLIED, EACH OF LENGTH 1/F.
C              HENCE THE AMPLITUDE AND PHASE PLOTS
C              HAVE N - 2/F VALUES
C              (RATHER THAN N VALUES) ALONG THE
C              HORIZONTAL (TIME) AXIS.
C              IN ORDER THAT THE AMPLITUDE AND PHASE
C              PLOTS BE NON-EMPTY, AN INPUT
C              REQUIREMENT ON F FOR THIS SUBROUTINE
C              IS THAT THE SAMPLE SIZE N
C              AND THE DEMODULATION FREQUENCY F
C              MUST BE SUCH THAT
C              N - 2/F BE GREATER THAN ZERO.
C              FURTHER, SINCE A PLOT WITH BUT
C              1 POINT IS MEANINGLESS
C              AND OUGHT ALSO BE EXCLUDED,
C              THE REQUIREMENT IS EXTENDED
C              SO THAT N - 2/F MUST BE GREATER THAN 1.
C     REFERENCES--GRANGER AND HATANAKA, PAGES 170 TO 189,
C                 ESPECIALLY PAGES 173, 177, AND 182.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1972. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y1(5000),Y2(5000),Z(5000)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y1(1),WS(1)),(Y2(1),WS(5001)),(Z(1),WS(10001))
      DATA PI/3.141592653/
C
      IPR=6
      ILOWER=3
      IUPPER=5000
      AN=N
      FMIN=2.0/(AN-2.0)
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.ILOWER.OR.N.GT.IUPPER)GOTO50
      IF(F.LE.FMIN.OR.F.GE.0.5)GOTO60
      HOLD=X(1)
      DO65I=2,N
      IF(X(I).NE.HOLD)GOTO90
   65 CONTINUE
      WRITE(IPR, 9)HOLD
      RETURN
   50 WRITE(IPR,17)ILOWER,IUPPER
      WRITE(IPR,47)N
      RETURN
   60 WRITE(IPR,27)FMIN
      WRITE(IPR,46)F
      WRITE(IPR,28)FMIN,N
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE DEMOD  SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 96H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 DEMOD  SUBROUTINE IS OUTSIDE THE ALLOWABLE (,I6,1H,,I6,16H) INTER
     1VAL *****)
   27 FORMAT(1H , 96H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE
     1 DEMOD  SUBROUTINE IS OUTSIDE THE ALLOWABLE (,F10.8,6H,0.5) ,
     1 14HINTERVAL *****)
   28 FORMAT(1H ,42H                   THE ABOVE LOWER LIMIT (,F10.8, 
     1 46H) = 2/(N-2) WHERE N = THE INPUT SAMPLE SIZE = ,I8)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
C     FORM THE COSINE AND SINE SERIES
C
      DO100I=1,N
      AI=I
      Y1(I)=X(I)*COS(6.2831853*F*AI)
      Y2(I)=X(I)*SIN(6.2831853*F*AI)
  100 CONTINUE
C
C     DEFINE THE LENGTH OF THE 2 MOVING AVERAGES
C
      LENMA1=1.0/F
      LENMA2=1.0/F
      ALEN1=LENMA1
      ALEN2=LENMA2
      IMAX1=N-LENMA1
      IMAX2=IMAX1-LENMA2
C
C     FORM THE FIRST MOVING AVERAGE FOR THE COSINE SERIES
C
      DO200I=1,IMAX1
      ISTART=I+1
      IEND=I+LENMA1-1
      IENDP1=I+LENMA1
      SUM=0.0
      DO300J=ISTART,IEND
      SUM=SUM+Y1(J) 
  300 CONTINUE
      SUM=SUM+Y1(I)/2.0+Y1(IENDP1)/2.0
      Z(I)=SUM/ALEN1
  200 CONTINUE
C
C     FORM THE SECOND MOVING AVERAGE FOR THE COSINE SERIES
C
      DO400I=1,IMAX2
      ISTART=I+1
      IEND=I+LENMA2-1
      IENDP1=I+LENMA2
      SUM=0.0
      DO500J=ISTART,IEND
      SUM=SUM+Z(J)
  500 CONTINUE
      SUM=SUM+Z(I)/2.0+Z(IENDP1)/2.0
      Y1(I)=SUM/ALEN2
  400 CONTINUE
C
C     FORM THE FIRST MOVING AVERAGE FOR THE SINE SERIES
C
      DO800I=1,IMAX1
      ISTART=I+1
      IEND=I+LENMA1-1
      IENDP1=I+LENMA1
      SUM=0.0
      DO900J=ISTART,IEND
      SUM=SUM+Y2(J) 
  900 CONTINUE
      SUM=SUM+Y2(I)/2.0+Y2(IENDP1)/2.0
      Z(I)=SUM/ALEN1
  800 CONTINUE
C
C     FORM THE SECOND MOVING AVERAGE FOR THE SINE SERIES
C
      DO1000I=1,IMAX2
      ISTART=I+1
      IEND=I+LENMA1-1
      IENDP1=I+LENMA1
      SUM=0.0
      DO1100J=ISTART,IEND
      SUM=SUM+Z(J)
 1100 CONTINUE
      SUM=SUM+Z(I)/2.0+Z(IENDP1)/2.0
      Y2(I)=SUM/ALEN2
 1000 CONTINUE
C
C
C     FORM THE AMPLITUDES AND PLOT THEM 
C
      DO1500I=1,IMAX2
      Z(I)=2.0*SQRT(Y1(I)*Y1(I)+Y2(I)*Y2(I))
 1500 CONTINUE
      CALL PLOTX(Z,IMAX2)
      WRITE(IPR,2005)F
C
C     COMPUTE THE DIFFERENCE BETWEEN THE MAX AND MIN AMPLITUDES AND WRITE IT OUT
C
      ZMIN=Z(1)
      ZMAX=Z(1)
      DO1600I=1,IMAX2
      IF(Z(I).LT.ZMIN)ZMIN=Z(I)
      IF(Z(I).GT.ZMAX)ZMAX=Z(I)
 1600 CONTINUE
      RANGE=ZMAX-ZMIN
      WRITE(IPR,2010)ZMIN,ZMAX,RANGE
C
C     FORM THE PHASES AND PLOT THEM
C
      DO1700I=1,IMAX2
      Z(I)=ATAN(Y1(I)/Y2(I))
 1700 CONTINUE
      CALL PLOTX(Z,IMAX2)
      WRITE(IPR,2020)F
C
C     COMPUTE A NEW ESTIMATE FOR THE DEMODULATION FREQUENCY AND WRITE IT OUT
C
      AIMAX2=IMAX2
      IMAX2M=IMAX2-1
      IFLAG=0
      ZMIN=Z(1)
      ZMAX=Z(1)
      DO1800I=1,IMAX2M
      IP1=I+1
      DEL=Z(IP1)-Z(I)
      IF(DEL.GT.2.5)IFLAG=IFLAG-1
      IF(DEL.LT.-2.5)IFLAG=IFLAG+1
      AIFLAG=IFLAG
      ZNEW=Z(IP1)+AIFLAG*PI
      IF(ZNEW.LT.ZMIN)ZMIN=ZNEW
      IF(ZNEW.GT.ZMAX)ZMAX=ZNEW
 1800 CONTINUE
      RANGE=ZMAX-ZMIN
      SLOPER=RANGE/AIMAX2
      SLOPEH=SLOPER/(2.0*PI)
      FEST=F+SLOPEH 
      WRITE(IPR,2025)ZMIN,ZMAX,RANGE
      WRITE(IPR,2030)SLOPER,SLOPEH,FEST 
C
 2005 FORMAT(1H ,30X, 48HAMPLITUDE PLOT FOR THE DEMODULATION FREQUENCY =
     1 ,F8.6,21H CYCLES PER UNIT TIME)
 2010 FORMAT(1H ,9X,20HMINIMUM AMPLITUDE = ,E15.8,5X,20HMAXIMUM AMPLITUD
     1E = ,E15.8,5X,22HRANGE OF AMPLITUDES = ,E15.8)
 2020 FORMAT(1H ,32X, 44HPHASE PLOT FOR THE DEMODULATION FREQUENCY = ,F8
     1.6,21H CYCLES PER UNIT TIME)
 2025 FORMAT(1H ,3X,16HMINIMUM PHASE = ,E15.8,11H RADIANS   ,16HMAXIMUM
     1PHASE = ,E15.8,11H RADIANS   ,18HRANGE OF PHASES = ,E15.8,8H RADIA
     1NS) 
 2030 FORMAT(1H ,8HSLOPE = ,E14.8,11H RADIANS = ,E14.6,52H CYCLES PER UN
     1IT TIME    EST. OF NEW DEMOD. FREQ. = ,E15.8,15H CYC./UNIT TIME)
C
      RETURN
      END 
      SUBROUTINE DEXCDF(X,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT DEXCDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE FOR THE DOUBLE EXPONENTIAL
C              (LAPLACE) DISTRIBUTION WITH MEAN = 0 AND
C              STANDARD DEVIATION = SQRT(2).
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = 0.5*EXP(-ABS(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--EXP.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--2, 1970, PAGES 22-36.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS.
C     NO INPUT ARGUMENT ERRORS POSSIBLE 
C     FOR THIS DISTRIBUTION.
C
C-----START POINT-----------------------------------------------------
C
      IF(X.LE.0.0)CDF=0.5*EXP(X)
      IF(X.GT.0.0)CDF=1.0-(0.5*EXP(-X)) 
C
      RETURN
      END 
      SUBROUTINE DEXPDF(X,PDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT DEXPDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY
C              FUNCTION VALUE FOR THE DOUBLE EXPONENTIAL
C              (LAPLACE) DISTRIBUTION WITH MEAN = 0 AND
C              STANDARD DEVIAITON = SQRT(2).
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = 0.5*EXP(-ABS(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--EXP.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--2, 1970, PAGES 22-36.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --SEPTEMBER 1978. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS.
C     NO INPUT ARGUMENT ERRORS POSSIBLE 
C     FOR THIS DISTRIBUTION.
C
C-----START POINT-----------------------------------------------------
C
      ARG=X
      IF(X.LT.0.0)ARG=-X
      PDF=0.5*EXP(-ARG)
C
      RETURN
      END 
      SUBROUTINE DEXPLT(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT DEXPLT
C
C     PURPOSE--THIS SUBROUTINE GENERATES A DOUBLE EXPONENTIAL (LAPLACE)
C              PROBABILITY PLOT.
C              THE PROTOTYPE DOUBLE EXPONENTIAL DISTRIBUTION USED HEREIN
C              HAS MEAN = 0 AND STANDARD DEVIATION = SQRT(2).
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = 0.5 * EXP(-ABS(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 DOUBLE EXPONENTIAL 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 DOUBLE EXPONENTIAL 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--A ONE-PAGE DOUBLE EXPONENTIAL PROBABILITY PLOT.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, PLOT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
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--2, 1970, PAGES 22-36.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(7500),W(7500)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501))
C
      DATA TAU/1.76862179/
C
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE DEXPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 DEXPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE DEXPLT SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     SORT THE DATA 
C
      CALL SORT(X,N,Y)
C
C     GENERATE UNIFORM ORDER STATISTIC MEDIANS
C
      CALL UNIMED(N,W)
C
C     COMPUTE DOUBLE EXPONENTIAL ORDER STATISTIC MEDIANS
C
      DO100I=1,N
      Q=W(I)
      IF(Q.LE.0.5)W(I)=ALOG(2.0*Q)
      IF(Q.GT.0.5)W(I)=-ALOG(2.0*(1.0-Q))
  100 CONTINUE
C
C     PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS.
C     WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION 
C     AND THE SAMPLE SIZE.
C
      CALL PLOT(Y,W,N)
      WRITE(IPR,105)TAU,N
C
C     COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. 
C     COMPUTE LOCATION AND SCALE ESTIMATES
C     FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. 
C     THEN WRITE THEM OUT.
C
      SUM1=0.0
      DO200I=1,N
      SUM1=SUM1+Y(I)
  200 CONTINUE
      YBAR=SUM1/AN
      WBAR=0.0
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO300I=1,N
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) 
      SUM2=SUM2+W(I)*Y(I)
      SUM3=SUM3+W(I)*W(I)
  300 CONTINUE
      CC=SUM2/SQRT(SUM3*SUM1) 
      YSLOPE=SUM2/SUM3
      YINT=YBAR-YSLOPE*WBAR
      WRITE(IPR,305)CC,YINT,YSLOPE
C
  105 FORMAT(1H ,43HDOUBLE EXPONENTIAL PROBABILITY PLOT (TAU = ,E15.8,1H
     1),44X,20HTHE SAMPLE SIZE N = ,I7) 
  305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X,
     122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) 
C
      RETURN
      END 
      SUBROUTINE DEXPPF(P,PPF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT DEXPPF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE FOR THE DOUBLE EXPONENTIAL
C              (LAPLACE) DISTRIBUTION WITH MEAN = 0 AND
C              STANDARD DEVIATION = SQRT(2).
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = 0.5*EXP(-ABS(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--ALOG.
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--2, 1970, PAGES 22-36.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LE.0.0.OR.P.GE.1.0)GOTO50
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 DEXPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      IF(P.LE.0.5)PPF=ALOG(2.0*P)
      IF(P.GT.0.5)PPF=-ALOG(2.0*(1.0-P))
C
      RETURN
      END 
      SUBROUTINE DEXRAN(N,ISTART,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT DEXRAN
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE DOUBLE EXPONENTIAL
C              (LAPLACE) DISTRIBUTION WITH MEAN = 0 AND
C              STANDARD DEVIATION = SQRT(2).
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = 0.5*EXP(-ABS(X)). 
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER 
C                                OF RANDOM NUMBERS TO BE
C                                GENERATED.
C                     --ISTART = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL START THE
C                                GENERATOR OVER AND HENCE
C                                PRODUCE THE SAME RANDOM SAMPLE
C                                OVER AND OVER AGAIN
C                                UPON SUCCESSIVE CALLS TO
C                                THIS SUBROUTINE WITHIN A RUN; OR
C                                (IF SET TO SOME INTEGER
C                                VALUE NOT EQUAL TO 0,
C                                LIKE, SAY, 1) WILL ALLOW
C                                THE GENERATOR TO CONTINUE
C                                FROM WHERE IT STOPPED
C                                AND HENCE PRODUCE DIFFERENT
C                                RANDOM SAMPLES UPON
C                                SUCCESSIVE CALLS TO
C                                THIS SUBROUTINE WITHIN A RUN.
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 DOUBLE EXPONENTIAL
C             (LAPLACE) DISTRIBUTION WITH MEAN = 0 AND
C             STANDARD DEVIATION = SQRT(2).
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--ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--TOCHER, THE ART OF SIMULATION,
C                 1963, PAGES 14-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--2, 1970, PAGES 22-36.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      GOTO90
   50 WRITE(IPR, 5) 
      WRITE(IPR,47)N
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 DEXRAN SUBROUTINE IS NON-POSITIVE *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
C
      CALL UNIRAN(N,ISTART,X) 
C
C     GENERATE N DOUBLE EXPONENTIAL RANDOM NUMBERS
C     USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD.
C
      DO100I=1,N
      Q=X(I)
      IF(Q.LE.0.5)X(I)=ALOG(2.0*Q)
      IF(Q.GT.0.5)X(I)=-ALOG(2.0*(1.0-Q))
  100 CONTINUE
C
      RETURN
      END 
      SUBROUTINE DEXSF(P,SF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT DEXSF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE SPARSITY
C              FUNCTION VALUE FOR THE DOUBLE EXPONENTIAL
C              (LAPLACE) DISTRIBUTION WITH MEAN = 0 AND
C              STANDARD DEVIATION = SQRT(2).
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = 0.5*EXP(-ABS(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--NONE.
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--2, 1970, PAGES 22-36.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LE.0.0.OR.P.GE.1.0)GOTO50
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 DEXSF  SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      IF(P.LE.0.5)SF=1.0/P
      IF(P.GT.0.5)SF=1.0/(1.0-P)
C
      RETURN
      END 
      SUBROUTINE DISCR2(X,N,NUMCLA,Y)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT DISCR2
C
C     PURPOSE--THIS SUBROUTINE 'DISCRETIZES' THE DATA
C              OF THE SINGLE PRECISION VECTOR X
C              INTO NUMCLA CLASSES.
C              ALL VALUES IN THE VECTOR X WITHIN A GIVEN CLASS
C              WILL BE MAPPED INTO THE MIDPOINT OF THAT CLASS.
C              THE SAMPLE MINIMUM AND SAMPLE MAXIMUM
C              ARE AUTOMATICALLY COMPUTED INTERNALLY
C              AND THE CLASS WIDTH (XDEL) IS COMPUTED AS
C              THE (SAMPLE MAX - SAMPLE MIN)/NUMCLA.
C              THE FIRST CLASS INTERVAL IS FROM
C              THE SAMPLE MIN TO THE SAMPLE MIN + XDEL;
C              THE SECOND CLASS INTERVAL IS FROM
C              THE SAMPLE MIN + XDEL TO 
C              THE SAMPLE MIN + 2*XDEL; 
C              ...; 
C              THE LAST CLASS INTERVAL IS FROM
C              THE SAMPLE MAX - XDEL TO THE SAMPLE MAX.
C              THE USE OF THIS SUBROUTINE
C              (AND THE DISCRE AND DISCR3 SUBROUTINES)
C              GIVES THE DATA ANALYST THE CAPABILITY OF
C              CONSTRUCTING A DISCRETE VARIATE FROM
C              A CONTINUOUS ONE.
C              THE RESULTING DISCRETE VARIATE MIGHT THEN
C              (FOR EXAMPLE) BE ANALYZED IN ITSELF FOR
C              GROSS STRUCTURE, OR FOR ADHERENCE TO SOME
C              THEROETICAL DISCRETE PROBABILITY MODEL,
C              OR THE DISCRETE VARIATE MIGHT BE USED
C              AS A SUBSET DEFINITION VECTOR FOR SOME
C              OTHER VARIATE. 
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                                (UNSORTED OR SORTED) OBSERVATIONS.
C                                TO BE DISCRETIZED.
C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR X. 
C                     --NUMLEV = THE INTEGER NUMBER OF CLASSES
C                                DESIRED IN THE DISCRETIZATION.
C     OUTPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
C                                DISCRETIZED VALUES (= THE CLASS
C                                MIDPOINTS) CORRESPONDING TO
C                                THE CONTINUOUS VALUES IN THE VECTOR X.
C                                THERE WILL RESULT N SUCH DISCRETIZED 
C                                VALUES.
C     OUTPUT--THE SINGLE PRECISION VECTOR Y
C             WHICH CONTAINS N DISCRETIZED VALUES 
C             (= THE CLASS MIDPOINTS)
C             CORRESPONDING TO THE N
C             CONTINUOUS VALUES IN THE
C             INPUT VECTOR X. 
C             ALSO, (NUMCLA+5) LINES OF SUMMARY INFORMATION 
C             WILL BE GENERATED INDICATING
C             1) WHAT THE SAMPLE SIZE IS (N);
C             2) WHAT THE NUMBER OF CLASSES IS (NUMCLA).
C             3) WHAT THE CLASS BOUNDARIES AND
C                THE NUMBER OF OBSERVATIONS
C                FALLING IN EACH CLASS ARE.
C     PRINTING--YES 
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C                 --NUMCLA SHOULD BE POSITIVE AND NOT EXCEED 1000
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--THIS SUBROUTINE DIFFERS FROM THE DISCR3
C              SUBROUTINE INASMUCH AS THIS SUBROUTINE
C              PERFORMS ITS DISCRETIZATION BY OUTPUTING
C              CLASS MIDPOINTS, WHEREAS THE DISCR3
C              SUBROUTINE OUTPUTS CLASS NUMBERS
C              (1, 2, ... , NUMCLA).
C     COMMENT--THE INPUT VECTOR X REMAINS UNALTERED.
C     COMMENT--IN THE MAIN (CALLING) ROUTINE, IT IS
C              PERMISSABLE (IF THE ANALYST SO DESIRES)
C              TO USE THE SAME VARIABLE NAME
C              IN THE FOURTH ARGUMENT AS USED IN THE FIRST
C              ARGUMENT IN THE CALLING SEQUENCE TO THIS
C              DISCR2 SUBROUTINE--NO CONFLICT WILL RESULT
C              IN THE INTERNAL OPERATION OF THE     DISCR2
C              SUBROUTINE.  FOR EXAMPLE, IT IS PERMISSIBLE
C              TO HAVE        CALL DISCR2(X,N,10,X)
C              IN WHICH THE VARIABLE NAME      X    IS USED 
C              AS BOTH THE FIRST AND FOURTH ARGUMENTS.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1974. 
C     UPDATED         --APRIL     1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1),Y(1)
      DIMENSION ICOUNT(1000)
      DIMENSION CLASSM(1000)
C
      IPR=6
      IUPNCL=1000
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      IF(NUMCLA.LT.1.OR.NUMCLA.GT.IUPNCL)GOTO70
      IF(NUMCLA.EQ.1)GOTO80
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      DO65I=1,N
      Y(I)=X(I)
   65 CONTINUE
      RETURN
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      Y(1)=X(1)
      RETURN
   70 WRITE(IPR,27)IUPNCL
      WRITE(IPR,47)NUMCLA
      DO71I=1,N
      Y(I)=0.0
   71 CONTINUE
      RETURN
   80 WRITE(IPR,28) 
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE DISCR2 SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 DISCR2 SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE DISCR2 SUBROUTINE HAS THE VALUE 1 *****)
   27 FORMAT(1H , 98H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 DISCR2 SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   28 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE THIRD  INPUT ARGUME
     1NT TO THE DISCR2 SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      ANUML=NUMCLA
C
C     ZERO OUT THE COUNT VECTOR (ICOUNT)
C
      DO100I=1,NUMCLA
      ICOUNT(I)=0
  100 CONTINUE
C
C     COMPUTE THE SAMPLE MINIMUM AND MAXIMUM,
C     THEN COMPUTE THE CLASS WIDTH.
C
      XMIN=X(1)
      XMAX=X(1)
      DO200I=1,N
      IF(X(I).LT.XMIN)XMIN=X(I)
      IF(X(I).GT.XMAX)XMAX=X(I)
  200 CONTINUE
      XDEL=(XMAX-XMIN)/ANUML
C
C     COMPUTE THE CLASS MIDPOINT FOR EACH CLASS
C
      DO300I=1,NUMCLA
      AI=I
      CLASSM(I)=XMIN+(AI-0.5)*XDEL
  300 CONTINUE
C
C     PERFORM THE DISCRETIZING TRANSFORMATION.
C     ALSO, KEEP A FREQUENCY COUNT FOR EACH CLASS.
C
      DO400I=1,N
      P=(X(I)-XMIN)/(XMAX-XMIN)
      P=P*ANUML+1.0 
      IP=P
      IF(IP.LT.1)IP=1
      IF(IP.GT.NUMCLA)IP=NUMCLA
      Y(I)=CLASSM(IP)
      ICOUNT(IP)=ICOUNT(IP)+1 
  400 CONTINUE
C
C     COMPUTE CLASS LIMITS AND WRITE OUT SUMMARY INFORMATION.
C
      WRITE(IPR,999)
      WRITE(IPR,501)
      WRITE(IPR,999)
      WRITE(IPR,502)N
      WRITE(IPR,508)NUMCLA
      WRITE(IPR,503)XMIN
      WRITE(IPR,504)XDEL
      WRITE(IPR,505)XMAX
      WRITE(IPR,999)
      WRITE(IPR,510)
      WRITE(IPR,997)
      DO500I=1,NUMCLA
      AI=I
      CMIN=XMIN+(AI-1.0)*XDEL 
      CMAX=XMIN+AI*XDEL
      WRITE(IPR,520)I,CMIN,CLASSM(I),CMAX,ICOUNT(I)
  500 CONTINUE
C
  501 FORMAT(1H ,35HOUTPUT FROM THE DISCR2 SUBROUTINE--)
  502 FORMAT(1H ,7X,36HNUMBER OF OBSERVATIONS            = ,I8)
  503 FORMAT(1H ,7X,36HCOMPUTED  LOWER BOUND OF INTERVAL = ,F15.7)
  504 FORMAT(1H ,7X,36HCOMPUTED  CLASS WIDTH             = ,F15.7)
  505 FORMAT(1H ,7X,36HCOMPUTED  UPPER BOUND OF INTERVAL = ,F15.7)
  508 FORMAT(1H ,7X,36HSPECIFIED NUMBER OF LEVELS        = ,I8)
  510 FORMAT(1H ,52H       CLASS     MINIMUM       MIDPOINT      MAXIMUM
     1,11H      COUNT)
  520 FORMAT(1H ,4X,I6,2X,3F14.7,I8)
  997 FORMAT(1H ,50H       -------------------------------------------,
     1 13H-------------)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE DISCR3(X,N,NUMCLA,Y)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT DISCR3
C
C     PURPOSE--THIS SUBROUTINE 'DISCRETIZES' THE DATA
C              ON THE SINGLE PRECISION VECTOR X
C              INTO NUMCLA CLASSES.
C              ALL VALUES IN THE VECTOR X WITHIN A GIVEN CLASS
C              WILL BE MAPPED INTO THE CLASS NUMBER
C              (1, 2, ... , NUMCLA).
C              THUS ALL THE ELEMENTS IN THE LOWERMOST CLASS 
C              WILL BE MAPPED INTO THE VALUE 1.0; 
C              ALL THE ELEMENTS OF X IN THE NEXT HIGHER CLASS
C              WILL BE MAPPED INTO 2.0; 
C              ETC. 
C              THE SAMPLE MINIMUM AND SAMPLE MAXIMUM
C              ARE AUTOMATICALLY COMPUTED INTERNALLY
C              AND THE CLASS WIDTH (XDEL) IS COMPUTED AS
C              THE (SAMPLE MAX - SAMPLE MIN)/NUMCLA.
C              THE FIRST CLASS INTERVAL IS FROM
C              THE SAMPLE MIN TO THE SAMPLE MIN + XDEL;
C              THE SECOND CLASS INTERVAL IS FROM
C              THE SAMPLE MIN + XDEL TO 
C              THE SAMPLE MIN + 2*XDEL; 
C              ...; 
C              THE LAST CLASS INTERVAL IS FROM
C              THE SAMPLE MAX - XDEL TO THE SAMPLE MAX.
C              THE USE OF THIS SUBROUTINE
C              (AND THE DISCRE AND DISCR2 SUBROUTINES)
C              GIVES THE DATA ANALYST THE CAPABILITY OF
C              CONSTRUCTING A DISCRETE VARIATE FROM
C              A CONTINUOUS ONE.
C              THE RESULTING DISCRETE VARIATE MIGHT THEN
C              (FOR EXAMPLE) BE ANALYZED IN ITSELF FOR
C              GROSS STRUCTURE, OR FOR ADHERENCE TO SOME
C              THEROETICAL DISCRETE PROBABILITY MODEL,
C              OR THE DISCRETE VARIATE MIGHT BE USED
C              AS A SUBSET DEFINITION VECTOR FOR SOME
C              OTHER VARIATE. 
C              THIS DISCR3 SUBROUTINE IS PARTICULARLY
C              SUITED TO THIS LAST PURPOSE INASMUCH
C              AS IT OUTPUT'S 1'S, 2'S, ETC.
C              RATHER THAN MIDPOINTS.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                                (UNSORTED OR SORTED) OBSERVATIONS.
C                                TO BE DISCRETIZED.
C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR X. 
C                     --NUMLEV = THE INTEGER NUMBER OF CLASSES
C                                DESIRED IN THE DISCRETIZATION.
C     OUTPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
C                                DISCRETIZED VALUES CORRESPONDING TO
C                                THE CONTINUOUS VALUES IN THE VECTOR X.
C                                THERE WILL RESULT N SUCH DISCRETIZED 
C                                VALUES.
C     OUTPUT--THE SINGLE PRECISION VECTOR Y
C             WHICH CONTAINS N DISCRETIZED VALUES 
C             CORRESPONDING TO THE N
C             CONTINUOUS VALUES IN THE
C             INPUT VECTOR X. 
C             ALSO, (NUMCLA+5) LINES OF SUMMARY INFORMATION 
C             WILL BE GENERATED INDICATING
C             1) WHAT THE SAMPLE SIZE IS (N);
C             2) WHAT THE NUMBER OF CLASSES IS (NUMCLA).
C             3) WHAT THE CLASS BOUNDARIES AND
C                THE NUMBER OF OBSERVATIONS
C                FALLING IN EACH CLASS ARE.
C     PRINTING--YES 
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C                 --NUMCLA SHOULD BE POSITIVE AND NOT EXCEED 1000
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--THIS SUBROUTINE DIFFERS FROM THE DISCR2
C              SUBROUTINE INASMUCH AS THIS SUBROUTINE
C              PERFORMS ITS DISCRETIZATION BY OUTPUTING
C              CLASS NUMBERS (1, 2,, ..., NUMCLA);
C              WHEREAS THE DISCR2 SUBROUTINE
C              OUTPUTS CLASS MIDPOINTS. 
C     COMMENT--THE INPUT VECTOR X REMAINS UNALTERED.
C     COMMENT--IN THE MAIN (CALLING) ROUTINE, IT IS
C              PERMISSABLE (IF THE ANALYST SO DESIRES)
C              TO USE THE SAME VARIABLE NAME
C              IN THE FOURTH ARGUMENT AS USED IN THE FIRST
C              ARGUMENT IN THE CALLING SEQUENCE TO THIS
C              DISCR3 SUBROUTINE--NO CONFLICT WILL RESULT
C              IN THE INTERNAL OPERATION OF THE     DISCR3
C              SUBROUTINE.  FOR EXAMPLE, IT IS PERMISSIBLE
C              TO HAVE        CALL DISCR3(X,N,10,X)
C              IN WHICH THE VARIABLE NAME      X    IS USED 
C              AS BOTH THE FIRST AND FOURTH ARGUMENTS.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1974. 
C     UPDATED         --APRIL     1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1),Y(1)
      DIMENSION ICOUNT(1000)
C
      IPR=6
      IUPNCL=1000
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      IF(NUMCLA.LT.1.OR.NUMCLA.GT.IUPNCL)GOTO70
      IF(NUMCLA.EQ.1)GOTO80
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      DO65I=1,N
      Y(I)=X(I)
   65 CONTINUE
      RETURN
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      Y(1)=X(1)
      RETURN
   70 WRITE(IPR,27)IUPNCL
      WRITE(IPR,47)NUMCLA
      DO71I=1,N
      Y(I)=0.0
   71 CONTINUE
      RETURN
   80 WRITE(IPR,28) 
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE DISCR3 SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 DISCR3 SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE DISCR3 SUBROUTINE HAS THE VALUE 1 *****)
   27 FORMAT(1H , 98H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 DISCR3 SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   28 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE THIRD  INPUT ARGUME
     1NT TO THE DISCR3 SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      ANUML=NUMCLA
C
C     ZERO OUT THE COUNT VECTOR (ICOUNT)
C
      DO100I=1,NUMCLA
      ICOUNT(I)=0
  100 CONTINUE
C
C     COMPUTE THE SAMPLE MINIMUM AND MAXIMUM,
C     THEN COMPUTE THE CLASS WIDTH.
C
      XMIN=X(1)
      XMAX=X(1)
      DO200I=1,N
      IF(X(I).LT.XMIN)XMIN=X(I)
      IF(X(I).GT.XMAX)XMAX=X(I)
  200 CONTINUE
      XDEL=(XMAX-XMIN)/ANUML
C
C     PERFORM THE DISCRETIZING TRANSFORMATION.
C     ALSO, KEEP A FREQUENCY COUNT FOR EACH CLASS.
C
      DO400I=1,N
      P=(X(I)-XMIN)/(XMAX-XMIN)
      P=P*ANUML+1.0 
      IP=P
      IF(IP.LT.1)IP=1
      IF(IP.GT.NUMCLA)IP=NUMCLA
      Y(I)=IP
      ICOUNT(IP)=ICOUNT(IP)+1 
  400 CONTINUE
C
C     COMPUTE CLASS LIMITS AND WRITE OUT SUMMARY INFORMATION.
C
      WRITE(IPR,999)
      WRITE(IPR,501)
      WRITE(IPR,999)
      WRITE(IPR,502)N
      WRITE(IPR,508)NUMCLA
      WRITE(IPR,503)XMIN
      WRITE(IPR,504)XDEL
      WRITE(IPR,505)XMAX
      WRITE(IPR,999)
      WRITE(IPR,510)
      WRITE(IPR,997)
      DO500I=1,NUMCLA
      AI=I
      CMIN=XMIN+(AI-1.0)*XDEL 
      CMAX=XMIN+AI*XDEL
      WRITE(IPR,520)I,CMIN,CMAX,ICOUNT(I)
  500 CONTINUE
C
  501 FORMAT(1H ,35HOUTPUT FROM THE DISCR3 SUBROUTINE--)
  502 FORMAT(1H ,7X,36HNUMBER OF OBSERVATIONS            = ,I8)
  503 FORMAT(1H ,7X,36HCOMPUTED  LOWER BOUND OF INTERVAL = ,F15.7)
  504 FORMAT(1H ,7X,36HCOMPUTED  CLASS WIDTH             = ,F15.7)
  505 FORMAT(1H ,7X,36HCOMPUTED  UPPER BOUND OF INTERVAL = ,F15.7)
  508 FORMAT(1H ,7X,36HSPECIFIED NUMBER OF LEVELS        = ,I8)
  510 FORMAT(1H ,49H       LEVEL     MINIMUM       MAXIMUM      COUNT)
  520 FORMAT(1H ,4X,I6,2X,2F14.7,I8)
  997 FORMAT(1H ,49H       ------------------------------------------)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE DISCRE(X,N,XMIN,XDEL,XMAX,Y)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT DISCRE
C
C     PURPOSE--THIS SUBROUTINE 'DISCRETIZES' THE DATA
C              OF THE SINGLE PRECISION VECTOR X.
C              THE FIRST CLASS INTERVAL IS FROM
C              XMIN TO XMIN + XDEL;
C              THE SECOND CLASS INTERVAL IS FROM
C              XMIN+ XDEL TO XMIN + 2*XDEL;
C              ETC. 
C              ALL VALUES IN THE VECTOR X WITHIN A GIVEN CLASS
C              WILL BE MAPPED INTO THE MIDPOINT OF THAT CLASS.
C              ALL VALUES IN THE VECTOR X SMALLER THAN XMIN 
C              WILL BE MAPPED INTO XMIN - (XDEL/2.0).
C              ALL VALUES IN THE VECTOR X LARGER THAN XMAX
C              WILL BE MAPPED INTO XMAX + (XDEL/2.0).
C              THE USE OF THIS SUBROUTINE
C              (AND THE DISCR2 AND DISCR3 SUBROUTINES)
C              GIVES THE DATA ANALYST THE CAPABILITY OF
C              CONSTRUCTING A DISCRETE VARIATE FROM
C              A CONTINUOUS ONE.
C              THE RESULTING DISCRETE VARIATE MIGHT THEN
C              (FOR EXAMPLE) BE ANALYZED IN ITSELF FOR
C              GROSS STRUCTURE, OR FOR ADHERENCE TO SOME
C              THEROETICAL DISCRETE PROBABILITY MODEL,
C              OR THE DISCRETE VARIATE MIGHT BE USED
C              AS A SUBSET DEFINITION VECTOR FOR SOME
C              OTHER VARIATE. 
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                                (UNSORTED OR SORTED) OBSERVATIONS.
C                                TO BE DISCRETIZED.
C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR X. 
C                     --XMIN   = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES THE LOWER BOUNDARY
C                                (INCLUSIVELY) OF THE LOWERMOST
C                                CLASS. 
C                     --XDEL   = THE SINGLE PRECISION VALUE 
C                                OF THE CLASS WIDTH.
C                     --XMAX   = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES THE UPPER BOUNDARY
C                                (INCLUSIVELY) OF THE UPPERMOST
C                                CLASS. 
C     OUTPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
C                                DISCRETIZED VALUES (= CLASS
C                                MIDPOINTS) CORRESPONDING TO
C                                THE CONTINUOUS VALUES IN THE VECTOR X.
C                                THERE WILL RESULT N SUCH DISCRETIZED 
C                                VALUES.
C     OUTPUT--THE SINGLE PRECISION VECTOR Y
C             WHICH CONTAINS N DISCRETIZED VALUES 
C             (= CLASS MIDPOINTS)
C             CORRESPONDING TO THE N
C             CONTINUOUS VALUES IN THE
C             INPUT VECTOR X. 
C             ALSO, A FEW LINES LINES OF SUMMARY INFORMATION
C             WILL BE GENERATED INDICATING
C             1) WHAT THE SAMPLE SIZE IS (N);
C             2) WHAT THE NUMBER OF CLASSES IS (NUMCLA).
C             3) WHAT THE CLASS BOUNDARIES AND
C                THE NUMBER OF OBSERVATIONS
C                FALLING IN EACH CLASS ARE.
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C                 --XDEL SHOULD BE POSITIVE.
C                 --(XMAX-XMIN)/XDEL SHOULD NOT EXCEED 999. 
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--IT IS SUGGESTED THAT XMIN, XDEL,
C              AND XMAX HAVE AT LEAST 1 MORE
C              DECIMAL PLACE THAN THE DATA VALUES 
C              IN THE VECTOR X SO AS TO HELP ASSURE
C              A UNIQUE DISCRETIZATION MAPPING;
C              THAT IS, TO HELP ASSURE THAT
C              NO DATA VALUE WILL FALL
C              EXACTLY ON THE BOUNDARY POINT
C              BETWEEN 2 ADJACENT CLASSES.
C     COMMENT--IN THE MAIN (CALLING) ROUTINE, IT IS
C              PERMISSABLE (IF THE ANALYST SO DESIRES)
C              TO USE THE SAME VARIABLE NAME
C              IN THE SIXTH ARGUMENT AS USED IN THE FIRST
C              ARGUMENT IN THE CALLING SEQUENCE TO THIS
C              DISCRE SUBROUTINE--NO CONFLICT WILL RESULT
C              IN THE INTERNAL OPERATION OF THE     DISCRE
C              SUBROUTINE.  FOR EXAMPLE, IT IS PERMISSIBLE
C              TO HAVE     CALL DISCRE(X,N,0.5,1.0,20.5,X)
C              IN WHICH THE VARIABLE NAME      X    IS USED 
C              AS BOTH THE FIRST AND SIXTH ARGUMENTS.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1974. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1),Y(1)
      DIMENSION ICOUNT(1000)
      DIMENSION CLASSM(1000)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      IF(XDEL.LE.0.0)GOTO70
      IF(XMIN.EQ.XMAX)GOTO80
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      DO65I=1,N
      Y(I)=X(I)
   65 CONTINUE
      RETURN
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      Y(1)=X(1)
      RETURN
   70 WRITE(IPR,35) 
      WRITE(IPR,48)XDEL
      DO71I=1,N
      Y(I)=0.0
   71 CONTINUE
      RETURN
   80 WRITE(IPR,26) 
      WRITE(IPR,49)XMIN
      DO81I=1,N
      Y(I)=0.0
   81 CONTINUE
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE DISCRE SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 DISCRE SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE DISCRE SUBROUTINE HAS THE VALUE 1 *****)
   26 FORMAT(1H ,45H***** FATAL ERROR--THE THIRD AND FIFTH INPUT ,
     1 48HARGUMENTS TO THE DISCRE SUBROUTINE ARE IDENTICAL) 
   35 FORMAT(1H , 91H***** FATAL ERROR--THE FOURTH INPUT ARGUMENT TO THE
     1 DISCRE SUBROUTINE IS NON-POSITIVE *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
   48 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.7   ,6H ***
     1**) 
   49 FORMAT(1H , 37H***** THE VALUE OF THE ARGUMENTS ARE ,E15.7   ,6H *
     1****)
C
C-----START POINT-----------------------------------------------------
C
C     DETERMINE THE TRUE INTERVAL MIN AND MAX;
C     THEN DETERMINE THE NUMBER OF CLASSES
C     WITHIN THE SPECIFIED MIN AND MAX. 
C
      POINTL=XMIN
      POINTU=XMAX
      IF(XMIN.GT.XMAX)POINTL=XMAX
      IF(XMIN.GT.XMAX)POINTU=XMIN
      TOTDEL=POINTU-POINTL
      NUMCLA=(TOTDEL/XDEL)+0.999
C
C     ZERO OUT THE COUNT VECTOR (ICOUNT)
C     AND THE LOWER AND UPPER COUNT VARIABLES.
C
      DO100I=1,NUMCLA
      ICOUNT(I)=0
  100 CONTINUE
      ICOUNL=0
      ICOUNU=0
C
C     COMPUTE THE CLASS MIDPOINT FOR EACH CLASS.
C
      DO200I=1,NUMCLA
      AI=I
      CMIN=XMIN+(AI-1.0)*XDEL 
      CMAX=XMIN+AI*XDEL
      CLASSM(I)=(CMIN+CMAX)/2.0
  200 CONTINUE
      CMAX=POINTU
      CLASSM(NUMCLA)=(CMIN+CMAX)/2.0
C
C     PERFORM THE DISCRETIZING TRANSFORMATION.
C
      DO300I=1,N
      IF(X(I).GE.POINTL.AND.X(I).LE.POINTU)GOTO350
      IF(X(I).LT.POINTL)GOTO370
      IF(X(I).GT.POINTU)GOTO390
      GOTO300
  350 IP=(X(I)-POINTL)/XDEL
      IP=IP+1
      IF(IP.GT.NUMCLA)IP=NUMCLA
      Y(I)=CLASSM(IP)
      ICOUNT(IP)=ICOUNT(IP)+1 
      GOTO300
  370 CLASML=POINTL-(XDEL/2.0)
      Y(I)=CLASML
      ICOUNL=ICOUNL+1
      GOTO300
  390 CLASMU=POINTU+(XDEL/2.0)
      Y(I)=CLASMU
      ICOUNU=ICOUNU+1
  300 CONTINUE
C
C     COMPUTE CLASS LIMITS AND WRITE OUT SUMMARY INFORMATION.
C
      WRITE(IPR,999)
      WRITE(IPR,501)
      WRITE(IPR,999)
      WRITE(IPR,502)N
      WRITE(IPR,503)XMIN
      WRITE(IPR,504)XDEL
      WRITE(IPR,505)XMAX
      WRITE(IPR,508)NUMCLA
      WRITE(IPR,999)
      WRITE(IPR,510)
      WRITE(IPR,997)
      IF(ICOUNL.GE.1)WRITE(IPR,511)CLASML,POINTL,ICOUNL
      DO500I=1,NUMCLA
      AI=I
      CMIN=POINTL+(AI-1.0)*XDEL
      CMAX=POINTL+AI*XDEL
      IF(CMAX.GT.POINTU)CMAX=POINTU
      WRITE(IPR,520)I,CMIN,CLASSM(I),CMAX,ICOUNT(I)
  500 CONTINUE
      IF(ICOUNU.GE.1)WRITE(IPR,512)POINTU,CLASMU,ICOUNU
C
  501 FORMAT(1H ,35HOUTPUT FROM THE DISCRE SUBROUTINE--)
  502 FORMAT(1H ,7X,36HNUMBER OF OBSERVATIONS            = ,I8)
  503 FORMAT(1H ,7X,36HSPECIFIED LOWER BOUND OF INTERVAL = ,F15.7)
  504 FORMAT(1H ,7X,36HSPECIFIED CLASS WIDTH             = ,F15.7)
  505 FORMAT(1H ,7X,36HSPECIFIED UPPER BOUND OF INTERVAL = ,F15.7)
  508 FORMAT(1H ,7X,36HCOMPUTED  NUMBER OF LEVELS        = ,I8)
  510 FORMAT(1H ,52H       CLASS     MINIMUM       MIDPOINT      MAXIMUM
     1,11H      COUNT)
  511 FORMAT(1H ,4X,22H   BELOW     -INFINITY,2F14.7,I8)
  512 FORMAT(1H ,4X,8H   ABOVE,2F14.7,14H     +INFINITY,I8) 
  520 FORMAT(1H ,4X,I6,2X,3F14.7,I8)
  997 FORMAT(1H ,50H       -------------------------------------------,
     1 13H-------------)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE DOT(A,B,IMIN,IMAX,PARPRO,DOTPRO) 
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT DOT
C     PURPOSE--TO COMPUTE THE DOT PRODUCT BETWEEN 2 VECTORS--A AND B. 
C     ONLY ELEMENTS IMIN THROUGH IMAX OF THE 2 VECTORS ARE CONSIDERED.
C     THE COMPUTED DOT PRODUCT IS ADDED TO THE INPUT VALUE PARPRO
C     TO YIELD A FINAL ANSWER FOR DOTPRO.
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION SUM,PROD,DPARPR
      DIMENSION A(1),B(1)
C
C-----START POINT-----------------------------------------------------
C
      DPARPR=PARPRO 
      SUM=0.0D0
      IF(IMIN.GT.IMAX)GOTO150 
      DO100I=IMIN,IMAX
      PROD=A(I)*B(I)
      SUM=SUM+PROD
  100 CONTINUE
  150 DOTPRO=SUM+DPARPR
C
      RETURN
      END 
      SUBROUTINE EV1CDF(X,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT EV1CDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE FOR THE EXTREME VALUE TYPE 1
C              DISTRIBUTION.
C              THE EXTREME VALUE TYPE 1 DISTRIBUTION USED
C              HEREIN HAS MEAN = EULER'S NUMBER = 0.57721566
C              AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983.
C              THIS DISTRIBUTION IS DEFINED FOR ALL X
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = (EXP(-X)) * (EXP(-(EXP(-X))))
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE 
C                                AT 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 FOR THE EXTREME VALUE TYPE 1
C             DISTRIBUTION WITH MEAN = EULER'S NUMBER = 0.57721566
C             AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--NONE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 272-295.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS.
C     NO INPUT ARGUMENT ERRORS POSSIBLE 
C     FOR THIS DISTRIBUTION.
C
C-----START POINT-----------------------------------------------------
C
      CDF=1.0-EXP(-(EXP(-X))) 
C
      RETURN
      END 
      SUBROUTINE EV1PLT(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT EV1PLT
C
C     PURPOSE--THIS SUBROUTINE GENERATES AN EXTREME VALUE TYPE 1
C              PROBABILITY PLOT.
C              THE PROTOTYPE EXTREME VALUE TYPE 1 DISTRIBUTION USED HERE
C              HAS MEAN = EULER'S NUMBER = 0.57721566
C              AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983.
C              THIS DISTRIBUTION IS DEFINED FOR ALL X
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = (EXP(-X)) * (EXP(-(EXP(-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 EXTREME VALUE TYPE 1 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 EXTREME VALUE TYPE 1 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--A ONE-PAGE EXTREME VALUE TYPE 1 PROBABILITY PLOT.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, PLOT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
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 272-295.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(7500),W(7500)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501))
C
      DATA TAU/1.56186687/
C
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE EV1PLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 EV1PLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE EV1PLT SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     SORT THE DATA 
C
      CALL SORT(X,N,Y)
C
C     GENERATE UNIFORM ORDER STATISTIC MEDIANS
C
      CALL UNIMED(N,W)
C
C     COMPUTE EXTREME VALUE TYPE 1 ORDER STATISTIC MEDIANS
C
      DO100I=1,N
      W(I)=-ALOG(ALOG(1.0/W(I)))
  100 CONTINUE
C
C     PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS.
C     WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION 
C     AND THE SAMPLE SIZE.
C
      CALL PLOT(Y,W,N)
      WRITE(IPR,105)TAU,N
C
C     COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. 
C     COMPUTE LOCATION AND SCALE ESTIMATES
C     FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. 
C     THEN WRITE THEM OUT.
C
      SUM1=0.0
      SUM2=0.0
      DO200I=1,N
      SUM1=SUM1+Y(I)
      SUM2=SUM2+W(I)
  200 CONTINUE
      YBAR=SUM1/AN
      WBAR=SUM2/AN
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO300I=1,N
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) 
      SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) 
      SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 
  300 CONTINUE
      CC=SUM2/SQRT(SUM3*SUM1) 
      YSLOPE=SUM2/SUM3
      YINT=YBAR-YSLOPE*WBAR
      WRITE(IPR,305)CC,YINT,YSLOPE
C
  105 FORMAT(1H ,64HEXTREME VALUE TYPE 1 (EXPONENTIAL TYPE) PROBABILITY
     1PLOT (TAU = ,E15.8,1H),23X,20HTHE SAMPLE SIZE N = ,I7)
  305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X,
     122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) 
C
      RETURN
      END 
      SUBROUTINE EV1PPF(P,PPF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT EV1PPF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE FOR THE EXTREME VALUE TYPE 1
C              DISTRIBUTION.
C              THE EXTREME VALUE TYPE 1 DISTRIBUTION USED
C              HEREIN HAS MEAN = EULER'S NUMBER = 0.57721566
C              AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983.
C              THIS DISTRIBUTION IS DEFINED FOR ALL X
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = (EXP(-X)) * (EXP(-(EXP(-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 (EXCLUSIVELY) 
C                                AND 1.0 (EXCLUSIVELY))
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 FUNCTION . 
C             VALUE PPF FOR THE EXTREME VALUE TYPE 1 DISTRIBUTION
C             WITH MEAN = EULER'S NUMBER = 0.57721566
C             AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 272-295.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LE.0.0.OR.P.GE.1.0)GOTO50
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      PPF=0.0
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 EV1PPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      PPF=-ALOG(ALOG(1.0/P))
C
      RETURN
      END 
      SUBROUTINE EV1RAN(N,ISEED,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT EV1RAN
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE EXTREME VALUE TYPE 1 DISTRIBUTION.
C              THE PROTOTYPE EXTREME VALUE TYPE 1 DISTRIBUTION USED
C              HEREIN HAS MEAN = EULER'S NUMBER = 0.57721566
C              AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983.
C              THIS DISTRIBUTION IS DEFINED FOR ALL X
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = (EXP(-X)) * (EXP(-(EXP(-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             FROM THE EXTREME VALUE TYPE 1 DISTRIBUTION
C             WITH MEAN = EULER'S NUMBER = 0.57721566
C             AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983.
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--ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--TOCHER, THE ART OF SIMULATION,
C                 1963, PAGES 14-15.
C               --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS,
C                 1964, PAGE 36.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 272-295.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--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
CCCCC CHARACTER*4 IFEEDB
CCCCC CHARACTER*4 IPRINT
C
CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
CCCCC COMMON /PRINT/IFEEDB,IPRINT
C
      IPR=6
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      GOTO90
   50 WRITE(IPR, 5)
      WRITE(IPR,47)N
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 EV1RAN SUBROUTINE IS NON-POSITIVE *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
C
      CALL UNIRAN(N,ISEED,X)
C
C     GENERATE N EXTREME VALUE TYPE 1 RANDOM NUMBERS
C     USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD.
C
      DO100I=1,N
      X(I)=-ALOG(ALOG(1.0/X(I)))
  100 CONTINUE
C
      RETURN
      END
      SUBROUTINE EV2CDF(X,GAMMA,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT EV2CDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE FOR THE EXTREME VALUE TYPE 2
C              DISTRIBUTION WITH SINGLE PRECISION 
C              TAIL LENGTH PARAMETER = GAMMA.
C              THE EXTREME VALUE TYPE 2 DISTRIBUTION USED
C              HEREIN IS DEFINED FOR ALL NON-NEGATIVE X,
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = GAMMA * (X**(-GAMMA-1)) * EXP(-(X**(-GAMMA))).
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE 
C                                AT WHICH THE CUMULATIVE DISTRIBUTION 
C                                FUNCTION IS TO BE EVALUATED.
C                                X SHOULD BE NON-NEGATIVE.
C                     --GAMMA  = THE SINGLE PRECISION VALUE 
C                                OF THE TAIL LENGTH PARAMETER.
C                                GAMMA 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 EXTREME VALUE TYPE 2
C             DISTRIBUTION WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--GAMMA SHOULD BE POSITIVE.
C                 --X SHOULD BE NON-NEGATIVE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 272-295.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(X.LT.0.0)GOTO50
      IF(GAMMA.LE.0.0)GOTO55
      GOTO90
   50 WRITE(IPR,4)
      WRITE(IPR,46)X
      CDF=0.0
      RETURN
   55 WRITE(IPR,15) 
      WRITE(IPR,46)GAMMA
      CDF=0.0
      RETURN
   90 CONTINUE
    4 FORMAT(1H , 96H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE EV2CDF SUBROUTINE IS NEGATIVE *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 EV2CDF SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      CDF=0.0
      IF(X.EQ.0.0)RETURN
      CDF=EXP(-(X**(-GAMMA))) 
C
      RETURN
      END 
      SUBROUTINE EV2PLT(X,N,GAMMA)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT EV2PLT
C
C     PURPOSE--THIS SUBROUTINE GENERATES A EXTREME VALUE TYPE 2
C              PROBABILITY PLOT
C              (WITH TAIL LENGTH PARAMETER VALUE = GAMMA).
C              THE PROTOTYPE EXTREME VALUE TYPE 2 DISTRIBUTION USED     N
C              HEREIN IS DEFINED FOR ALL NON-NEGATIVE X,
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = GAMMA * (X**(-GAMMA-1)) * EXP(-(X**(-GAMMA))).
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 EXTREME VALUE TYPE 2 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  EXTREME VALUE TYPE 2 DISTRIBUTION
C              WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
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                     --GAMMA  = THE SINGLE PRECISION VALUE OF THE
C                                TAIL LENGTH PARAMETER.
C                                GAMMA SHOULD BE POSITIVE.
C     OUTPUT--A ONE-PAGE EXTREME VALUE TYPE 2 PROBABILITY PLOT.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C                 --GAMMA SHOULD BE POSITIVE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, PLOT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
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 272-295.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--DECEMBER  1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(7500),W(7500)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501))
C
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      IF(GAMMA.LE.0.0)GOTO60
      HOLD=X(1)
      DO65I=2,N
      IF(X(I).NE.HOLD)GOTO90
   65 CONTINUE
      WRITE(IPR, 9)HOLD
      RETURN
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   60 WRITE(IPR,25) 
      WRITE(IPR,46)GAMMA
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE EV2PLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 EV2PLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE EV2PLT SUBROUTINE HAS THE VALUE 1 *****)
   25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 EV2PLT SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     SORT THE DATA 
C
      CALL SORT(X,N,Y)
C
C     GENERATE UNIFORM ORDER STATISTIC MEDIANS
C
      CALL UNIMED(N,W)
C
C     COMPUTE EXREME VALUE TYPE 2 DISTRIBUTION ORDER STATISTIC MEDIANS
C
      DO100I=1,N
      W(I)=(-ALOG(W(I)))**(-1.0/GAMMA)
  100 CONTINUE
C
C     PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS.
C     COMPUTE THE TAIL LENGTH MEASURE OF THE DISTRIBUTION.
C     WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION 
C     AND THE SAMPLE SIZE.
C
      CALL PLOT(Y,W,N)
      Q=.9975
      PP9975=(-ALOG(Q))**(-1.0/GAMMA)
      Q=.0025
      PP0025=(-ALOG(Q))**(-1.0/GAMMA)
      Q=.975
      PP975 =(-ALOG(Q))**(-1.0/GAMMA)
      Q=.025
      PP025 =(-ALOG(Q))**(-1.0/GAMMA)
      TAU=(PP9975-PP0025)/(PP975-PP025) 
      WRITE(IPR,105)GAMMA,TAU,N
C
C     COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. 
C     COMPUTE LOCATION AND SCALE ESTIMATES
C     FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. 
C     THEN WRITE THEM OUT.
C
      SUM1=0.0
      SUM2=0.0
      DO200I=1,N
      SUM1=SUM1+Y(I)
      SUM2=SUM2+W(I)
  200 CONTINUE
      YBAR=SUM1/AN
      WBAR=SUM2/AN
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO300I=1,N
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) 
      SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) 
      SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 
  300 CONTINUE
      CC=SUM2/SQRT(SUM3*SUM1) 
      YSLOPE=SUM2/SUM3
      YINT=YBAR-YSLOPE*WBAR
      WRITE(IPR,305)CC,YINT,YSLOPE
C
  105 FORMAT(1H ,63HEXTREME VALUE TYPE 2 (CAUCHY TYPE) PROB. PLOT WITH E
     1XP. PAR. = ,E17.10,1X,7H(TAU = ,E15.8,1H),1X,16HSAMPLE SIZE N = ,I
     17)
  305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X,
     122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) 
C
      RETURN
      END 
      SUBROUTINE EV2PPF(P,GAMMA,PPF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT EV2PPF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE FOR THE EXTREME VALUE TYPE 2
C              DISTRIBUTION WITH SINGLE PRECISION 
C              TAIL LENGTH PARAMETER = GAMMA.
C              THE EXTREME VALUE TYPE 2 DISTRIBUTION USED
C              HEREIN IS DEFINED FOR ALL NON-NEGATIVE X,
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = GAMMA * (X**(-GAMMA-1)) * EXP(-(X**(-GAMMA))).
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 (EXCLUSIVELY) 
C                                AND 1.0 (EXCLUSIVELY))
C                                AT WHICH THE PERCENT POINT 
C                                FUNCTION IS TO BE EVALUATED.
C                     --GAMMA  = THE SINGLE PRECISION VALUE 
C                                OF THE TAIL LENGTH PARAMETER.
C                                GAMMA 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 EXTREME VALUE TYPE 2 DISTRIBUTION
C             WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--GAMMA SHOULD BE POSITIVE.
C                 --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 272-295.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LE.0.0.OR.P.GE.1.0)GOTO50
      IF(GAMMA.LE.0.0)GOTO55
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      PPF=0.0
      RETURN
   55 WRITE(IPR,15) 
      WRITE(IPR,46)GAMMA
      PPF=0.0
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 EV2PPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 EV2PPF SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      PPF=(-ALOG(P))**(-1.0/GAMMA)
C
      RETURN
      END 
      SUBROUTINE EV2RAN(N,GAMMA,ISEED,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT EV2RAN
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE EXTREME VALUE TYPE 2 DISTRIBUTION
C              WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
C              THE PROTOTYPE EXTREME VALUE TYPE 2 DISTRIBUTION USED
C              HEREIN IS DEFINED FOR ALL NON-NEGATIVE X,
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = GAMMA * (X**(-GAMMA-1)) * EXP(-(X**(-GAMMA))).
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
C                                OF RANDOM NUMBERS TO BE
C                                GENERATED.
C                     --GAMMA  = THE SINGLE PRECISION VALUE OF THE
C                                TAIL LENGTH PARAMETER.
C                                GAMMA SHOULD BE POSITIVE.
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 EXTREME VALUE TYPE 2 DISTRIBUTION
C             WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
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                 --GAMMA SHOULD BE POSITIVE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--TOCHER, THE ART OF SIMULATION,
C                 1963, PAGES 14-15.
C               --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS,
C                 1964, PAGE 36.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 272-295.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--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
CCCCC CHARACTER*4 IFEEDB
CCCCC CHARACTER*4 IPRINT
C
CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
CCCCC COMMON /PRINT/IFEEDB,IPRINT
C
      IPR=6
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(GAMMA.LE.0.0)GOTO60
      GOTO90
   50 WRITE(IPR, 5)
      WRITE(IPR,47)N
      RETURN
   60 WRITE(IPR,15)
      WRITE(IPR,46)GAMMA
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 EV2RAN SUBROUTINE IS NON-POSITIVE *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 EV2RAN SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
C
      CALL UNIRAN(N,ISEED,X)
C
C     GENERATE N EXTREME VALUE TYPE 2 DISTRIBUTION RANDOM NUMBERS
C     USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD.
C
      DO100I=1,N
      X(I)=(-ALOG(X(I)))**(-1.0/GAMMA)
  100 CONTINUE
C
      RETURN
      END
      SUBROUTINE EXPCDF(X,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT EXPCDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE FOR THE EXPONENTIAL DISTRIBUTION
C              WITH MEAN = 1 AND STANDARD DEVIATION = 1.
C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X,
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = EXP(-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 UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 207-232.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(X.LT.0.0)GOTO50
      GOTO90
   50 WRITE(IPR,4)
      WRITE(IPR,46)X
      CDF=0.0
      RETURN
   90 CONTINUE
    4 FORMAT(1H , 96H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE EXPCDF SUBROUTINE IS NEGATIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      CDF=1.0-EXP(-X)
C
      RETURN
      END 
      SUBROUTINE EXPPDF(X,PDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT EXPPDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY
C              FUNCTION VALUE FOR THE EXPONENTIAL DISTRIBUTION
C              WITH MEAN = 1 AND STANDARD DEVIATION = 1.
C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X,
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = EXP(-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 UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 207-232.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(X.LT.0.0)GOTO50
      GOTO90
   50 WRITE(IPR,4)
      WRITE(IPR,46)X
      PDF=0.0
      RETURN
   90 CONTINUE
    4 FORMAT(1H , 96H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE EXPPDF SUBROUTINE IS NEGATIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      PDF=EXP(-X)
C
      RETURN
      END 
      SUBROUTINE EXPPLT(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT EXPPLT
C
C     PURPOSE--THIS SUBROUTINE GENERATES AN EXPONENTIAL
C              PROBABILITY PLOT.
C              THE PROTOTYPE EXPONENTIAL DISTRIBUTION USED HEREIN
C              HAS MEAN = 1 AND STANDARD DEVIATION = 1.
C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X,
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X)=EXP(-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 EXPONENTIAL 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 EXPONENTIAL 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--A ONE-PAGE EXPONENTIAL PROBABILITY PLOT.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, PLOT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
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 207-232.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(7500),W(7500)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501))
C
      DATA TAU/1.63473745/
C
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE EXPPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 EXPPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE EXPPLT SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     SORT THE DATA 
C
      CALL SORT(X,N,Y)
C
C     GENERATE UNIFORM ORDER STATISTIC MEDIANS
C
      CALL UNIMED(N,W)
C
C     COMPUTE EXPONENTIAL ORDER STATISTIC MEDIANS 
C
      DO100I=1,N
      W(I)=-ALOG(1.0-W(I))
  100 CONTINUE
C
C     PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS.
C     WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION 
C     AND THE SAMPLE SIZE.
C
      CALL PLOT(Y,W,N)
      WRITE(IPR,105)TAU,N
C
C     COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. 
C     COMPUTE LOCATION AND SCALE ESTIMATES
C     FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. 
C     THEN WRITE THEM OUT.
C
      SUM1=0.0
      SUM2=0.0
      DO200I=1,N
      SUM1=SUM1+Y(I)
      SUM2=SUM2+W(I)
  200 CONTINUE
      YBAR=SUM1/AN
      WBAR=SUM2/AN
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO300I=1,N
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) 
      SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) 
      SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 
  300 CONTINUE
      CC=SUM2/SQRT(SUM3*SUM1) 
      YSLOPE=SUM2/SUM3
      YINT=YBAR-YSLOPE*WBAR
      WRITE(IPR,305)CC,YINT,YSLOPE
C
  105 FORMAT(1H ,36HEXPONENTIAL PROBABILITY PLOT (TAU = ,E15.8,1H),51X,2
     10HTHE SAMPLE SIZE N = ,I7)
  305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X,
     122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) 
C
      RETURN
      END 
      SUBROUTINE EXPPPF(P,PPF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT EXPPPF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE FOR THE EXPONENTIAL DISTRIBUTION
C              WITH MEAN = 1 AND STANDARD DEVIATION = 1.
C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X,
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = EXP(-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 (INCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG.
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 207-232.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LT.0.0.OR.P.GE.1.0)GOTO50
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 EXPPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      PPF=-ALOG(1.0-P)
C
      RETURN
      END 
      SUBROUTINE EXPRAN(N,ISEED,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT EXPRAN
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE EXPONENTIAL DISTRIBUTION
C              WITH MEAN = 1 AND STANDARD DEVIATION = 1.
C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X,
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = EXP(-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             FROM THE EXPONENTIAL DISTRIBUTION
C             WITH MEAN = 1 AND STANDARD DEVIATION = 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--ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--TOCHER, THE ART OF SIMULATION,
C                 1963, PAGES 14, 35-36.
C               --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS,
C                 1964, PAGE 36.
C               --FILLIBEN, 'THE PERCENT POINT FUNCTION',
C                 (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 207-232.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGE 58.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JUNE      1972.
C     UPDATED         --SEPTEMBER 1975.
C     UPDATED         --NOVEMBER  1975.
C     UPDATED         --JULY      1976.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
C
C---------------------------------------------------------------------
C
CCCCC CHARACTER*4 IFEEDB
CCCCC CHARACTER*4 IPRINT
C
CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
CCCCC COMMON /PRINT/IFEEDB,IPRINT
C
      IPR=6
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      GOTO90
   50 WRITE(IPR, 5)
      WRITE(IPR,47)N
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 EXPRAN SUBROUTINE IS NON-POSITIVE *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
C
      CALL UNIRAN(N,ISEED,X)
C
C     GENERATE N EXPONENTIAL RANDOM NUMBERS
C     USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD.
C
      DO100I=1,N
      X(I)=-ALOG(X(I))
  100 CONTINUE
C
      RETURN
      END
      SUBROUTINE EXPSF(P,SF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT EXPSF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE SPARSITY
C              FUNCTION VALUE FOR THE EXPONENTIAL DISTRIBUTION
C              WITH MEAN = 1 AND STANDARD DEVIATION = 1.
C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X,
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = EXP(-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 (INCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
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--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 207-232.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LT.0.0.OR.P.GE.1.0)GOTO50
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 EXPSF  SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      SF=1.0/(1.0-P)
C
      RETURN
      END 
      SUBROUTINE EXTREM(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT EXTREM
C
C     PURPOSE--THIS SUBROUTINE PERFORMS AN EXTREME VALUE ANALYSIS
C              ON THE DATA IN THE INPUT VECTOR X. 
C              THIS ANALYSIS CONSISTS OF DETERMINING THAT PARTICULAR
C              EXTREME VALUE TYPE 1 OR EXTREME VALUE TYPE 2 DISTRIBUTION
C              WHICH BEST FITS THE DATA SET.
C              THE GOODNESS OF FIT CRITERION IS THE MAXIMUM PROBABILITY
C              PLOT CORRELATION COEFFICIENT CRITERION.
C              AFTER THE BEST-FIT DISTRIBUTION IS DETERMINED,
C              ESTIMATES ARE COMPUTED AND PRINTED OUT FOR THE
C              LOCATION AND SCALE PARAMETERS.
C              TWO PROBABILITY PLOTS ARE ALSO PRINTED OUT-- 
C              THE BEST-FIT TYPE 2 PROBABILITY PLOT
C              (IF THE BEST FIT WAS IN FACT A TYPE 2),
C              AND THE TYPE 1 PROBABILITY PLOT.
C              PREDICTED EXTREMES FOR VARIOUS RETURN PERIODS ARE
C              ALSO COMPUTED AND PRINTED OUT.
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--6 PAGES OF AUTOMATIC PRINTOUT.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, EV1PLT,
C                                         EV2PLT, PLOT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--FILLIBEN (1972), 'TECHNIQUES FOR TAIL LENGTH
C                 ANALYSIS', PROCEEDINGS OF THE EIGHTEENTH
C                 CONFERENCE ON THE DESIGN OF EXPERIMENTS IN
C                 ARMY RESEARCH AND TESTING, PAGES 425-450. 
C               --FILLIBEN, 'THE PERCENT POINT FUNCTION',
C                 UNPUBLISHED MANUSCRIPT.
C               --JOHNSON AND KOTZ (1970), CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS-1, 1970, PAGES 272-295.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --DECEMBER  1974. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --MAY       1976. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 BLANK,ALPHAM,ALPHAA,ALPHAX
      CHARACTER*4 ALPHAI,ALPHAN,ALPHAF,ALPHAT,ALPHAY
      CHARACTER*4 ALPHAG,EQUAL
C
      CHARACTER*4 IFLAG1
      CHARACTER*4 IFLAG2
      CHARACTER*4 IFLAG3
C
      DIMENSION W(3000)
      DIMENSION X(1)
      DIMENSION Y(7500),Z(7500)
      DIMENSION GAMTAB(50),CORR(50)
      DIMENSION YI(50),YS(50),T(50)
      DIMENSION IFLAG1(50),IFLAG2(50),IFLAG3(50)
CCCCC DIMENSION C(10)
      DIMENSION AM(50)
      DIMENSION SCRAT(50)
C
      DIMENSION AINDEX(50)
CCCCC DIMENSION P0(10)
      DIMENSION H(60,2)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(Z(1),WS(7501))
      DATA BLANK,ALPHAM,ALPHAA,ALPHAX/' ','M','A','X'/
      DATA ALPHAI,ALPHAN,ALPHAF,ALPHAT,ALPHAY/'I','N','F','T','Y'/
      DATA ALPHAG,EQUAL/'G','='/
      DATA GAMTAB(1),GAMTAB(2),GAMTAB(3),GAMTAB(4),GAMTAB(5),
     1GAMTAB(6),GAMTAB(7),GAMTAB(8),GAMTAB(9),GAMTAB(10),
     1GAMTAB(11),GAMTAB(12),GAMTAB(13),GAMTAB(14),GAMTAB(15),
     1GAMTAB(16),GAMTAB(17),GAMTAB(18),GAMTAB(19),GAMTAB(20),
     1GAMTAB(21),GAMTAB(22),GAMTAB(23),GAMTAB(24),GAMTAB(25)
     1/1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.,
     113.,14.,15.,16.,17.,18.,19.,20.,21.,22.,23.,24.,25./
      DATA GAMTAB(26),GAMTAB(27),GAMTAB(28),GAMTAB(29),GAMTAB(30),
     1GAMTAB(31),GAMTAB(32),GAMTAB(33),GAMTAB(34),GAMTAB(35),
     1GAMTAB(36),GAMTAB(37),GAMTAB(38),GAMTAB(39),GAMTAB(40),
     1GAMTAB(41),GAMTAB(42)
     1/30.,35.,40.,45.,50.,60.,70.,80.,90.,100.,150.,200.,250.,
     1350.,500.,750.,1000./
CCCCC DATA C(1),C(2),C(3),C(4),C(5),C(6),C(7),C(8),C(9),C(10)
CCCCC1/60.,75.,100.,150.,250.,500.,1000.,10000.,100000.,1000000./
CCCCC DATA P0(1),P0(2),P0(3),P0(4),P0(5),P0(6),P0(7),P0(8),P0(9),P0(10)
CCCCC1/.0,.5,.75,.9,.95,.975,.99,.999,.9999,.99999/
      DATA T(1),T(2),T(3),T(4),T(5),T(6),T(7),T(8),T(9),T(10),
     1T(11),T(12),T(13),T(14),T(15),T(16),T(17),T(18),T(19),T(20),
     1T(21),T(22),T(23),T(24),T(25)
     1/10.18011,3.39672,2.47043,2.14609,1.98712,1.89429,1.83394,
     11.79175,1.76069,1.73691,1.71814,1.70297,1.69045,1.67996,
     11.67103,1.66335,1.65667,1.65082,1.64564,1.64102,1.63689,
     11.63316,1.62979,1.62672,1.62391/
      DATA T(26),T(27),T(28),T(29),T(30),
     1T(31),T(32),T(33),T(34),T(35),T(36),T(37),T(38),T(39),T(40),
     1T(41),T(42),T(43)
     1/1.61287,1.60516,1.59947,1.59510,1.59164,1.58651,1.58289,
     11.58019,1.57811,1.57645,1.57152,1.56908,1.56763,1.56666,
     11.56546,1.56377,1.56330,1.56187/
      DATA AINDEX(1),AINDEX(2),AINDEX(3),AINDEX(4),AINDEX(5),
     1AINDEX(6),AINDEX(7),AINDEX(8),AINDEX(9),AINDEX(10),
     1AINDEX(11),AINDEX(12),AINDEX(13),AINDEX(14),AINDEX(15),
     1AINDEX(16),AINDEX(17),AINDEX(18),AINDEX(19),AINDEX(20),
     1AINDEX(21),AINDEX(22),AINDEX(23),AINDEX(24),AINDEX(25)
     1/1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.,
     113.,14.,15.,16.,17.,18.,19.,20.,21.,22.,23.,24.,25./
      DATA AINDEX(26),AINDEX(27),AINDEX(28),AINDEX(29),AINDEX(30),
     1AINDEX(31),AINDEX(32),AINDEX(33),AINDEX(34),AINDEX(35),
     1AINDEX(36),AINDEX(37),AINDEX(38),AINDEX(39),AINDEX(40),
     1AINDEX(41),AINDEX(42),AINDEX(43),AINDEX(44),AINDEX(45),
     1AINDEX(46),AINDEX(47),AINDEX(48),AINDEX(49),AINDEX(50)
     1/26.,27.,28.,29.,30.,31.,32.,33.,34.,35.,36.,37.,38., 
     139.,40.,41.,42.,43.,44.,45.,46.,47.,48.,49.,50./
C
      IPR=6
      IUPPER=7500
      NUMDIS=43
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      RETURN
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE EXTREM SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 EXTREM SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE EXTREM SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     COMPUTE THE SAMPLE MINIMUM AND SAMPLE MAXIMUM
C
      XMIN=X(1)
      XMAX=X(1)
      DO140I=2,N
      IF(X(I).LT.XMIN)XMIN=X(I)
      IF(X(I).GT.XMAX)XMAX=X(I)
  140 CONTINUE
C
C     COMPUTE THE PROB PLOT CORRELATION COEFFICIENTS FOR THE VARIOUS VALUES
C     OF GAMMA
C
      CALL SORT(X,N,Y)
      CALL UNIMED(N,Z)
C
      DO100IDIS=1,NUMDIS
      IF(IDIS.EQ.NUMDIS)GOTO150
      A=GAMTAB(IDIS)
      DO110I=1,N
      W(I)=(-ALOG(Z(I)))**(-1.0/A)
  110 CONTINUE
      GOTO170
  150 DO160I=1,N
      W(I)=-ALOG(ALOG(1.0/Z(I)))
  160 CONTINUE
C
  170 SUM1=0.0
      SUM2=0.0
      DO200I=1,N
      SUM1=SUM1+Y(I)
      SUM2=SUM2+W(I)
  200 CONTINUE
      YBAR=SUM1/AN
      WBAR=SUM2/AN
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO300I=1,N
      SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) 
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) 
      SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 
  300 CONTINUE
      SY=SQRT(SUM1/(AN-1.0))
      CC=SUM2/SQRT(SUM3*SUM1) 
      YSLOPE=SUM2/SUM3
      YINT=YBAR-YSLOPE*WBAR
      CORR(IDIS)=CC 
      YI(IDIS)=YINT 
      YS(IDIS)=YSLOPE
  100 CONTINUE
C
C     DETERMINE THAT DISTRIBUTION WITH THE MAX PROB PLOT CORR COEFFICIENT
C
      IDISMX=1
      CORRMX=CORR(1)
      DO400IDIS=1,NUMDIS
      IF(CORR(IDIS).GT.CORRMX)IDISMX=IDIS
      IF(CORR(IDIS).GT.CORRMX)CORRMX=CORR(IDIS)
  400 CONTINUE
      DO500IDIS=1,NUMDIS
      IFLAG1(IDIS)=BLANK
      IFLAG2(IDIS)=BLANK
      IFLAG3(IDIS)=BLANK
      IF(IDIS.EQ.IDISMX)GOTO550
      GOTO500
  550 IFLAG1(IDIS)=ALPHAM
      IFLAG2(IDIS)=ALPHAA
      IFLAG3(IDIS)=ALPHAX
  500 CONTINUE
C
C     WRITE OUT THE TABLE OF PROB PLOT CORR COEFFICIENTS FOR VARIOUS GAMMA
C
      WRITE(IPR,998)
      WRITE(IPR,305)
      WRITE(IPR,999)
      WRITE(IPR,310)N
      WRITE(IPR,311)YBAR
      WRITE(IPR,312)SY
      WRITE(IPR,313)XMIN
      WRITE(IPR,314)XMAX
      WRITE(IPR,999)
      WRITE(IPR,323)
      WRITE(IPR,324)
      WRITE(IPR,325)
      WRITE(IPR,999)
C
      NUMDM1=NUMDIS-1
      IF(NUMDM1.LT.1)GOTO850
      DO800I=1,NUMDM1
      WRITE(IPR,805)GAMTAB(I),CORR(I),IFLAG1(I),IFLAG2(I),IFLAG3(I),
     1YI(I),YS(I),T(I)
  800 CONTINUE
  850 I=NUMDIS
      WRITE(IPR,806)ALPHAI,ALPHAN,ALPHAF,ALPHAI,ALPHAN,ALPHAI,
     1ALPHAT,ALPHAY,CORR(I),IFLAG1(I),IFLAG2(I),IFLAG3(I),
     1YI(I),YS(I),T(I)
C
C     PLOT THE PROB PLOT CORR COEFFICIENT VERSUS GAMMA VALUE INDEX
C
      CALL PLOT(CORR,AINDEX,NUMDIS)
      WRITE(IPR,810)ALPHAG,ALPHAA,ALPHAM,ALPHAM,ALPHAA,EQUAL,
     1GAMTAB(1),GAMTAB(12),GAMTAB(23),GAMTAB(34), 
     1ALPHAI,ALPHAN,ALPHAF,ALPHAI,ALPHAN,ALPHAI,ALPHAT,ALPHAY
      WRITE(IPR,999)
      WRITE(IPR,812)
      WRITE(IPR,813)
C
C     IF THE OPTIMAL GAMMA IS FINITE, PLOT OUT THE EXTREME VALUE
C     TYPE 2 PROBABILITY PLOT FOR THE OPTIMAL VALUE
C     OF GAMMA.
C
      IF(IDISMX.LT.NUMDIS)CALL EV2PLT(X,N,GAMTAB(IDISMX))
C
C     PLOT OUT AN EXTREME VALUE TYPE 1 PROBABILITY PLOT
C
      CALL EV1PLT(X,N)
C
C     FORM THE VARIOUS RETURN PERIOD VALUES
C
 1650 K=0 
      DO2100I=1,4
      DO2200J=1,9
      K=K+1
      AM(K)=J*(10**(I-1))
 2200 CONTINUE
 2100 CONTINUE
      K=K+1
      AM(K)=10000.
      K=K+1
      AM(K)=50000.
      K=K+1
      AM(K)=100000. 
      K=K+1
      AM(K)=500000. 
      K=K+1
      AM(K)=1000000.
      K=K+1
      AM(K)=N
      NUMAM=K
      CALL SORT(AM,NUMAM,SCRAT)
      DO2300I=1,NUMAM
      AM(I)=SCRAT(I)
 2300 CONTINUE
C
C     IF THE OPTIMAL GAMMA IS FINITE, COMPUTE THE 
C     PREDICTED EXTREME (= F(1-(1/M)) FOR VARIOUS RETURN PERIODS M
C     FOR THE OPTIMAL EXTREME VALUE TYPE 2 DISTRIBUTION.
C
      IF(IDISMX.EQ.NUMDIS)GOTO2450
      A=GAMTAB(IDISMX)
      YINT=YI(IDISMX)
      YSLOPE=YS(IDISMX)
      DO2400I=2,NUMAM
      R=1.0/AM(I)
      P=1.0-R
      ARG=-ALOG(P)
      IF(ARG.LE.0.0)GOTO2400
      H(I,1)=YINT+YSLOPE*(ARG**(-1.0/A))
 2400 CONTINUE
C
C     COMPUTE THE PREDICTED EXTREME (= F(1-(1/M)) FOR VARIOUS RETURN
C     PERIODS M FOR THE EXTREME VALUE TYPE 1 DISTRIBUTION.
C
 2450 YINT=YI(NUMDIS)
      YSLOPE=YS(NUMDIS)
      DO2500I=2,NUMAM
      R=1.0/AM(I)
      P=1.0-R
      ARG=-ALOG(P)
      IF(ARG.LE.0.0)GOTO2500
      H(I,2)=YINT+YSLOPE*(-ALOG(ARG))
 2500 CONTINUE
C
C     WRITE OUT THE PAGE WITH THE RETURN PERIODS AND THE PREDICTED EXTREMES
C     FOR THE 2 DISTRIBUTIONS--OPTIMAL EXTREME VALUE TYPE 2, AND EXTREME
C     VALUE TYPE 1. 
C
      WRITE(IPR,998)
      IF(IDISMX.EQ.NUMDIS)GOTO2750
      WRITE(IPR,2602)
      WRITE(IPR,2604)
      WRITE(IPR,2606)
      WRITE(IPR,2608)
      WRITE(IPR,2610)GAMTAB(IDISMX)
      WRITE(IPR,999)
      DO2700I=2,NUMAM
      WRITE(IPR,2705)AM(I),H(I,1),H(I,2)
      J=I-1
      JSKIP=J-5*(J/5)
      IF(JSKIP.EQ.0)WRITE(IPR,999)
 2700 CONTINUE
      RETURN
C
 2750 WRITE(IPR,2802)
      WRITE(IPR,2804)
      WRITE(IPR,2806)
      WRITE(IPR,2808)
      WRITE(IPR,999)
      DO2900I=2,NUMAM
      WRITE(IPR,2705)AM(I),H(I,2)
      J=I-1
      JSKIP=J-5*(J/5)
      IF(JSKIP.EQ.0)WRITE(IPR,999)
 2900 CONTINUE
C
  998 FORMAT(1H1)
  999 FORMAT(1H )
  305 FORMAT(1H ,40X,22HEXTREME VALUE ANALYSIS)
  310 FORMAT(1H ,37X,20HTHE SAMPLE SIZE N = ,I7)
  311 FORMAT(1H ,34X,18HTHE SAMPLE MEAN = ,F14.7) 
  312 FORMAT(1H ,28X,32HTHE SAMPLE STANDARD DEVIATION = ,F14.7)
  313 FORMAT(1H ,32X,21HTHE SAMPLE MINIMUM = ,F14.7)
  314 FORMAT(1H ,32X,21HTHE SAMPLE MAXIMUM = ,F14.7)
  323 FORMAT(1H ,85H     EXTREME VALUE      PROBABILITY PLOT     LOCATIO
     1N         SCALE       TAIL LENGTH)
  324 FORMAT(1H ,83H  TYPE 2 TAIL LENGTH      CORRELATION        ESTIMAT
     1E        ESTIMATE       MEASURE)
  325 FORMAT(1H ,37H   PARAMETER (GAMMA)      COEFFICIENT)
  805 FORMAT(1H ,3X,F10.2,13X,F8.5,1X,3A1,2X,F14.7,2X,F14.7,3X,F10.5) 
  806 FORMAT(1H ,5X,8A1,13X,F8.5,1X,3A1,2X,F14.7,2X,F14.7,3X,F10.5)
  810 FORMAT(1H ,12X,5A1,1X,A1,F14.7,11X,F14.7,11X,F14.7,11X,F14.7,
     115X,8A1)
  812 FORMAT(1H ,96HTHE ABOVE IS A PLOT OF THE 46 PROBABILITY PLOT CORRE
     1LATION COEFFICIENTS (FROM THE PREVIOUS PAGE))
  813 FORMAT(1H ,16X,41HVERSUS THE 46 EXTREME VALUE DISTRIBUTIONS)
 2602 FORMAT(1H ,43H   RETURN PERIOD     PREDICTED EXTREME WIND,
     1 27H     PREDICTED EXTREME WIND)
 2604 FORMAT(1H ,43H    (IN YEARS)          BASED ON OPTIMAL   ,
     1 20H            BASED ON)
 2606 FORMAT(1H ,42H                      EXTREME VALUE TYPE 2,
     1 27H       EXTREME VALUE TYPE 1)
 2608 FORMAT(1H ,43H                          DISTRIBUTION     ,
     1 22H          DISTRIBUTION)
 2610 FORMAT(1H ,30H                     (GAMMA = ,F12.5,1H))
 2705 FORMAT(1H ,2X,F9.1,13X,F10.2,17X,F10.2)
 2802 FORMAT(1H ,43H   RETURN PERIOD     PREDICTED EXTREME WIND)
 2804 FORMAT(1H ,36H    (IN YEARS)              BASED ON)
 2806 FORMAT(1H ,42H                      EXTREME VALUE TYPE 1)
 2808 FORMAT(1H ,38H                          DISTRIBUTION) 
C
      RETURN
      END 
      SUBROUTINE FCDF(X,NU1,NU2,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT FCDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE FOR THE F DISTRIBUTION
C              WITH INTEGER DEGREES OF FREEDOM
C              PARAMETERS = NU1 AND NU2.
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                     --NU1    = THE INTEGER DEGREES OF FREEDOM
C                                FOR THE NUMERATOR OF THE F RATIO.
C                                NU1 SHOULD BE POSITIVE.
C                     --NU2    = THE INTEGER DEGREES OF FREEDOM
C                                FOR THE DENOMINATOR OF THE F RATIO.
C                                NU2 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 F DISTRIBUTION
C             WITH DEGREES OF FREEDOM
C             PARAMETERS = NU1 AND NU2. 
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE.
C                 --NU1 SHOULD BE A POSITIVE INTEGER VARIABLE.
C                 --NU2 SHOULD BE A POSITIVE INTEGER VARIABLE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NORCDF,CHSCDF.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DATAN.
C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGES 946-947, 
C                 FORMULAE 26.6.4, 26.6.5, 26.6.8, AND 26.6.15.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--2, 1970, PAGE 83, FORMULA 20,
C                 AND PAGE 84, THIRD FORMULA.
C               --PAULSON, AN APPROXIMATE NORMAILIZATION
C                 OF THE ANALYSIS OF VARIANCE DISTRIBUTION, 
C                 ANNALS OF MATHEMATICAL STATISTICS, 1942,
C                 NUMBER 13, PAGES 233-135.
C               --SCHEFFE AND TUKEY, A FORMULA FOR SAMPLE SIZES
C                 FOR POPULATION TOLERANCE LIMITS, 1944,
C                 NUMBER 15, PAGE 217.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--AUGUST    1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --OCTOBER   1976. 
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DX,PI,ANU1,ANU2,Z,SUM,TERM,AI,COEF1,COEF2,ARG
      DOUBLE PRECISION COEF
      DOUBLE PRECISION THETA,SINTH,COSTH,A,B
      DOUBLE PRECISION DSQRT,DATAN
      DOUBLE PRECISION DFACT1,DFACT2,DNUM,DDEN
      DOUBLE PRECISION DPOW1,DPOW2
      DOUBLE PRECISION DNU1,DNU2
      DOUBLE PRECISION TERM1,TERM2,TERM3
      DATA PI/3.14159265358979D0/
      DATA DPOW1,DPOW2/0.33333333333333D0,0.66666666666667D0/
      DATA NUCUT1,NUCUT2/100,1000/
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(NU1.LE.0)GOTO50
      IF(NU2.LE.0)GOTO55
      IF(X.LT.0.0)GOTO60
      GOTO90
   50 WRITE(IPR,15) 
      WRITE(IPR,47)NU1
      CDF=0.0
      RETURN
   55 WRITE(IPR,23) 
      WRITE(IPR,47)NU2
      CDF=0.0
      RETURN
   60 WRITE(IPR,4)
      WRITE(IPR,46)X
      CDF=0.0
      RETURN
   90 CONTINUE
    4 FORMAT(1H , 96H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE FCDF   SUBROUTINE IS NEGATIVE *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 FCDF   SUBROUTINE IS NON-POSITIVE *****)
   23 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 FCDF   SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      DX=X
      M=NU1
      N=NU2
      ANU1=NU1
      ANU2=NU2
      DNU1=NU1
      DNU2=NU2
C
C     IF X IS NON-POSITIVE, SET CDF = 0.0 AND RETURN.
C     IF NU2 IS 5 THROUGH 9 AND X IS MORE THAN 3000
C     STANDARD DEVIATIONS BELOW THE MEAN,
C     SET CDF = 0.0 AND RETURN.
C     IF NU2 IS 10 OR LARGER AND X IS MORE THAN 150
C     STANDARD DEVIATIONS BELOW THE MEAN,
C     SET CDF = 0.0 AND RETURN.
C     IF NU2 IS 5 THROUGH 9 AND X IS MORE THAN 3000
C     STANDARD DEVIATIONS ABOVE THE MEAN,
C     SET CDF = 1.0 AND RETURN.
C     IF NU2 IS 10 OR LARGER AND X IS MORE THAN 150
C     STANDARD DEVIATIONS ABOVE THE MEAN,
C     SET CDF = 1.0 AND RETURN.
C
      IF(X.LE.0.0)GOTO105
      IF(NU2.LE.4)GOTO109
      T1=2.0/ANU1
      T2=ANU2/(ANU2-2.0)
      T3=(ANU1+ANU2-2.0)/(ANU2-4.0)
      AMEAN=T2
      SD=SQRT(T1*T2*T2*T3)
      ZRATIO=(X-AMEAN)/SD
      IF(NU2.LT.10.AND.ZRATIO.LT.-3000.0)GOTO105
      IF(NU2.GE.10.AND.ZRATIO.LT.-150.0)GOTO105
      IF(NU2.LT.10.AND.ZRATIO.GT.3000.0)GOTO107
      IF(NU2.GE.10.AND.ZRATIO.GT.150.0)GOTO107
      GOTO109
  105 CDF=0.0
      RETURN
  107 CDF=1.0
      RETURN
  109 CONTINUE
C
C     DISTINGUISH BETWEEN 6 SEPARATE REGIONS
C     OF THE (NU1,NU2) SPACE. 
C     BRANCH TO THE PROPER COMPUTATIONAL METHOD
C     DEPENDING ON THE REGION.
C     NUCUT1 HAS THE VALUE 100.
C     NUCUT2 HAS THE VALUE 1000.
C
      IF(NU1.LT.NUCUT2.AND.NU2.LT.NUCUT2)GOTO1000 
      IF(NU1.GE.NUCUT2.AND.NU2.GE.NUCUT2)GOTO2000 
      IF(NU1.LT.NUCUT1.AND.NU2.GE.NUCUT2)GOTO3000 
      IF(NU1.GE.NUCUT1.AND.NU2.GE.NUCUT2)GOTO2000 
      IF(NU1.GE.NUCUT2.AND.NU2.LT.NUCUT1)GOTO5000 
      IF(NU1.GE.NUCUT2.AND.NU2.GE.NUCUT1)GOTO2000 
      IBRAN=5
      WRITE(IPR,99)IBRAN
   99 FORMAT(1H ,42H*****INTERNAL ERROR IN   FCDF SUBROUTINE--,
     146HIMPOSSIBLE BRANCH CONDITION AT BRANCH POINT = ,I8) 
      RETURN
C
C     TREAT THE CASE WHEN NU1 AND NU2
C     ARE BOTH SMALL OR MODERATE
C     (THAT IS, BOTH ARE SMALLER THAN 1000).
C     METHOD UTILIZED--EXACT FINITE SUM 
C     (SEE AMS 55, PAGE 946, FORMULAE 26.6.4, 26.6.5,
C     AND 26.6.8).
C
 1000 CONTINUE
      Z=ANU2/(ANU2+ANU1*DX)
      IFLAG1=NU1-2*(NU1/2)
      IFLAG2=NU2-2*(NU2/2)
      IF(IFLAG1.EQ.0)GOTO120
      IF(IFLAG2.EQ.0)GOTO150
      GOTO250
C
C     DO THE NU1 EVEN AND NU2 EVEN OR ODD CASE
C
  120 SUM=0.0D0
      TERM=1.0D0
      IMAX=(M-2)/2
      IF(IMAX.LE.0)GOTO110
      DO100I=1,IMAX 
      AI=I
      COEF1=2.0D0*(AI-1.0D0)
      COEF2=2.0D0*AI
      TERM=TERM*((ANU2+COEF1)/COEF2)*(1.0D0-Z)
      SUM=SUM+TERM
  100 CONTINUE
C
  110 SUM=SUM+1.0D0 
      SUM=(Z**(ANU2/2.0D0))*SUM
      CDF=1.0D0-SUM 
      RETURN
C
C     DO THE NU1 ODD AND NU2 EVEN CASE
C
  150 SUM=0.0D0
      TERM=1.0D0
      IMAX=(N-2)/2
      IF(IMAX.LE.0)GOTO210
      DO200I=1,IMAX 
      AI=I
      COEF1=2.0D0*(AI-1.0D0)
      COEF2=2.0D0*AI
      TERM=TERM*((ANU1+COEF1)/COEF2)*Z
      SUM=SUM+TERM
  200 CONTINUE
C
  210 SUM=SUM+1.0D0 
      CDF=((1.0D0-Z)**(ANU1/2.0D0))*SUM 
      RETURN
C
C     DO THE NU1 ODD AND NU2 ODD CASE
C
  250 SUM=0.0D0
      TERM=1.0D0
      ARG=DSQRT((ANU1/ANU2)*DX)
      THETA=DATAN(ARG)
      SINTH=ARG/DSQRT(1.0D0+ARG*ARG)
      COSTH=1.0D0/DSQRT(1.0D0+ARG*ARG)
      IF(N.EQ.1)GOTO320
      IF(N.EQ.3)GOTO310
      IMAX=N-2
      DO300I=3,IMAX,2
      AI=I
      COEF1=AI-1.0D0
      COEF2=AI
      TERM=TERM*(COEF1/COEF2)*(COSTH*COSTH)
      SUM=SUM+TERM
  300 CONTINUE
C
  310 SUM=SUM+1.0D0 
      SUM=SUM*SINTH*COSTH
C
  320 A=(2.0D0/PI)*(THETA+SUM)
  350 SUM=0.0D0
      TERM=1.0D0
      IF(M.EQ.1)B=0.0D0
      IF(M.EQ.1)GOTO450
      IF(M.EQ.3)GOTO410
      IMAX=M-3
      DO400I=1,IMAX,2
      AI=I
      COEF1=AI
      COEF2=AI+2.0D0
      TERM=TERM*((ANU2+COEF1)/COEF2)*(SINTH*SINTH)
      SUM=SUM+TERM
  400 CONTINUE
C
  410 SUM=SUM+1.0D0 
      SUM=SUM*SINTH*(COSTH**N)
      COEF=1.0D0
      IEVODD=N-2*(N/2)
      IMIN=3
      IF(IEVODD.EQ.0)IMIN=2
      IF(IMIN.GT.N)GOTO420
      DO430I=IMIN,N,2
      AI=I
      COEF=((AI-1.0D0)/AI)*COEF
  430 CONTINUE
C
  420 COEF=COEF*ANU2
      IF(IEVODD.EQ.0)GOTO440
      COEF=COEF*(2.0D0/PI)
C
  440 B=COEF*SUM
C
  450 CDF=A-B
      RETURN
C
C     TREAT THE CASE WHEN NU1 AND NU2
C     ARE BOTH LARGE
C     (THAT IS, BOTH ARE EQUAL TO OR LARGER THAN 1000);
C     OR WHEN NU1 IS MODERATE AND NU2 IS LARGE
C     (THAT IS, WHEN NU1 IS EQUAL TO OR GREATER THAN 100
C     BUT SMALLER THAN 1000,
C     AND NU2 IS EQUAL TO OR LARGER THAN 1000);
C     OR WHEN NU2 IS MODERATE AND NU1 IS LARGE
C     (THAT IS WHEN NU2 IS EQUAL TO OR GREATER THAN 100
C     BUT SMALLER THAN 1000,
C     AND NU1 IS EQUAL TO OR LARGER THAN 1000).
C     METHOD UTILIZED--PAULSON APPROXIMATION
C     (SEE AMS 55, PAGE 947, FORMULA 26.6.15).
C
 2000 CONTINUE
      DFACT1=1.0D0/(4.5D0*DNU1)
      DFACT2=1.0D0/(4.5D0*DNU2)
      DNUM=((1.0D0-DFACT2)*(DX**DPOW1))-(1.0D0-DFACT1)
      DDEN=DSQRT((DFACT2*(DX**DPOW2))+DFACT1)
      U=DNUM/DDEN
      CALL NORCDF(U,GCDF)
      CDF=GCDF
      RETURN
C
C     TREAT THE CASE WHEN NU1 IS SMALL
C     AND NU2 IS LARGE
C     (THAT IS, WHEN NU1 IS SMALLER THAN 100,
C     AND NU2 IS EQUAL TO OR LARGER THAN 1000).
C     METHOD UTILIZED--SHEFFE-TUKEY APPROXIMATION 
C     (SEE JOHNSON AND KOTZ, VOLUME 2, PAGE 84, THIRD FORMULA).
C
 3000 CONTINUE
      TERM1=DNU1
      TERM2=(DNU1/DNU2)*(0.5D0*DNU1-1.0D0)
      TERM3=-(DNU1/DNU2)*0.5D0
      U=(TERM1+TERM2)/((1.0D0/DX)-TERM3)
      CALL CHSCDF(U,NU1,CCDF) 
      CDF=CCDF
      RETURN
C
C     TREAT THE CASE WHEN NU2 IS SMALL
C     AND NU1 IS LARGE
C     (THAT IS, WHEN NU2 IS SMALLER THAN 100,
C     AND NU1 IS EQUAL TO OR LARGER THAN 1000).
C     METHOD UTILIZED--SHEFFE-TUKEY APPROXIMATION 
C     (SEE JOHNSON AND KOTZ, VOLUME 2, PAGE 84, THIRD FORMULA).
C
 5000 CONTINUE
      TERM1=DNU2
      TERM2=(DNU2/DNU1)*(0.5D0*DNU2-1.0D0)
      TERM3=-(DNU2/DNU1)*0.5D0
      U=(TERM1+TERM2)/(DX-TERM3)
      CALL CHSCDF(U,NU2,CCDF) 
      CDF=1.0-CCDF
      RETURN
C
      END 
      SUBROUTINE FOURIE(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT FOURIE
C
C     PURPOSE--THIS SUBROUTINE PERFORMS A FOURIER ANALYSIS
C              OF THE DATA IN THE INPUT VECTOR X. 
C              THE ANALYSIS CONSISTS OF THE FOLLOWING--
C              1) COMPUTING (AND PRINTING)
C                 (FOR EACH OF THE HARMONIC FREQUENCIES
C                 1/N, 2/N, 3/N, ..., 1/2)
C                 THE CORRESPONDING FOURIER COEFICIENTS,
C                 THE AMPLITUDE, THE PHASE,
C                 THE CONTRIBUTION TO THE TOTAL VARIANCE,
C                 AND THE RELATIVE CONTRIBUTION TO THE TOTAL
C                 VARIANCE.
C              2) PLOTTING OUT A FOURIER LINE SPECTRUM =
C                 THE PERIODOGRAM = THE PLOT OF RELATIVE
C                 CONTRIBUTION TO TOTAL VARIANCE
C                 (AT EACH FOURIER FREQUENCY) VERSUS
C                 THE FOURIER FREQUENCY.
C
C              IN ORDER THAT THE RESULTS OF THE FOURIER ANALYSIS
C              BE VALID AND PROPERLY INTERPRETED, THE INPUT DATA
C              IN X SHOULD BE EQUI-SPACED IN TIME 
C              (OR WHATEVER VARIABLE CORRESPONDS TO TIME).
C
C              THE HORIZONTAL AXIS OF THE SPECTRA PRODUCED
C              BY THIS SUBROUTINE IS FREQUENCY.
C              THIS FREQUENCY IS MEASURED IN UNITS OF
C              CYCLES PER 'DATA POINT' OR, MORE PRECISELY, IN
C              CYCLES PER UNIT TIME WHERE
C              'UNIT TIME' IS DEFINED AS THE
C              ELAPSED TIME BETWEEN ADJACENT OBSERVATIONS.
C              THE RANGE OF THE FREQUENCY AXIS IS 0.0 TO 0.5.
C
C     INPUT ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED) OBSERVATIONS.
C                      N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR X.
C     OUTPUT--2 TO 10 PAGES (DEPENDING ON
C             THE INPUT SAMPLE SIZE) OF 
C             AUTOMATIC PRINTOUT--
C             1) A LISTING OF THE AMPLITUDE,
C                PHASE, CONTRIBUTION TO THE
C                TOTAL VARIANCE, AND RELATIVE
C                CONTRIBUTION TO THE TOTAL
C                VARIANCE FOR EACH OF THE
C                FOURIER FREQUENCIES
C                (1/N, 2/N, 3/N, ..., 1/2).
C                THIS LISTING MAY TAKE AS LITTLE AS 1
C                PAGE OR AS MANY AS N/100 PAGES
C                (THE EXACT NUMBER DEPENDING ON
C                THE INPUT SAMPLE SIZE N).
C                THIS LISTING IS TERMINATED
C                AFTER AT MOST 8 COMPUTER PAGES.
C                IF MORE PAGES ARE DESIRED,
C                CHANGE THE VALUE OF THE
C                VARIABLE     MAXPAG
C                WITHIN THIS SUBROUTINE 
C                FROM 8 TO WHATEVER DESIRED.
C             2) A PLOT OF THE RELATIVE 
C                CONTRIBUTION TO THE
C                TOTAL VARIANCE VERSUS FREQUENCY. 
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 15000. 
C                 --THE SAMPLE SIZE N MUST BE GREATER
C                   THAN OR EQUAL TO 3. 
C     OTHER DATAPAC   SUBROUTINES NEEDED--PLOTSP AND CHSPPF.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, SIN, COS, ATAN.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--FOURIER ANALYSIS DIFFERS FROM SPECTRAL ANALYSIS
C              (AS, FOR EXAMPLE, PRODUCED BY THE DATAPAC
C              TIMESE SUBROUTINE) IN THAT A
C              FOURIER ANALYSIS DOES NO SMOOTHING ON
C              THE SPECTRAL ESTIMATES WHEREAS A SPECRRAL
C              ANALYSIS DOES SMOOTH THE SPECTRAL ESTIMATES. 
C              THE NET RESULT IS THAT THE SPECTRAL
C              ESTIMATES OBTAINED FROM A FOURIER
C              ANALYSIS ARE ALMOST ALWAYS MORE
C              VARIABLE THAN THOSE OBTAINED IN A
C              SPECTRAL ANALYSIS.
C              THE PRACTICAL CONCLUSION IS THAT
C              WHEN THE DATA ANALYST HAS A CHOICE 
C              OF WHETHER TO PERFORM A FOURIER
C              ANALYSIS OR A SPECTRAL ANALYSIS,
C              THE SPECTRAL ANALYSIS SHOULD
C              ALMOST ALWAYS BE PREFERRED.
C            --THE MAXIMUM NUMBER OF FOURIER FREQUENCIES
C              FOR WHICH THE FOURIER COEFFICIENTS IS
C              COMPUTED (AND LISTED) IS N/2 WHERE N IS
C              THE SAMPLE SIZE (LENGTH OF THE
C              DATA RECORD IN THE VECTOR X).
C              THIS RULE IS OVERRIDDEN
C              (FOR LISTING PURPOSES ONLY)
C              IN LARGE DATA SETS AND IS REPLACED 
C              BY THE RULE THAT THE MAXIMUM
C              NUMBER OF LAGS LISTED = 800
C              (WHICH CORRESPONDS TO AN 
C              8-PAGE LISTING OF FOURIER COEFFICIENTS.
C              IF MORE PAGES ARE DESIRED,
C              CHANGE THE VALUE OF THE
C              VARIABLE     MAXPAG
C              WITHIN THIS SUBROUTINE
C              FROM 8 TO WHATEVER DESIRED.
C            --IF THE INPUT OBSERVATIONS IN X ARE CONSIDERED
C              TO HAVE BEEN COLLECTED 1 SECOND APART IN TIME,
C              THEN THE FREQUENCY AXIS OF THE RESULTING
C              SPECTRA WOULD BE IN UNITS OF HERTZ 
C              (= CYCLES PER SECOND).
C            --THE FREQUENCY OF 0.0 CORRESPONDS TO A CYCLE
C              IN THE DATA OF INFINITE (= 1/(0.0))
C              LENGTH OR PERIOD.
C              THE FREQUENCY OF 0.5 CORRESPONDS TO A CYCLE
C              IN THE DATA OF LENGTH = 1/(0.5) = 2 DATA POINTS.
C            --ANY EQUI-SPACED FOURIER ANALYSIS IS
C              INTRINSICALLY LIMITED TO DETECTING FREQUENCIES
C              NO LARGER THAN 0.5 CYCLES PER DATA POINT;
C              THIS CORRESPONDS TO THE FACT THAT THE
C              SMALLEST DETECTABLE CYCLE IN THE DATA
C              IS 2 DATA POINTS PER CYCLE.
C     REFERENCES--JENKINS AND WATTS, ESPECIALLY PAGE 290.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1972. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 ALPERC
      DIMENSION X(1)
      DIMENSION A(7500),B(7500)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (A(1),WS(1)),(B(1),WS(7501))
      DATA PI/3.14159265358979/
      DATA ALPERC/'%'/
C
      IPR=6
      ILOWER=3
      IUPPER=15000
      MAXPAG=8
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.ILOWER.OR.N.GT.IUPPER)GOTO50
      HOLD=X(1)
      DO65I=2,N
      IF(X(I).NE.HOLD)GOTO90
   65 CONTINUE
      WRITE(IPR, 9)HOLD
      RETURN
   50 WRITE(IPR,17)ILOWER,IUPPER
      WRITE(IPR,47)N
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE FOURIE SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 96H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 FOURIE SUBROUTINE IS OUTSIDE THE ALLOWABLE (,I6,1H,,I6,16H) INTER
     1VAL *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     DETERMINE IF N IS ODD OR EVEN
C
      IEVODD=N-2*(N/2)
      DEL=(AN+1.0)/2.0
      IF(IEVODD.EQ.0)DEL=(AN+2.0)/2.0
C
C     COMPUTE THE SAMPLE MEAN 
C
      SUM=0.0
      DO100I=1,N
      SUM=SUM+X(I)
  100 CONTINUE
      XBAR=SUM/AN
C
C     COMPUTE THE BIASED SAMPLE VARIANCE
C
      SUM=0.0
      DO200I=1,N
      SUM=SUM+(X(I)-XBAR)**2
  200 CONTINUE
      VBIAS=SUM/AN
C
C     COMPUTE THE FOURIER COSINE AND SINE COEFFICIENTS--THEY ARE PLACED
C     IN VECTORS A AND B, RESPECTIVELY. 
C
      NHALF=N/2
      DO400I=1,NHALF
      AI=I
      SUMA=0.0
      SUMB=0.0
      DO500J=1,N
      T=J 
      SUMA=SUMA+X(J)*COS(2.0*PI*(AI/AN)*(T-DEL))
      SUMB=SUMB+X(J)*SIN(2.0*PI*(AI/AN)*(T-DEL))
  500 CONTINUE
      A(I)=SUMA/AN
      B(I)=SUMB/AN
  400 CONTINUE
C
C     WRITE OUT THE SAMPLE SIZE, THE SAMPLE MEAN, 
C     AND THE (BIASED) SAMPLE VARIANCE. 
C
      WRITE(IPR,998)
      WRITE(IPR,801)
      WRITE(IPR,999)
      WRITE(IPR,999)
      WRITE(IPR,805)N
      WRITE(IPR,810)XBAR
      WRITE(IPR,815)VBIAS
      WRITE(IPR,999)
C
C     COMPUTE THE HARMONIC CONTRIBUTION 
C     AT EACH OF THE FOURIER FREQUENCIES.
C     THE FUNDAMENTAL FOURIER FREQUENCY 
C     IS 1/N CYCLES PER DATA POINT
C     (WHERE N = THE INPUT SAMPLE SIZE).
C     THE OTHER FOURIER FREQUENCIES
C     ARE MULTIPLES OR HARMONICS
C     (2/N, 3/N, 4/N, ...1/2) OF THE FUNDAMENTAL. 
C     COMPUTE AMPLITUDES, PHASES, AND
C     CONTRIBUTIONS TO THE VARIANCE AT EACH
C     OF THE FOURIER FREQUENCIES.
C     COMPUTE THE PERCENTAGE CONTRIBUTION
C     TO THE TOTAL VARIANCE AT EACH
C     OF THE FOURIER FREQUENCIES.
C     NOTE--TO SAVE STORAGE, ALSO COPY
C     THE PERCENTAGE CONTRIBUTIONS TO THE VARIANCE)
C     (WHICH WILL LATER BE PLOTTED OUT LIKE A SPECTRUM)
C     INTO THE VECTOR A; THIS WILL DESTROY
C     THE PREVIOUS CONTENTS OF THE VECTOR A.
C     WRITE OUT ALL OF THE ABOVE.
C
      NNPAGE=50
      I=0 
      DO600IPAGE=1,MAXPAG
      WRITE(IPR,998)
      WRITE(IPR,820)
      WRITE(IPR,821)
      WRITE(IPR,822)
      DO700J=1,NNPAGE
      I=I+1
      AI=I
      FFREQ   =AI/AN
      PERIOD=1.0/FFREQ
      ANGRAD   =(AI/AN)*2.0*PI
      ANGDEG   =(AI/AN)*360.0 
      AMP   =SQRT(A(I)*A(I)+B(I)*B(I))
      PHASE1   =ATAN(-B(I)/A(I))
      PHASE2   =PHASE1   *360.0/(2.0*PI)
      CONMSQ   =2.0*AMP   *AMP
      IF(I.EQ.NHALF.AND.IEVODD.EQ.0)CONMSQ=CONMSQ/2.0
      PERCON   =100.0*(CONMSQ   /VBIAS) 
      WRITE(IPR,825)I,FFREQ,PERIOD,A(I),B(I),AMP,PHASE1,PHASE2,
     1CONMSQ,PERCON,ALPERC
      A(I)=PERCON
      IF(I.GE.NHALF)GOTO750
      ISKIP=I-10*(I/10)
      IF(ISKIP.EQ.0)WRITE(IPR,999)
  700 CONTINUE
  600 CONTINUE
  750 CONTINUE
C
C     PLOT OUT THE PERCENTAGE CONTRIBUTIONS
C     TO THE TOTAL VARIANCE AT
C     EACH OF THE FOURIER FREQUENCIES
C     (1/N, 2/N, 3/N, ..., 1/2).
C     THIS WILL CORRESPOND TO A SPECTRAL
C     PLOT IN SPECTRAL ANALYSIS.
C
      CALL PLOTSP(A,NHALF,0)
      WRITE(IPR,855)
C
  801 FORMAT(1H ,44X,16HFOURIER ANALYSIS)
  805 FORMAT(1H ,40X,41HTHE SAMPLE SIZE N                      = ,I8) 
  810 FORMAT(1H ,40X,41HTHE SAMPLE MEAN                        = ,F20.8)
  815 FORMAT(1H ,40X,41HTHE SAMPLE VARIANCE (WITH DIVISOR N-1) = ,F20.8)
  820 FORMAT(1H ,40H     I   FOURIER   PERIOD      FOURIER  ,
     1 30H      FOURIER       AMPLITUDE ,
     1  46H      PHASE          PHASE         VARIANCE   ,
     1   10H  RELATIVE)
  821 FORMAT(1H ,44H        FREQUENCY            COEFFICIENT    ,
     1 11HCOEFFICIENT              ,
     1  59H                    RADIANS        DEGREES        COMPONENT,
     1   12H    VARIANCE)
  822 FORMAT(1H ,43H     (CYCLES/POINT)             A(I)       ,
     1 14H    B(I)      ,
     1  50H                                                  ,
     1   22H         COMPONENT (%))
  825 FORMAT(1H ,I6,2X,F8.6,1X,F8.2,6(1X,E14.7),2X,F6.2,A1) 
  855 FORMAT(1H ,40X,56HPERIODOGRAM = FOURIER LINE SPECTRUM OF THE ORIGI
     1NAL DATA)
  998 FORMAT(1H1)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE FRAN(N,NU1,NU2,ISTART,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT FRAN
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE F DISTRIBUTION
C              WITH INTEGER DEGREES OF FREEDOM
C              PARAMETERS = NU1 AND NU2.
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--N      = THE DESIRED INTEGER NUMBER 
C                                OF RANDOM NUMBERS TO BE
C                                GENERATED.
C                     --NU1    = THE INTEGER DEGREES OF FREEDOM
C                                FOR THE NUMERATOR OF THE F RATIO.
C                     --NU2    = THE INTEGER DEGREES OF FREEDOM
C                                FOR THE DENOMINATOR OF THE F RATIO.
C                     --ISTART = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL START THE
C                                GENERATOR OVER AND HENCE
C                                PRODUCE THE SAME RANDOM SAMPLE
C                                OVER AND OVER AGAIN
C                                UPON SUCCESSIVE CALLS TO
C                                THIS SUBROUTINE WITHIN A RUN; OR
C                                (IF SET TO SOME INTEGER
C                                VALUE NOT EQUAL TO 0,
C                                LIKE, SAY, 1) WILL ALLOW
C                                THE GENERATOR TO CONTINUE
C                                FROM WHERE IT STOPPED
C                                AND HENCE PRODUCE DIFFERENT
C                                RANDOM SAMPLES UPON
C                                SUCCESSIVE CALLS TO
C                                THIS SUBROUTINE WITHIN A RUN.
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 F DISTRIBUTION
C             WITH DEGREES OF FREEDOM
C             PARAMETERS = NU1 AND NU2. 
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                 --NU1 SHOULD BE A POSITIVE INTEGER VARIABLE.
C                 --NU2 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. 
C     REFERENCES--MOOD AND GRABLE, INTRODUCTION TO THE
C                 THEORY OF STATISTICS, 1963, PAGES 231-232.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--2, 1970, PAGES 75-93.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGE 64.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(2),Z(2)
      DATA PI/3.14159265358979/
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(NU1.LE.0)GOTO60
      IF(NU2.LE.0)GOTO65
      GOTO90
   50 WRITE(IPR,5)
      WRITE(IPR,47)N
      RETURN
   60 WRITE(IPR,15) 
      WRITE(IPR,47)NU1
      RETURN
   65 WRITE(IPR,25) 
      WRITE(IPR,47)NU2
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 FRAN   SUBROUTINE IS NON-POSITIVE *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 FRAN   SUBROUTINE IS NON-POSITIVE *****)
   25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 FRAN   SUBROUTINE IS NON-POSITIVE *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      CALL UNIRAN(1,ISTART,Y) 
C
C     GENERATE N F RANDOM NUMBERS
C     USING THE DEFINITION THAT
C     A F VARIATE WITH NU1 AND NU2 DEGREES OF FREEDOM
C     EQUALS (CHS1/NU1)/(CHS2/NU2)
C     WHERE CHS1 IS A CHI-SQUARED VARIATE
C     WITH NU1 DEGREES OF FREEDOM,
C     AND   CHS2 IS A CHI-SQUARED VARIATE
C     WITH NU2 DEGREES OF FREEDOM.
C     FIRST GENERATE UNIFORM (0,1) RANDOM NUMBERS,
C     THEN GENERATE NORMAL RANDOM NUMBERS,
C     THEN CHI-SQUARED RANDOM NUMBERS WITH NU1 DEGREES
C     OF FREEDOM,
C     THEN CHI-SQUARED RANDOM NUMBERS WITH NU2 DEGREES
C     OF FREEDOM,
C     AND THEN FINALLY THE F RANDOM NUMBER.
C
      ANU1=NU1
      ANU2=NU2
      DO100I=1,N
C
      SUM=0.0
      DO200J=1,NU1,2
      CALL UNIRAN(2,1,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.NU1)GOTO200
      SUM=SUM+Z(2)*Z(2)
  200 CONTINUE
      CHS1=SUM
C
      SUM=0.0
      DO300J=1,NU2,2
      CALL UNIRAN(2,1,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.NU2)GOTO300
      SUM=SUM+Z(2)*Z(2)
  300 CONTINUE
      CHS2=SUM
C
      X(I)=(CHS1/ANU1)/(CHS2/ANU2)
C
  100 CONTINUE
C
      RETURN
      END 
      SUBROUTINE FREQ(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT FREQ
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE SAMPLE FREQUENCY
C              AND SAMPLE CUMULATIVE FREQUENCY
C              FOR THE DATA IN THE INPUT VECTOR X.
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--SEVERAL (FOR LARGE DATA SETS) PAGES OF AUTOMATIC
C             PRINTOUT (WITH APPROXIMATELY 55 VALUES PER PAGE)
C             CONSISTING OF AN ORDERED LISTING OF EACH DISTINCT
C             VALUE IN THE DATA SET ALONG WITH
C             THE FREQUENCY OF OCCURANCE OF THAT VALUE
C             AND THE CUMULATIVE FREQUENCY.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 15000. 
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 1, EDITION 2, 1963, PAGE 8.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--DECEMBER  1972. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(15000)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1))
C
      IPR=6
      IUPPER=15000
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE FREQ   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 FREQ   SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** FATAL ERROR--         THE SECOND INPUT ARGUME
     1NT TO THE FREQ   SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     COMPUTE THE SAMPLE MEAN AND SAMPLE STANDARD DEVIATION 
C
      SUM=0.0
      DO100I=1,N
      SUM=SUM+X(I)
  100 CONTINUE
      XBAR=SUM/AN
      SUM=0.0
      DO200I=1,N
      SUM=SUM+(X(I)-XBAR)**2
  200 CONTINUE
      S=SQRT(SUM/(AN-1.0))
C
      WRITE(IPR,998)
      WRITE(IPR,101)
      WRITE(IPR,999)
      WRITE(IPR,102)N
      WRITE(IPR,103)XBAR
      WRITE(IPR,104)S
      WRITE(IPR,999)
      WRITE(IPR,999)
      WRITE(IPR,105)
      WRITE(IPR,106)
      WRITE(IPR,107)
      WRITE(IPR,999)
C
      CALL SORT(X,N,Y)
      NDV=0
      ICFREQ=0
      NUMSEQ=1
      NM1=N-1
      DO400I=1,NM1
      IP1=I+1
      IF(Y(I).EQ.Y(IP1))NUMSEQ=NUMSEQ+1 
      IF(Y(I).EQ.Y(IP1))GOTO400
      NDV=NDV+1
      DVALUE=Y(I)
      IFREQ=NUMSEQ
      ICFREQ=ICFREQ+IFREQ
      FRQ=IFREQ
      CFREQ=ICFREQ
      PFREQ=100.0*FRQ/AN
      PCFREQ=100.0*CFREQ/AN
      WRITE(IPR,110)NDV,DVALUE,IFREQ,PFREQ,ICFREQ,PCFREQ
      IFLAG=NDV-10*(NDV/10)
      IF(IFLAG.EQ.0)WRITE(IPR,999)
      NUMSEQ=1
  400 CONTINUE
      NDV=NDV+1
      DVALUE=Y(N)
      IFREQ=NUMSEQ
      ICFREQ=ICFREQ+IFREQ
      FRQ=IFREQ
      CFREQ=ICFREQ
      PFREQ=100.0*FRQ/AN
      PCFREQ=100.0*CFREQ/AN
      WRITE(IPR,110)NDV,DVALUE,IFREQ,PFREQ,ICFREQ,PCFREQ
      IFLAG=NDV-10*(NDV/10)
      IF(IFLAG.EQ.0)WRITE(IPR,999)
C
  101 FORMAT(1H ,18X,48HSAMPLE FREQUENCY AND SAMPLE CUMULATIVE FREQUENCY
     1)
  102 FORMAT(1H ,27X,20HTHE SAMPLE SIZE N = ,I8)
  103 FORMAT(1H ,25X,18HTHE SAMPLE MEAN = ,E15.8) 
  104 FORMAT(1H ,20X,32HTHE SAMPLE STANDARD DEVIATION = ,E15.8)
  105 FORMAT(1H , 88H    INDEX            VALUE       FREQUENCY    PERCE
     1NTAGE        CUMULATIVE    PERCENTAGE)
  106 FORMAT(1H , 88H                                              FREQU
     1ENCY         FREQUENCY     CUMULATIVE)
  107 FORMAT(1H , 88H
     1                           FREQUENCY )
  110 FORMAT(1H ,I8,4X,E17.10,3X,I8,6X,F8.4,10X,I8,6X,F8.4) 
  998 FORMAT(1H1)
  999 FORMAT(1H )
      RETURN
      END 
      SUBROUTINE GAMCDF(X,GAMMA,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT GAMCDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE FOR THE GAMMA
C              DISTRIBUTION WITH SINGLE PRECISION 
C              TAIL LENGTH PARAMETER = GAMMA.
C              THE GAMMA DISTRIBUTION USED
C              HEREIN HAS MEAN = GAMMA
C              AND STANDARD DEVIATION = SQRT(GAMMA).
C              THIS DISTRIBUTION IS DEFINED FOR ALL POSITIVE X,
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = (1/CONSTANT) * (X**(GAMMA-1)) * EXP(-X)
C              WHERE THE CONSTANT = THE GAMMA FUNCTION EVALUATED
C              AT THE VALUE GAMMA.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE 
C                                AT WHICH THE CUMULATIVE DISTRIBUTION 
C                                FUNCTION IS TO BE EVALUATED.
C                                X SHOULD BE POSITIVE.
C                     --GAMMA  = THE SINGLE PRECISION VALUE 
C                                OF THE TAIL LENGTH PARAMETER.
C                                GAMMA 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 GAMMA DISTRIBUTION 
C             WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--GAMMA SHOULD BE POSITIVE.
C                 --X SHOULD BE POSITIVE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--DEXP, DLOG.
C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     ACCURACY--(ON THE UNIVAC 1108, EXEC 8 SYSTEM AT NBS)
C               COMPARED TO THE KNOWN GAMMA = 1 (EXPONENTIAL)
C               RESULTS, AGREEMENT WAS HAD OUT TO 7 SIGNIFICANT
C               DIGITS FOR ALL TESTED X.
C               THE TESTED X VALUES COVERED THE ENTIRE
C               RANGE OF THE DISTRIBUTION--FROM THE 0.00001 
C               PERCENT POINT UP TO THE 99.99999 PERCENT POINT
C               OF THE DISTRIBUTION.
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 BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 257, FORMULA 6.1.41.
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 68-73.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DX,DGAMMA,AI,TERM,SUM,CUT1,CUT2,CUTOFF,T
      DOUBLE PRECISION Z,Z2,Z3,Z4,Z5,DEN,A,B,C,D,G
      DOUBLE PRECISION DEXP,DLOG
      DIMENSION D(10)
      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
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(X.LE.0.0)GOTO50
      IF(GAMMA.LE.0.0)GOTO55
      GOTO90
   50 WRITE(IPR,4)
      WRITE(IPR,46)X
      CDF=0.0
      RETURN
   55 WRITE(IPR,15) 
      WRITE(IPR,46)GAMMA
      CDF=0.0
      RETURN
   90 CONTINUE
    4 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE GAMCDF SUBROUTINE IS NON-POSITIVE *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 GAMCDF SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      DX=X
      DGAMMA=GAMMA
      MAXIT=10000
C
C     COMPUTE THE GAMMA FUNCTION USING THE ALGORITHM IN THE 
C     NBS APPLIED MATHEMATICS SERIES REFERENCE.
C
      Z=DGAMMA
      DEN=1.0D0
  300 IF(Z.GE.10.0D0)GOTO400
      DEN=DEN*Z
      Z=Z+1
      GOTO300
  400 Z2=Z*Z
      Z3=Z*Z2
      Z4=Z2*Z2
      Z5=Z2*Z3
      A=(Z-0.5D0)*DLOG(Z)-Z+C 
      B=D(1)/Z+D(2)/Z3+D(3)/Z5+D(4)/(Z2*Z5)+D(5)/(Z4*Z5)+
     1D(6)/(Z*Z5*Z5)+D(7)/(Z3*Z5*Z5)+D(8)/(Z5*Z5*Z5)+D(9)/(Z2*Z5*Z5*Z5)
      G=DEXP(A+B)/DEN
C
C     COMPUTE T-SUB-Q AS DEFINED ON PAGE 4 OF THE WILK, GNANADESIKAN, 
C     AND HUYETT REFERENCE
C
      SUM=1.0D0/DGAMMA
      TERM=1.0D0/DGAMMA
      CUT1=DX-DGAMMA
      CUT2=DX*10000000000.0D0 
      DO200I=1,MAXIT
      AI=I
      TERM=DX*TERM/(DGAMMA+AI)
      SUM=SUM+TERM
      CUTOFF=CUT1+(CUT2*TERM/SUM)
      IF(AI.GT.CUTOFF)GOTO250 
  200 CONTINUE
      WRITE(IPR,205)MAXIT
      WRITE(IPR,206)X
      WRITE(IPR,207)GAMMA
      WRITE(IPR,208)
      CDF=1.0
      RETURN
C
  250 T=SUM
      CDF=(DX**DGAMMA)*(DEXP(-DX))*T/G
C
  205 FORMAT(1H ,48H*****ERROR IN INTERNAL OPERATIONS IN THE GAMCDF , 
     1 45HSUBROUTINE--THE NUMBER OF ITERATIONS EXCEEDS ,I7) 
  206 FORMAT(1H ,33H     THE INPUT VALUE OF X     IS ,E15.8)
  207 FORMAT(1H ,33H     THE INPUT VALUE OF GAMMA IS ,E15.8)
  208 FORMAT(1H ,48H     THE OUTPUT VALUE OF CDF HAS BEEN SET TO 1.0) 
C
      RETURN
      END 
      SUBROUTINE GAMPLT(X,N,GAMMA)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT GAMPLT
C
C     PURPOSE--THIS SUBROUTINE GENERATES A GAMMA
C              PROBABILITY PLOT
C              (WITH TAIL LENGTH PARAMETER VALUE = GAMMA).
C              THE PROTOTYPE GAMMA DISTRIBUTION USED
C              HEREIN HAS MEAN = GAMMA
C              AND STANDARD DEVIATION = SQRT(GAMMA).
C              THIS DISTRIBUTION IS DEFINED FOR ALL POSITIVE X,
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = (1/CONSTANT) * (X**(GAMMA-1)) * EXP(-X)
C              WHERE THE CONSTANT = THE GAMMA FUNCTION EVALUATED
C              AT THE VALUE GAMMA.
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 GAMMA 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  GAMMA DISTRIBUTION
C              WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
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                     --GAMMA  = THE SINGLE PRECISION VALUE OF THE
C                                TAIL LENGTH PARAMETER.
C                                GAMMA SHOULD BE POSITIVE.
C     OUTPUT--A ONE-PAGE GAMMA PROBABILITY PLOT.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C                 --GAMMA SHOULD BE POSITIVE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, PLOT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ABS, EXP, DEXP, DLOG. 
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION AND DOUBLE PRECISION
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--WILK, GNANADESIKAN, AND HUYETT, 'PROBABILITY
C                 PLOTS FOR THE GAMMA DISTRIBUTION',
C                 TECHNOMETRICS, 1962, PAGES 1-15.
C               --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 257, FORMULA 6.1.41.
C               --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 166-206.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1974. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION Z,Z2,Z3,Z4,Z5,DEN,A,B,C,D
      DOUBLE PRECISION DEXP,DLOG
      DIMENSION D(10)
      DIMENSION X(1)
      DIMENSION Y(7500),W(7500)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501))
      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
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      IF(GAMMA.LE.0.0)GOTO60
      HOLD=X(1)
      DO65I=2,N
      IF(X(I).NE.HOLD)GOTO90
   65 CONTINUE
      WRITE(IPR, 9)HOLD
      RETURN
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   60 WRITE(IPR,25) 
      WRITE(IPR,46)GAMMA
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE GAMPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 GAMPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE GAMPLT SUBROUTINE HAS THE VALUE 1 *****)
   25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 GAMPLT SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
      DGAMMA=GAMMA
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
      Z3=Z*Z2
      Z4=Z2*Z2
      Z5=Z2*Z3
      A=(Z-0.5D0)*DLOG(Z)-Z+C 
      B=D(1)/Z+D(2)/Z3+D(3)/Z5+D(4)/(Z2*Z5)+D(5)/(Z4*Z5)+
     1D(6)/(Z*Z5*Z5)+D(7)/(Z3*Z5*Z5)+D(8)/(Z5*Z5*Z5)+D(9)/(Z2*Z5*Z5*Z5)
      G=DEXP(A+B)/DEN
C
C     SORT THE DATA 
C
      CALL SORT(X,N,Y)
C
C     GENERATE UNIFORM ORDER STATISTIC MEDIANS
C
      CALL UNIMED(N,W)
C
C     GENERATE GAMMA DISTRIBUTION ORDER STATISTIC MEDIANS
C
C     DETERMINE LOWER AND UPPER BOUNDS ON THE DESIRED I-TH GAMMA
C     ORDER STATISTIC MEDIAN. 
C     FOR EACH I, A LOWER BOUND IS GIVEN BY
C     (Y(I)*GAMMA*THE GAMMA FUNCTION OF GAMMA)**(1.0/GAMMA) 
C     WHERE Y(I) IS THE CORRESPONDING UNIFORM (0,1) ORDER STATISIC
C     MEDIAN.
C     FOR EACH I EXCEPT I = N, AN UPPER BOUND IS GIVEN BY THE
C     (I+1)-ST GAMMA ORDER STATISTIC MEDIAN (ASSUMEDLY ALREADY
C     CALCULTATED). 
C     FOR I = N, AN UPPER BOUND IS DETERMINED BY COMPUTING
C     MULTIPLES OF THE LOWER BOUND FOR I = N UNTIL A LARGER 
C     VALUE IS OBTAINED.
C     DUE TO THE ABOVE CONSIDERATIONS, THE GAMMA ORDER STATISTIC
C     MEDIANS WILL BE CALCULATED LARGEST TO SMALLEST, THAT IS,
C     IN THE FOLLOWING SEQUENCE:  W(N), W(N-1), ..., W(2), W(1).
C     NOTE ALSO THAT 1) THE CODE IS COMPLICATED SLIGHTLY BY THE
C     FACT THAT PERCENT POINT VALUES INVOLVED IN THE CALCULATION OF
C     THE TAIL LENGTH MEASURE TAU (SEE LABEL 605) ARE GOING ON
C     'SIMULATNEOUSLY'. AND 2) THE VECTOR W WILL AT VARIOUS TIMES
C     IN THE PROGRAM HAVE UNIFORM ORDER STATISTIC MEDIANS AND
C     THEN LATER GRADUALLY FILL UP WITH GAMMA ORDER STATISTIC
C     MEDIANS.
C
      I=N 
      ITAIL=0
  310 IF(ITAIL.EQ.0)U=W(I)
      DP=U
      XMIN0=(U*GAMMA*G)**(1.0/GAMMA)
      XMIN=XMIN0
      IF(I.EQ.N.OR.ITAIL.GE.1)GOTO320
      IP1=I+1
      XMAX=W(IP1)
      GOTO370
  320 ILOOP=1
      ICOUNT=1
  350 ACOUNT=ICOUNT 
      XMAX=ACOUNT*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.0
C
C     AT THIS STAGE WE NOW HAVE LOWER AND UPPER LIMITS ON
C     THE DESIRED I-TH GAMMA ORDER STATISITC MEDIAN W(I).
C     NOW ITERATE BY BISECTION UNTIL THE DESIRED ACCURACY IS ACHIEVED 
C     FOR THE I-TH GAMMA ORDER STATISITIC MEDIAN. 
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.0
      GOTO590
  580 XUPPER=XMID
      XMID=(XMID+XLOWER)/2.0
  590 XDEL=ABS(XMID-XLOWER)
      ICOUNT=ICOUNT+1
      IF(XDEL.LT.0.0000001.OR.ICOUNT.GT.100)GOTO570
      GOTO550
  570 IF(ITAIL.GE.1)GOTO605
      W(I)=XMID
      IF(I.LE.1)GOTO595
      I=I-1
      GOTO310
  595 CONTINUE
C
C     AT THIS POINT, THE GAMMA ORDER STATISTIC MEDIANS ARE ALL COMPUTED.
C     NOW PLOT OUT THE GAMMA PROBABILITY PLOT
C
      CALL PLOT(Y,W,N)
C
C     COMPUTE THE TAIL LENGTH MEASURE OF THE DISTRIBUTION.
C     WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION 
C     AND THE SAMPLE SIZE.
C
  605 IF(ITAIL.EQ.0)GOTO600
      IF(ITAIL.EQ.1)GOTO610
      IF(ITAIL.EQ.2)GOTO620
      IF(ITAIL.EQ.3)GOTO630
      GOTO640
  600 U=.9975
      ITAIL=1
      GOTO310
  610 PP9975=XMID
      U=.0025
      ITAIL=2
      GOTO310
  620 PP0025=XMID
      U=.975
      ITAIL=3
      GOTO310
  630 PP975=XMID
      U=.025
      ITAIL=4
      GOTO310
  640 PP025=XMID
      TAU=(PP9975-PP0025)/(PP975-PP025) 
      WRITE(IPR,655)GAMMA,TAU,N
C
C     COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. 
C     COMPUTE LOCATION AND SCALE ESTIMATES
C     FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. 
C     THEN WRITE THEM OUT.
C
      SUM1=0.0
      SUM2=0.0
      DO660I=1,N
      SUM1=SUM1+Y(I)
      SUM2=SUM2+W(I)
  660 CONTINUE
      YBAR=SUM1/AN
      WBAR=SUM2/AN
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO670I=1,N
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) 
      SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) 
      SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 
  670 CONTINUE
      CC=SUM2/SQRT(SUM3*SUM1) 
      YSLOPE=SUM2/SUM3
      YINT=YBAR-YSLOPE*WBAR
      WRITE(IPR,675)CC,YINT,YSLOPE
C
  655 FORMAT(1H ,46HGAMMA PROBABILITY PLOT WITH SHAPE PARAMETER = ,
     1E17.10,1X,7H(TAU = ,E15.8,1H),16X,16HSAMPLE SIZE N = ,I7)
  675 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X,
     122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) 
C
      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.0/DGAMMA
      TERM=1.0/DGAMMA
      CUT1=DX-DGAMMA
      CUT2=DX*10000000.0
      DO700J=1,1000 
      AJ=J
      TERM=DX*TERM/(DGAMMA+AJ)
      SUM=SUM+TERM
      CUTOFF=CUT1+(CUT2*TERM/SUM)
      IF(AJ.GT.CUTOFF)GOTO750 
  700 CONTINUE
      WRITE(IPR,705)
      WRITE(IPR,707)GAMMA
  705 FORMAT(1H ,48H*****ERROR IN INTERNAL OPERATIONS IN THE GAMPLT , 
     1 53HSUBROUTINE--THE NUMBER OF CDF ITERATIONS EXCEEDS 1000)
  707 FORMAT(1H ,33H     THE INPUT VALUE OF GAMMA IS ,E15.8)
  750 T=SUM
      PCALC=(DX**DGAMMA)*(EXP(-DX))*T/G 
      IF(ILOOP.EQ.1)GOTO360
      GOTO560
C
      END 
      SUBROUTINE GAMPPF(P,GAMMA,PPF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT GAMPPF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE FOR THE GAMMA DISTRIBUTION
C              WITH SINGLE PRECISION
C              TAIL LENGTH PARAMETER = GAMMA.
C              THE GAMMA DISTRIBUTION USED
C              HEREIN HAS MEAN = GAMMA
C              AND STANDARD DEVIATION = SQRT(GAMMA).
C              THIS DISTRIBUTION IS DEFINED FOR ALL POSITIVE X,
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = (1/CONSTANT) * (X**(GAMMA-1)) * EXP(-X)
C              WHERE THE CONSTANT = THE GAMMA FUNCTION EVALUATED
C              AT THE VALUE GAMMA.
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 (EXCLUSIVELY) 
C                                AND 1.0 (EXCLUSIVELY))
C                                AT WHICH THE PERCENT POINT 
C                                FUNCTION IS TO BE EVALUATED.
C                     --GAMMA  = THE SINGLE PRECISION VALUE OF THE
C                                TAIL LENGTH PARAMETER.
C                                GAMMA 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 GAMMA DISTRIBUTION
C             WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--GAMMA SHOULD BE POSITIVE.
C                 --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY)
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. 
C     ACCURACY--(ON THE UNIVAC 1108, EXEC 8 SYSTEM AT NBS)
C               COMPARED TO THE KNOWN GAMMA = 1 (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 BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 257, FORMULA 6.1.41.
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 68-73.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1974. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DP,DGAMMA
      DOUBLE PRECISION Z,Z2,Z3,Z4,Z5,DEN,A,B,C,D,G
      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 DEXP,DLOG
      DIMENSION D(10)
      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
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LE.0.0.OR.P.GE.1.0)GOTO50
      IF(GAMMA.LE.0.0)GOTO55
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      PPF=0.0
      RETURN
   55 WRITE(IPR,15) 
      WRITE(IPR,46)GAMMA
      PPF=0.0
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 GAMPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 GAMPPF SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      DP=P
      DGAMMA=GAMMA
      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
      Z3=Z*Z2
      Z4=Z2*Z2
      Z5=Z2*Z3
      A=(Z-0.5D0)*DLOG(Z)-Z+C 
      B=D(1)/Z+D(2)/Z3+D(3)/Z5+D(4)/(Z2*Z5)+D(5)/(Z4*Z5)+
     1D(6)/(Z*Z5*Z5)+D(7)/(Z3*Z5*Z5)+D(8)/(Z5*Z5*Z5)+D(9)/(Z2*Z5*Z5*Z5)
      G=DEXP(A+B)/DEN
C
C     DETERMINE LOWER AND UPPER LIMITS ON THE DESIRED 100P
C     PERCENT POINT.
C
      ILOOP=1
      XMIN0=(DP*DGAMMA*G)**(1.0D0/DGAMMA)
      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=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(IPR,705)MAXIT
      WRITE(IPR,706)P
      WRITE(IPR,707)GAMMA
      WRITE(IPR,708)
      PPF=0.0
      RETURN
C
  750 T=SUM
      PCALC=(DX**DGAMMA)*(DEXP(-DX))*T/G
      IF(ILOOP.EQ.1)GOTO360
      GOTO560
C
  705 FORMAT(1H ,48H*****ERROR IN INTERNAL OPERATIONS IN THE GAMPPF , 
     1 45HSUBROUTINE--THE NUMBER OF ITERATIONS EXCEEDS ,I7) 
  706 FORMAT(1H ,33H     THE INPUT VALUE OF P     IS ,E15.8)
  707 FORMAT(1H ,33H     THE INPUT VALUE OF GAMMA IS ,E15.8)
  708 FORMAT(1H ,48H     THE OUTPUT VALUE OF PPF HAS BEEN SET TO 0.0) 
C
      END 
      SUBROUTINE GAMRAN(N,GAMMA,ISEED,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT GAMRAN
C     ******STILL NEEDS ALGORITHM WORK ******
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE GAMMA DISTRIBUTION
C              WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
C              THE PROTOTYPE GAMMA DISTRIBUTION USED
C              HEREIN HAS MEAN = GAMMA
C              AND STANDARD DEVIATION = SQRT(GAMMA).
C              THIS DISTRIBUTION IS DEFINED FOR ALL POSITIVE X,
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = (1/CONSTANT) * (X**(GAMMA-1)) * EXP(-X)
C              WHERE THE CONSTANT = THE GAMMA FUNCTION EVALUATED
C              AT THE VALUE GAMMA.
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
C                                OF RANDOM NUMBERS TO BE
C                                GENERATED.
C                     --GAMMA  = THE SINGLE PRECISION VALUE OF THE
C                                TAIL LENGTH PARAMETER.
C                                GAMMA SHOULD BE POSITIVE.
C                                GAMMA SHOULD BE LARGER
C                                THAN 1/3 (ALGORITHMIC RESTRICTION).
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 GAMMA DISTRIBUTION
C             WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
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                 --GAMMA SHOULD BE POSITIVE.
C                 --GAMMA SHOULD BE LARGER
C                   THAN 1/3 (ALGORITHMIC RESTRICTION).
C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN, NORRAN.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, EXP.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--GREENWOOD, 'A FAST GENERATOR FOR
C                 GAMMA-DISTRIBUTED RANDOM VARIABLES',
C                 COMPSTAT 1974, PROCEEDINGS IN
C                 COMPUTATIONAL STATISTICS, VIENNA,
C                 SEPTEMBER, 1974, PAGES 19-27.
C               --TOCHER, THE ART OF SIMULATION,
C                 1963, PAGES 24-27.
C               --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS,
C                 1964, PAGES 36-37.
C               --WILK, GNANADESIKAN, AND HUYETT, 'PROBABILITY
C                 PLOTS FOR THE GAMMA DISTRIBUTION',
C                 TECHNOMETRICS, 1962, PAGES 1-15.
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 68-73.
C               --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 952.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1975.
C     UPDATED         --FEBRUARY  1976.
C     UPDATED         --JUNE      1978.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
C
C---------------------------------------------------------------------
C
CCCCC CHARACTER*4 IFEEDB
CCCCC CHARACTER*4 IPRINT
C
CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
CCCCC COMMON /PRINT/IFEEDB,IPRINT
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA ATHIRD/0.3333333/
      DATA SQRT3 /1.73205081/
C
      IPR=6
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(GAMMA.LE.0.0)GOTO60
      IF(GAMMA.LE.0.33333333)GOTO65
      GOTO90
   50 WRITE(IPR, 5)
      WRITE(IPR,47)N
      RETURN
   60 WRITE(IPR,15)
      WRITE(IPR,46)GAMMA
      RETURN
   65 WRITE(IPR,16)
      WRITE(IPR,17)
      WRITE(IPR,46)GAMMA
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 GAMRAN SUBROUTINE IS NON-POSITIVE *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 GAMRAN SUBROUTINE IS NON-POSITIVE *****)
   16 FORMAT(1H ,114H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 GAMRAN SUBROUTINE IS SMALLER THAN OR EQUAL TO 0.33333333 *****)
   17 FORMAT(1H , 44H                   (ALGORITHMIC RESTIRCTION))
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C     GENERATE N GAMMA DISTRIBUTION RANDOM NUMBERS
C     USING GREENWOOD'S REJECTION ALGORITHM--
C     1) GENERATE A NORMAL RANDOM NUMBER;
C     2) TRANSFORM THE NORMAL VARIATE TO AN APPROXIMATE
C        GAMMA VARIATE USING THE WILSON-HILFERTY
C        APPROXIMATION (SEE THE JOHNSON AND KOTZ
C        REFERENCE, PAGE 176);
C     3) FORM THE REJECTION FUNCTION VALUE, BASED
C        ON THE PROBABILITY DENSITY FUNCTION VALUE
C        OF THE ACTUAL DISTRIBUTION OF THE PSEUDO-GAMMA
C        VARIATE, AND THE PROBABILITY DENSITY FUNCTION VALUE
C        OF A TRUE GAMMA VARIATE.
C     4) GENERATE A UNIFORM RANDOM NUMBER;
C     5) IF THE UNIFORM RANDOM NUMBER IS LESS THAN
C        THE REJECTION FUNCTION VALUE, THEN ACCEPT
C        THE PSEUDO-RANDOM NUMBER AS A GAMMA VARIATE;
C        IF THE UNIFORM RANDOM NUMBER IS LARGER THAN
C        THE REJECTION FUNCTION VALUE, THEN REJECT
C        THE PSEUDO-RANDOM NUMBER AS A GAMMA VARIATE.
C
      A1=1.0/(9.0*GAMMA)
      B1=SQRT(A1)
      XN0=-SQRT3+B1
      XG0=GAMMA*(1.0-A1+B1*XN0)**3
      DO100I=1,N
  150 CALL NORRAN(1,ISEED,XN)
      XG=GAMMA*(1.0-A1+B1*XN)**3
      IF(XG.LT.0.0)GOTO150
      TERM=(XG/XG0)**(GAMMA-ATHIRD)
      ARG=0.5*XN*XN-XG-0.5*XN0*XN0+XG0
      FUNCT=TERM*EXP(ARG)
      CALL UNIRAN(1,ISEED,U)
      IF(U.LE.FUNCT)GOTO170
      GOTO150
  170 X(I)=XG
  100 CONTINUE
C
      RETURN
      END
      SUBROUTINE GEOCDF(X,P,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT GEOCDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE AT THE SINGLE PRECISION VALUE X
C              FOR THE GEOMETRIC DISTRIBUTION
C              WITH SINGLE PRECISION
C              'BERNOULLI PROBABILITY' PARAMETER = P.
C              THE GEOMETRIC DISTRIBUTION USED HEREIN
C              HEREIN HAS MEAN = (1-P)/P
C              AND STANDARD DEVIATION = SQRT((1-P)/(P*P))). 
C              THIS DISTRIBUTION IS DEFINED FOR
C              ALL NON-NEGATIVE INTEGER X--X = 0, 1, 2, ... .
C              THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION
C              F(X) = P * (1-P)**X.
C              THE GEOMETRIC DISTRIBUTION IS THE
C              DISTRIBUTION OF THE NUMBER OF FAILURES
C              BEFORE OBTAINING 1 SUCCESS IN AN
C              INDEFINITE SEQUENCE OF BERNOULLI (0,1)
C              TRIALS WHERE THE PROBABILITY OF SUCCESS
C              IN A SINGLE TRIAL = P.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE 
C                                AT WHICH THE CUMULATIVE DISTRIBUTION 
C                                FUNCTION IS TO BE EVALUATED.
C                                X SHOULD BE NON-NEGATIVE AND
C                                INTEGRAL-VALUED. 
C                     --P      = THE SINGLE PRECISION VALUE 
C                                OF THE 'BERNOULLI PROBABILITY'
C                                PARAMETER FOR THE GEOMETRIC
C                                DISTRIBUTION.
C                                P SHOULD BE BETWEEN
C                                0.0 (EXCLUSIVELY) AND
C                                1.0 (EXCLUSIVELY).
C     OUTPUT ARGUMENTS--CDF    = THE SINGLE PRECISION CUMULATIVE
C                                DISTRIBUTION FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION
C             FUNCTION VALUE CDF
C             FOR THE GEOMETRIC DISTRIBUTION
C             WITH 'BERNOULLI PROBABILITY' PARAMETER = P.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE AND INTEGRAL-VALUED.
C                 --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--NOTE THAT EVEN THOUGH THE INPUT
C              TO THIS CUMULATIVE
C              DISTRIBUTION FUNCTION SUBROUTINE
C              FOR THIS DISCRETE DISTRIBUTION
C              SHOULD (UNDER NORMAL CIRCUMSTANCES) BE A
C              DISCRETE INTEGER VALUE,
C              THE INPUT VARIABLE X IS SINGLE
C              PRECISION IN MODE.
C              X HAS BEEN SPECIFIED AS SINGLE
C              PRECISION SO AS TO CONFORM WITH THE DATAPAC
C              CONVENTION THAT ALL INPUT ****DATA****
C              (AS OPPOSED TO SAMPLE SIZE, FOR EXAMPLE)
C              VARIABLES TO ALL
C              DATAPAC SUBROUTINES ARE SINGLE PRECISION.
C              THIS CONVENTION IS BASED ON THE BELIEF THAT
C              1) A MIXTURE OF MODES (FLOATING POINT
C              VERSUS INTEGER) IS INCONSISTENT AND
C              AN UNNECESSARY COMPLICATION
C              IN A DATA ANALYSIS; AND
C              2) FLOATING POINT MACHINE ARITHMETIC
C              (AS OPPOSED TO INTEGER ARITHMETIC) 
C              IS THE MORE NATURAL MODE FOR DOING 
C              DATA ANALYSIS. 
C     REFERENCES--FELLER, AN INTRODUCTION TO PROBABILITY
C                 THEORY AND ITS APPLICATIONS, VOLUME 1,
C                 EDITION 2, 1957, PAGES 155-157, 210.
C               --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 929.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LE.0.0.OR.P.GE.1.0)GOTO50
      IF(X.LT.0.0)GOTO55
      INTX=X+0.0001 
      FINTX=INTX
      DEL=X-FINTX
      IF(DEL.LT.0.0)DEL=-DEL
      IF(DEL.GT.0.001)GOTO60
      GOTO90
   50 WRITE(IPR,11) 
      WRITE(IPR,46)P
      CDF=0.0
      RETURN
   55 WRITE(IPR,4)
      WRITE(IPR,46)X
      CDF=0.0
      RETURN
   60 WRITE(IPR,5)
      WRITE(IPR,46)X
   90 CONTINUE
    4 FORMAT(1H , 96H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE GEOCDF SUBROUTINE IS NEGATIVE *****)
    5 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE GEOCDF SUBROUTINE IS NON-INTEGRAL *****)
   11 FORMAT(1H ,115H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 GEOCDF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      CDF=1.0-(1.0-P)**(X+1.0)
C
      RETURN
      END 
      SUBROUTINE GEOPLT(X,N,P)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT GEOPLT
C
C     PURPOSE--THIS SUBROUTINE GENERATES A GEOMETRIC
C              PROBABILITY PLOT
C              (WITH 'BERNOULLI PROBABILITY' PARAMETER VALUE = P).
C              THE GEOMETRIC DISTRIBUTION USED
C              HEREIN HAS MEAN = (1-P)/P
C              AND STANDARD DEVIATION = SQRT((1-P)/(P*P))). 
C              THIS DISTRIBUTION IS DEFINED FOR
C              ALL NON-NEGATIVE INTEGER X--X = 0, 1, 2, ... .
C              THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION
C              F(X) = P * (1-P)**X.
C              THE GEOMETRIC DISTRIBUTION IS THE
C              DISTRIBUTION OF THE NUMBER OF FAILURES
C              BEFORE OBTAINING 1 SUCCESS IN AN
C              INDEFINITE SEQUENCE OF BERNOULLI (0,1)
C              TRIALS WHERE THE PROBABILITY OF SUCCESS
C              IN A SINGLE TRIAL = P.
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 GEOMETRIC 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  GEOMETRIC DISTRIBUTION
C              WITH PROBABILITY PARAMETER VALUE = P.
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                     --P      = THE SINGLE PRECISION VALUE 
C                                OF THE 'BERNOULLI PROBABILITY'
C                                PARAMETER FOR THE GEOMETRIC
C                                DISTRIBUTION.
C                                P SHOULD BE BETWEEN
C                                0.0 (EXCLUSIVELY) AND
C                                1.0 (EXCLUSIVELY).
C     OUTPUT--A ONE-PAGE GEOMETRIC PROBABILITY PLOT.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C                 --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, PLOT, GEOPPF. 
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
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               --FELLER, AN INTRODUCTION TO PROBABILITY
C                 THEORY AND ITS APPLICATIONS, VOLUME 1,
C                 EDITION 2, 1957, PAGES 155-157, 210.
C               --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 929.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C     UPDATED         --FEBRUARY  1976. 
C     UPDATED         --MARCH     1987. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(7500),W(7500)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501))
C
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      IF(P.LE.0.0.OR.P.GE.1.0)GO TO 60
      HOLD=X(1)
      DO65I=2,N
      IF(X(I).NE.HOLD)GOTO90
   65 CONTINUE
      WRITE(IPR, 9)HOLD
      RETURN
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   60 WRITE(IPR,21) 
      WRITE(IPR,46)P
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE GEOPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 GEOPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE GEOPLT SUBROUTINE HAS THE VALUE 1 *****)
   21 FORMAT(1H ,115H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 GEOPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     SORT THE DATA 
C
      CALL SORT(X,N,Y)
C
C     GENERATE UNIFORM ORDER STATISTIC MEDIANS
C
      CALL UNIMED(N,W)
C
C     COMPUTE GEOMETRIC DISTRIBUTION ORDER STATISTIC MEDIANS
C
      DO100I=1,N
      CALL GEOPPF(W(I),P,W(I))
  100 CONTINUE
C
C     PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS.
C     COMPUTE THE TAIL LENGTH MEASURE OF THE DISTRIBUTION.
C     WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION 
C     AND THE SAMPLE SIZE.
C
      CALL PLOT(Y,W,N)
      Q=.9975
      CALL GEOPPF(Q,P,PP9975) 
      Q=.0025
      CALL GEOPPF(Q,P,PP0025) 
      Q=.975
      CALL GEOPPF(Q,P,PP975)
      Q=.025
      CALL GEOPPF(Q,P,PP025)
      TAU=(PP9975-PP0025)/(PP975-PP025) 
      WRITE(IPR,105)P,TAU,N
C
C     COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. 
C     COMPUTE LOCATION AND SCALE ESTIMATES
C     FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. 
C     THEN WRITE THEM OUT.
C
      SUM1=0.0
      SUM2=0.0
      DO200I=1,N
      SUM1=SUM1+Y(I)
      SUM2=SUM2+W(I)
  200 CONTINUE
      YBAR=SUM1/AN
      WBAR=SUM2/AN
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO300I=1,N
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) 
      SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) 
      SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 
  300 CONTINUE
      CC=SUM2/SQRT(SUM3*SUM1) 
      YSLOPE=SUM2/SUM3
      YINT=YBAR-YSLOPE*WBAR
      WRITE(IPR,305)CC,YINT,YSLOPE
C
  105 FORMAT(1H ,44HGEOMETRIC PROBABILITY PLOT WITH PROBABILITY ,
     1 12HPARAMETER = ,E17.10,1X,7H(TAU = ,E15.8,1H),11X,11HTHE SAMPLE ,
     1  9HSIZE N = ,I7)
  305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X,
     122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) 
C
      RETURN
      END 
      SUBROUTINE GEOPPF(P,PPAR,PPF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT GEOPPF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE FOR THE GEOMETRIC
C              DISTRIBUTION WITH SINGLE PRECISION 
C              'BERNOULLI PROBABILITY' PARAMETER = PPAR.
C              THE GEOMETRIC DISTRIBUTION USED
C              HEREIN HAS MEAN = (1-PPAR)/PPAR
C              AND STANDARD DEVIATION = SQRT((1-PPAR)/(PPAR*PPAR))).
C              THIS DISTRIBUTION IS DEFINED FOR
C              ALL NON-NEGATIVE INTEGER X--X = 0, 1, 2, ... .
C              THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION
C              F(X) = PPAR * (1-PPAR)**X.
C              THE GEOMETRIC DISTRIBUTION IS THE
C              DISTRIBUTION OF THE NUMBER OF FAILURES
C              BEFORE OBTAINING 1 SUCCESS IN AN
C              INDEFINITE SEQUENCE OF BERNOULLI (0,1)
C              TRIALS WHERE THE PROBABILITY OF SUCCESS
C              IN A SINGLE TRIAL = PPAR.
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                     --PPAR   = THE SINGLE PRECISION VALUE 
C                                OF THE 'BERNOULLI PROBABILITY'
C                                PARAMETER FOR THE GEOMETRIC
C                                DISTRIBUTION.
C                                PPAR SHOULD BE BETWEEN
C                                0.0 (EXCLUSIVELY) AND
C                                1.0 (EXCLUSIVELY).
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 GEOMETRIC DISTRIBUTION
C             WITH 'BERNOULLI PROBABILITY' PARAMETER VALUE = PPAR.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--PPAR SHOULD BE BETWEEN 0.0 (EXCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C                 --P SHOULD BE BETWEEN 0.0 (INCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--NOTE THAT EVEN THOUGH THE OUTPUT
C              FROM THIS DISCRETE DISTRIBUTION
C              PERCENT POINT FUNCTION
C              SUBROUTINE MUST NECESSARILY BE A
C              DISCRETE INTEGER VALUE,
C              THE OUTPUT VARIABLE PPF IS SINGLE
C              PRECISION IN MODE.
C              PPF HAS BEEN SPECIFIED AS SINGLE
C              PRECISION SO AS TO CONFORM WITH THE DATAPAC
C              CONVENTION THAT ALL OUTPUT VARIABLES FROM ALL
C              DATAPAC SUBROUTINES ARE SINGLE PRECISION.
C              THIS CONVENTION IS BASED ON THE BELIEF THAT
C              1) A MIXTURE OF MODES (FLOATING POINT
C              VERSUS INTEGER) IS INCONSISTENT AND
C              AN UNNECESSARY COMPLICATION
C              IN A DATA ANALYSIS; AND
C              2) FLOATING POINT MACHINE ARITHMETIC
C              (AS OPPOSED TO INTEGER ARITHMETIC) 
C              IS THE MORE NATURAL MODE FOR DOING 
C              DATA ANALYSIS. 
C     REFERENCES--FELLER, AN INTRODUCTION TO PROBABILITY
C                 THEORY AND ITS APPLICATIONS, VOLUME 1,
C                 EDITION 2, 1957, PAGES 155-157, 210.
C               --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 929.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LT.0.0.OR.P.GE.1.0)GOTO50
      IF(PPAR.LE.0.0.OR.PPAR.GE.1.0)GOTO55
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      PPF=0.0
      RETURN
   55 WRITE(IPR,11) 
      WRITE(IPR,46)PPAR
      PPF=0.0
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 GEOPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   11 FORMAT(1H ,115H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 GEOPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      IF(P.NE.0.0)GOTO150
      PPF=0.0
      RETURN
  150 CONTINUE
C
      ARG1=1.0-P
      ARG2=1.0-PPAR 
      ANUM=ALOG(ARG1)
      ADEN=ALOG(ARG2)
      RATIO=ANUM/ADEN
      IRATIO=RATIO
      PPF=IRATIO
      ARATIO=IRATIO 
      IF(ARATIO.EQ.RATIO)PPF=IRATIO-1
      RETURN
C
      END 
      SUBROUTINE GEORAN(N,P,ISEED,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT GEORAN
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE GEOMETRIC DISTRIBUTION
C              WITH SINGLE PRECISION 'BERNOULLI PROBABILITY'
C              PARAMETER = P.
C              THE GEOMETRIC DISTRIBUTION USED
C              HEREIN HAS MEAN = (1-P)/P
C              AND STANDARD DEVIATION = SQRT((1-P)/(P*P))).
C              THIS DISTRIBUTION IS DEFINED FOR
C              ALL NON-NEGATIVE INTEGER X--X = 0, 1, 2, ... .
C              THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION
C              F(X) = P * (1-P)**X.
C              THE GEOMETRIC DISTRIBUTION IS THE
C              DISTRIBUTION OF THE NUMBER OF FAILURES
C              BEFORE OBTAINING 1 SUCCESS IN AN
C              INDEFINITE SEQUENCE OF BERNOULLI (0,1)
C              TRIALS WHERE THE PROBABILITY OF SUCCESS
C              IN A SINGLE TRIAL = P.
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
C                                OF RANDOM NUMBERS TO BE
C                                GENERATED.
C                     --P      = THE SINGLE PRECISION VALUE
C                                OF THE 'BERNOULLI PROBABILITY'
C                                PARAMETER FOR THE GEOMETRIC
C                                DISTRIBUTION.
C                                P SHOULD BE BETWEEN
C                                0.0 (EXCLUSIVELY) AND
C                                1.0 (EXCLUSIVELY).
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 GEOMETRIC DISTRIBUTION
C             WITH 'BERNOULLI PROBABILITY' PARAMETER = P.
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                 --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     COMMENT--NOTE THAT EVEN THOUGH THE OUTPUT
C              FROM THIS DISCRETE RANDOM NUMBER
C              GENERATOR MUST NECESSARILY BE A
C              SEQUENCE OF ***INTEGER*** VALUES,
C              THE OUTPUT VECTOR X IS SINGLE
C              PRECISION IN MODE.
C              X HAS BEEN SPECIFIED AS SINGLE
C              PRECISION SO AS TO CONFORM WITH THE DATAPAC
C              CONVENTION THAT ALL OUTPUT VECTORS FROM ALL
C              DATAPAC SUBROUTINES ARE SINGLE PRECISION.
C              THIS CONVENTION IS BASED ON THE BELIEF THAT
C              1) A MIXTURE OF MODES (FLOATING POINT
C              VERSUS INTEGER) IS INCONSISTENT AND
C              AN UNNECESSARY COMPLICATION
C              IN A DATA ANALYSIS; AND
C              2) FLOATING POINT MACHINE ARITHMETIC
C              (AS OPPOSED TO INTEGER ARITHMETIC)
C              IS THE MORE NATURAL MODE FOR DOING
C              DATA ANALYSIS.
C     REFERENCES--TOCHER, THE ART OF SIMULATION,
C                 1963, PAGES 14-15.
C               --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS,
C                 1964, PAGE 36.
C               --FELLER, AN INTRODUCTION TO PROBABILITY
C                 THEORY AND ITS APPLICATIONS, VOLUME 1,
C                 EDITION 2, 1957, PAGES 155-157, 210.
C               --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 929.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--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
CCCCC CHARACTER*4 IFEEDB
CCCCC CHARACTER*4 IPRINT
C
CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
CCCCC COMMON /PRINT/IFEEDB,IPRINT
C
      IPR=6
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(P.LE.0.0.OR.P.GE.1.0)GOTO55
      GOTO90
   50 WRITE(IPR, 5)
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,11)
      WRITE(IPR,46)P
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 GEORAN SUBROUTINE IS NON-POSITIVE *****)
   11 FORMAT(1H ,115H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 GEORAN SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
C
      CALL UNIRAN(N,ISEED,X)
C
C     GENERATE N GEOMETRIC RANDOM NUMBERS
C     USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD.
C
      DO100I=1,N
      IF(X(I).EQ.0.0)GOTO100
      ARG1=1.0-X(I)
      ARG2=1.0-P
      ANUM=ALOG(ARG1)
      ADEN=ALOG(ARG2)
      RATIO=ANUM/ADEN
      IRATIO=RATIO
      X(I)=IRATIO
      ARATIO=IRATIO
      IF(ARATIO.EQ.RATIO)X(I)=IRATIO-1
  100 CONTINUE
C
      RETURN
      END
      SUBROUTINE HFNCDF(X,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT HFNCDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE FOR THE HALFNORMAL
C              DISTRIBUTION.
C              THE HALFNORMAL DISTRIBUTION USED
C              HEREIN HAS MEAN = SQRT(2/PI) = 0.79788456
C              AND STANDARD DEVIATION = 1.
C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = (2/SQRT(2*PI)) * EXP(-X*X/2).
C              THE HALFNORMAL DISTRIBUTION USED HEREIN
C              IS THE DISTRIBUTION OF THE VARIATE X = ABS(Z) WHERE
C              THE VARIATE Z IS NORMALLY DISTRIBUTED
C              WITH MEAN = 0 AND STANDARD DEVIATION = 1.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE 
C                                AT WHICH THE CUMULATIVE DISTRIBUTION 
C                                FUNCTION IS TO BE EVALUATED.
C                                X SHOULD BE NON-NEGATIVE.
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 HALFNORMAL
C             DISTRIBUTION WITH MEAN = SQRT(2/PI) = 0.79788456
C             AND STANDARD DEVIATION = 1.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NORCDF. 
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 53, 59, 81, 83.
C               --DANIEL, 'USE OF HALF-NORMAL PLOTS IN
C                 INTERPRETING FACTORIAL TWO-LEVEL EXPERIMENTS',
C                 TECHNOMETRICS, 1959, PAGES 311-341.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C     UPDATED         --OCTOBER   1976. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(X.LT.0.0)GOTO50
      GOTO90
   50 WRITE(IPR,4)
      WRITE(IPR,46)X
      CDF=0.0
      RETURN
   90 CONTINUE
    4 FORMAT(1H , 96H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE HFNCDF SUBROUTINE IS NEGATIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      CALL NORCDF(X,CDF)
      CDF=2.0*CDF-1.0
C
      RETURN
      END 
      SUBROUTINE HFNPLT(X,N)
C
C     PURPOSE--THIS SUBROUTINE GENERATES A HALFNORMAL
C              PROBABILITY PLOT.
C              THE PROTOTYPE HALFNORMAL DISTRIBUTION USED HEREIN
C              HAS MEAN = SQRT(2/PI) = 0.79788456 
C              AND STANDARD DEVIATION = 1.
C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = (2/SQRT(2*PI)) * EXP(-X*X/2).
C              THE PROTOTYPE HALFNORMAL DISTRIBUTION USED HEREIN
C              IS THE DISTRIBUTION OF THE VARIATE X = ABS(Z) WHERE
C              THE VARIATE Z IS NORMALLY DISTRIBUTED
C              WITH MEAN = 0 AND STANDARD DEVIATION = 1.
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 HALFNORMAL 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 HALFNORMAL 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--A ONE-PAGE HALFNORMAL PROBABILITY PLOT.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, NORPPF, PLOT. 
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--DANIEL, 'USE OF HALF-NORMAL PLOTS IN
C                 INTERPRETING FACTORIAL TWO-LEVEL EXPERIMENTS',
C                 TECHNOMETRICS, 1959, PAGES 311-341.
C               --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 53, 59, 81, 83.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(7500),W(7500)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501))
C
      DATA TAU/1.41223913/
C
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE HFNPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 HFNPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE HFNPLT SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     SORT THE DATA 
C
      CALL SORT(X,N,Y)
C
C     GENERATE UNIFORM ORDER STATISTIC MEDIANS
C
      CALL UNIMED(N,W)
C
C     COMPUTE HALFNORMAL ORDER STATISTIC MEDIANS
C
      DO100I=1,N
      Q=W(I)
      Q=(Q+1.0)/2.0 
      CALL NORPPF(Q,W(I))
  100 CONTINUE
C
C     PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS.
C     WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION 
C     AND THE SAMPLE SIZE.
C
      CALL PLOT(Y,W,N)
      WRITE(IPR,105)TAU,N
C
C     COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. 
C     COMPUTE LOCATION AND SCALE ESTIMATES
C     FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. 
C     THEN WRITE THEM OUT.
C
      SUM1=0.0
      SUM2=0.0
      DO200I=1,N
      SUM1=SUM1+Y(I)
      SUM2=SUM2+W(I)
  200 CONTINUE
      YBAR=SUM1/AN
      WBAR=SUM2/AN
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO300I=1,N
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) 
      SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) 
      SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 
  300 CONTINUE
      CC=SUM2/SQRT(SUM3*SUM1) 
      YSLOPE=SUM2/SUM3
      YINT=YBAR-YSLOPE*WBAR
      WRITE(IPR,305)CC,YINT,YSLOPE
C
  105 FORMAT(1H ,35HHALFNORMAL PROBABILITY PLOT (TAU = ,E15.8,1H),52X,20
     1HTHE SAMPLE SIZE N = ,I7)
  305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X,
     122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) 
C
      RETURN
      END 
      SUBROUTINE HFNPPF(P,PPF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT HFNPPF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE FOR THE HALFNORMAL
C              DISTRIBUTION.
C              THE HALFNORMAL DISTRIBUTION USED
C              HEREIN HAS MEAN = SQRT(2/PI) = 0.79788456
C              AND STANDARD DEVIATION = 1.
C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = (2/SQRT(2*PI)) * EXP(-X*X/2).
C              THE HALFNORMAL DISTRIBUTION USED HEREIN
C              IS THE DISTRIBUTION OF THE VARIATE X = ABS(Z) WHERE
C              THE VARIATE Z IS NORMALLY DISTRIBUTED
C              WITH MEAN = 0 AND STANDARD DEVIATION = 1.
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     OUTPUT ARGUMENTS--PPF    = THE SINGLE PRECISION PERCENT
C                                POINT FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION PERCENT POINT FUNCTION . 
C             VALUE PPF FOR THE HALFNORMAL DISTRIBUTION
C             WITH MEAN = SQRT(2/PI) = 0.79788456 
C             AND STANDARD DEVIATION = 1.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--P SHOULD BE BETWEEN 0.0 (INCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C     OTHER DATAPAC   SUBROUTINES NEEDED--NORPPF. 
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 53, 59, 81, 83.
C               --DANIEL, 'USE OF HALF-NORMAL PLOTS IN
C                 INTERPRETING FACTORIAL TWO-LEVEL EXPERIMENTS',
C                 TECHNOMETRICS, 1959, PAGES 311-341.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C     UPDATED         --OCTOBER   1976. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LT.0.0.OR.P.GE.1.0)GOTO50
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      PPF=0.0
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 HFNPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      ARG=(1.0+P)/2.0
      CALL NORPPF(ARG,PPF)
      IF(PPF.LE.0.0)PPF=0.0
C
      RETURN
      END 
      SUBROUTINE HFNRAN(N,ISEED,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT HFNRAN
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE HALFNORMAL DISTRIBUTION.
C              THE PROTOTYPE HALFNORMAL DISTRIBUTION USED
C              HEREIN HAS MEAN = SQRT(2/PI) = 0.79788456
C              AND STANDARD DEVIATION = 1.
C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = (2/SQRT(2*PI)) * EXP(-X*X/2).
C              THE PROTOTYPE HALFNORMAL DISTRIBUTION USED HEREIN
C              IS THE DISTRIBUTION OF THE VARIATE X = ABS(Z) WHERE
C              THE VARIATE Z IS NORMALLY DISTRIBUTED
C              WITH MEAN = 0 AND STANDARD DEVIATION = 1.
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             FROM THE HALFNORMAL DISTRIBUTION
C              WITH MEAN = SQRT(2/PI) = 0.79788456
C              AND STANDARD DEVIATION = 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--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 14-15.
C               --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS,
C                 1964, PAGE 36.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 53, 59, 81, 83.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1975.
C     UPDATED         --JULY      1976.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
      DIMENSION Y(2)
C
C---------------------------------------------------------------------
C
CCCCC CHARACTER*4 IFEEDB
CCCCC CHARACTER*4 IPRINT
C
CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
CCCCC COMMON /PRINT/IFEEDB,IPRINT
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA PI/3.14159265359/
C
      IPR=6
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      GOTO90
   50 WRITE(IPR, 5)
      WRITE(IPR,47)N
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 HFNRAN SUBROUTINE IS NON-POSITIVE *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
C     THEN GENERATE 2 ADDITIONAL UNIFORM (0,1) RANDOM NUMBERS
C     (TO BE USED BELOW IN FORMING THE N-TH NORMAL
C     RANDOM NUMBER WHEN THE DESIRED SAMPLE SIZE N
C     HAPPENS TO BE ODD).
C
      CALL UNIRAN(N,ISEED,X)
      CALL UNIRAN(2,ISEED,Y)
C
C     GENERATE N NORMAL RANDOM NUMBERS
C     USING THE BOX-MULLER METHOD.
C
      DO200I=1,N,2
      IP1=I+1
      U1=X(I)
      IF(I.EQ.N)GOTO210
      U2=X(IP1)
      GOTO220
  210 U2=Y(2)
  220 ARG1=-2.0*ALOG(U1)
      ARG2=2.0*PI*U2
      SQRT1=SQRT(ARG1)
      Z1=SQRT1*COS(ARG2)
      Z2=SQRT1*SIN(ARG2)
      X(I)=Z1
      IF(I.EQ.N)GOTO200
      X(IP1)=Z2
  200 CONTINUE
C
C     GENERATE N HALFNORMAL RANDOM NUMBERS
C     USING THE DEFINITION THAT
C     A HALFNORMAL VARIATE
C     EQUALS THE ABSOLUTE VALUE OF A NORMAL VARIATE.
C
      DO400I=1,N
      IF(X(I).LT.0.0)X(I)=-X(I)
  400 CONTINUE
C
      RETURN
      END
      SUBROUTINE HIST(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT HIST
C
C     PURPOSE--THIS SUBROUTINE PRODUCES 2 HISTOGRAMS
C              (WITH DIFFERING CLASS WIDTHS)
C              OF THE DATA IN THE INPUT VECTOR X. 
C              THE FIRST  HISTOGRAM HAS CLASS WIDTH = 0.1
C              SAMPLE STANDARD DEVIATIONS;
C              THE SECOND HISTOGRAM HAS CLASS WIDTH = 0.2
C              SAMPLE STANDARD DEVIATIONS.
C              TWO HISTOGRAMS OF THE SAME DATA SET
C              ARE PRINTED OUT SO AS TO GIVE THE DATA
C              ANALYST SOME FEEL FOR HOW DEPENDENT
C              THE HISTOGRAM SHAPE IS AS A FUNCTION
C              OF THE CLASS WIDTH AND NUMBER OF CLASSES.
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--1 PAGE OF AUTOMATIC PRINTOUT
C             CONSISTING OF 2 HALF-PAGE HISTOGRAMS
C             (WITH CLASS WIDTHS = 0.1 AND 0.2 SAMPLE
C             STANDARD DEVIATIONS, RESPECTIVELY)
C             OF THE DATA IN THE INPUT VECTOR X.
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 1, EDITION 2, 1963, PAGE 4.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--DECEMBER  1972. 
C     UPDATED         --JANUARY   1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX
      CHARACTER*4 IGRAPH
C
      DIMENSION X(1)
      DIMENSION IXLABL(21)
      COMMON /BLOCK1/ IGRAPH(55,130)
CCCCC COMMON IGRAPH(22,123)
      DIMENSION ICOUNT(121),ICOUN2(121) 
      DIMENSION TLABLE(13),ITLABL(13)
      DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      RETURN
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,105H***** FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUMENT (
     1A VECTOR) TO THE HIST   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,
     16H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 HIST   SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** FATAL ERROR--         THE SECOND INPUT ARGUME
     1NT TO THE HIST   SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      NUMHIS=2
      AN=N
C
C     FIND THE MINIMUM AND THE MAXIMUM
      XMIN=X(1)
      XMAX=X(1)
      DO100I=1,N
      IF(X(I).LT.XMIN)XMIN=X(I)
      IF(X(I).GT.XMAX)XMAX=X(I)
  100 CONTINUE
C
C     COMPUTE THE SAMPLE MEAN AND SAMPLE STANDARD DEVIATION 
C
      SUM=0.0
      DO200I=1,N
      SUM=SUM+X(I)
  200 CONTINUE
      XBAR=SUM/AN
      SUM=0.0
      DO300I=1,N
      SUM=SUM+(X(I)-XBAR)**2
  300 CONTINUE
      S=SQRT(SUM/(AN-1.0))
C
C     FORM THE BASIC FREQUENCY TABLE (ICOUNT) WHICH CORRESPONDS TO A HISTOGRAM
C     WITH 121 CLASSES AND A CLASS WIDTH OF ONE TENTH A SAMPLE STANDARD
C     DEVIATION.
C
      DO1000I=1,121 
      ICOUNT(I)=0
 1000 CONTINUE
C
      NUMOUT=0
      DO1100I=1,N
      Z=(X(I)-XBAR)/S
      MT=10.0*(Z+6.0)+2.5
      IF(MT.LT.2.OR.MT.GT.122)NUMOUT=NUMOUT+1
      IF(MT.LT.2.OR.MT.GT.122)GOTO1100
      ICOUNT(MT)=ICOUNT(MT)+1 
 1100 CONTINUE
C
C     LOOP THROUGH NUMHIS (= 2) HISTOGRAMS
C     NOTE THAT NUMHIS WAS PREVIOUSLY SET TO 6 (BEFORE JANUARY 1975)
C
      DO1500IHIST=1,NUMHIS
C
C     ZERO OUT THE MINI-GRAPH 
C
      DO400I=1,22
      DO500J=1,123
      IGRAPH(I,J)=BLANK
  500 CONTINUE
  400 CONTINUE
C
C     PRODUCE THE HORIZONTAL AXES
C
      DO600J=2,122
      IGRAPH(1,J)=HYPHEN
      IGRAPH(22,J)=HYPHEN
  600 CONTINUE
      DO700J=2,122,10
      IGRAPH(1,J)=ALPHAI
      IGRAPH(22,J)=ALPHAI
  700 CONTINUE
C
C     PRODUCE THE VERTICAL AXES
C
      DO800I=2,21
      IGRAPH(I,1 )=ALPHAI
      IGRAPH(I,123)=ALPHAI
  800 CONTINUE
      DO900I=2,21,5 
      IGRAPH(I,1 )=HYPHEN
      IGRAPH(I,123)=HYPHEN
  900 CONTINUE
      INC=IHIST
      IF(IHIST.EQ.4)INC=5
      IF(IHIST.EQ.5)INC=10
      IF(IHIST.EQ.6)INC=20
C
C     FORM THE FREQUENCY TABLE FOR THIS PARTICULAR HISTOGRAM
C
      ICOUN2(1)=ICOUNT(1)
      DO1600I=2,121,INC
      JMAX=I+INC-1
      JSUM=0
      DO1700J=I,JMAX
      JSUM=JSUM+ICOUNT(J)
 1700 CONTINUE
      DO1800J=I,JMAX
      ICOUN2(J)=JSUM
 1800 CONTINUE
 1600 CONTINUE
C
C     DETERMINE THE MAXIMUM FREQUENCY
C
      MAXFRE=ICOUN2(1)
      DO2000I=1,121 
      IF(ICOUN2(I).GT.MAXFRE)MAXFRE=ICOUN2(I)
 2000 CONTINUE
C
C     DETERMINE THE PLOT POSITIONS
C
      AMAXFR=MAXFRE 
      HEIGHT=20.0
      DO2100J=1,121 
      JP1=J+1
      IF(MAXFRE.LE.20)MX=ICOUN2(J)
      IF(MAXFRE.LE.20)GOTO2110
      ACOUNT=ICOUN2(J)
      PROP=ACOUNT/AMAXFR
      MX=PROP*HEIGHT+0.999
 2110 IF(MX.EQ.0)GOTO2150
      DO2200I=1,MX
      IREV=22-I
      IGRAPH(IREV,JP1)=ALPHAX 
 2200 CONTINUE
 2150 IF(ICOUN2(J).GE.1)IGRAPH(21,JP1)=ALPHAX
 2100 CONTINUE
C
C     DETERMINE THE X VALUES TO BE LISTED ON THE LEFT LEFT VERTICAL AXIS
C
      IF(MAXFRE.GE.21)GOTO2250
      DO2300I=1,20
      IREV=22-I
      IXLABL(IREV)=I
 2300 CONTINUE
      GOTO2450
 2250 DO2400I=1,20
      IREV=22-I
      AI=I
      PROP=AI/20.0
      IXLABL(IREV)=PROP*AMAXFR+0.5
 2400 CONTINUE
C
C     WRITE EVERYTHING OUT
C
 2450 IEVODD=IHIST-2*(IHIST/2)
      IF(IEVODD.EQ.0)GOTO3050 
      WRITE(IPR,998)
  998 FORMAT(1H1)
      GOTO3060
 3050 WRITE(IPR,999)
  999 FORMAT(1H )
 3060 WRITE(IPR,3070)(IGRAPH(1,J),J=1,123)
 3070 FORMAT(1H ,6X,123A1)
      DO3100I=2,21
      WRITE(IPR,3080)IXLABL(I),(IGRAPH(I,J),J=1,123)
 3080 FORMAT(1H ,I5,1X,123A1) 
 3100 CONTINUE
      WRITE(IPR,3070)(IGRAPH(22,J),J=1,123)
      NUMCLA=(120/INC)+1
      TINC=INC
      CWIDSD=TINC*0.1
      CWIDTH=CWIDSD*S
      TLABLE(7)=XBAR
      ITLABL(7)=0
      DO3200I=1,6
      IREV=13-I+1
      AI=I
      TLABLE(I)=XBAR-(7.0-AI)*S
      TLABLE(IREV)=XBAR+(7.0-AI)*S
      ITLABL(I)=I-7 
      ITLABL(IREV)=7-I
 3200 CONTINUE
      WRITE(IPR,3205)(TLABLE(I),I=1,13) 
      WRITE(IPR,3210)(ITLABL(I),I=1,13) 
      WRITE(IPR,3215)NUMOUT
      WRITE(IPR,3220)NUMCLA,CWIDTH,CWIDSD
      WRITE(IPR,3225)N
 3205 FORMAT(1H ,1X,12F10.4,F9.4)
 3210 FORMAT(1H ,13(1X,I7,2X))
 3215 FORMAT(1H     ,I5,106H OBSERVATIONS WERE IN EXCESS OF 6 SAMPLE STA
     1NDARD DEVIATIONS ABOUT THE SAMPLE MEAN AND SO WERE NOT PLOTTED) 
 3220 FORMAT(1H ,40HHISTOGRAM      THE NUMBER OF CLASSES IS ,I6,8X,
     119HTHE CLASS WIDTH IS ,E15.8,3H = ,F7.1,20H STANDARD DEVIATIONS)
 3225 FORMAT(1H ,20HTHE SAMPLE SIZE N = ,I7)
 1500 CONTINUE
      RETURN
      END 
      SUBROUTINE INVXWX(N,K)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT INVXWX
      EXTERNAL DOT
C     PURPOSE--THIS SUBROUTINE COMPUTES THE INVERSE OF X'WX 
C     WHICH IS DONE BY COMPUTING THE INVERSE OF R'R (WHERE
C     R HAS JUST RECENTLY BEEN MODIFIED BEFORE CALLING THIS 
C     SUBROUTINE.  THE INPUT R = THE SQUARE ROOT OF
C     THE DIAGONAL MATRIX D TIMES THE OLD MATRIX R.
C     THE INVERSE OF X'WX WILL BE IDENTICAL
C     (EXCEPT FOR THE ABSENCE OF S**2 = THE RESIDUAL
C     VARIANCE) TO THE COVARIANCE MATRIX OF THE COEFFICIENTS.
C     THE ONLY REASON THIS SUBROUTINE EXISTS IS FOR THE
C     CALCULATION OF SUCH COVARIANCES.
C     UNPIVOTING HAS ALSO BEEN DONE HEREIN SO AS TO UNDO
C     THE PIVOTING DONE IN THE DECOMPOSITION SUBROUTINE (DECOMP).
C     THE MATRIX C USED HEREIN IS AN INTERMEDIATE RESULT MATRIX.
C     X--NOT USED
C     Q--NOT USED
C     R--USED AND CHANGED
C     D--NOT USED
C     IPIVOT--USED
C     INVERSION ALGORITHM USED--CHOLESKI DECOMPOSITION
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION Q(10000),R(2500),D(50),IPIVOT(50) 
      COMMON /BLOCK2/ WS(15000)
      COMMON /BLOCK3/ DUM1(3000),DUM2(3000)
      EQUIVALENCE (Q(1),WS(1))
      EQUIVALENCE (R(1),WS(10001))
      EQUIVALENCE (D(1),WS(12501))
      EQUIVALENCE (IPIVOT(1),WS(12551)) 
      DIMENSION DUM3(200)
C
C-----START POINT-----------------------------------------------------
C
      DO 10 I=1,K
      IM1=I-1
      IF(IM1.LT.1)GOTO10
      DO15J=1,IM1
      IRARG=(I-1)*K+J
      R(IRARG)=0.0
15    CONTINUE
10    CONTINUE
      DO30JJ=1,K
      J=K+1-JJ
      DO 30 II=1,J
      I=J+1-II
      IP1=I+1
      IF(IP1.GT.K)GOTO25
      DO20L=IP1,K
      IRARG1=(I-1)*K+L
      IRARG2=(J-1)*K+L
      IRARG3=(L-1)*K+J
      DUM1(L)=R(IRARG1)
      IF(L.LT.J)DUM2(L)=R(IRARG2)
      IF(L.EQ.J)DUM2(L)=DUM3(L)
      IF(L.GT.J)DUM2(L)=R(IRARG3)
20    CONTINUE
25    RI=0.0
      IRARG=(I-1)*K+I
      IF (I.EQ.J) RI=1.0/R(IRARG)
      ANEGRI=-RI
C
      CALL DOT(DUM1,DUM2,IP1,K,ANEGRI,DOTPRO)
C
      IRARG=(I-1)*K+I
      DOTPRO=-DOTPRO/R(IRARG) 
      IF(I.EQ.J)DUM3(I)=DOTPRO
      IRARG=(J-1)*K+I
      IF(I.LT.J)R(IRARG)=DOTPRO
30    CONTINUE
      DO35I=1,K
      IRARG=(I-1)*K+I
      R(IRARG)=DUM3(I)
35    CONTINUE
C
C     MATRIX C NOW EQUALS THE INVERSE OF R'R.
C     NOW 'UNPIVOT' ON C AND PUT THE RESULTS BACK INTO R.
C
      DO40I=1,K
      II=IPIVOT(I)
      DO40J=1,I
      JJ=IPIVOT(J)
      IRARG1=(II-1)*K+JJ
      IRARG2=(I-1)*K+J
      IRARG3=(JJ-1)*K+II
      IF(II.LT.JJ)R(IRARG1)=R(IRARG2)
      IF(II.EQ.JJ)DUM3(II)=R(IRARG2)
      IF(II.GT.JJ)R(IRARG3)=R(IRARG2)
40    CONTINUE
      DO50I=1,K
      IRARG=(I-1)*K+I
      R(IRARG)=DUM3(I)
50    CONTINUE
      RETURN
      END 
      SUBROUTINE LAMCDF(X,ALAMBA,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT LAMCDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE FOR THE (TUKEY) LAMBDA DISTRIBUTION
C              WITH TAIL LENGTH PARAMETER VALUE = ALAMBA.
C              IN GENERAL, THE PROBABILITY DENSITY FUNCTION 
C              FOR THIS DISTRIBUTION IS NOT SIMPLE.
C              THE PERCENT POINT FUNCTION FOR THIS DISTRIBUTION IS
C              G(P) = ((P**ALAMBA)-((1-P)**ALAMBA))/ALAMBA
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
C                                WHICH THE CUMULATIVE DISTRIBUTION
C                                FUNCTION IS TO BE EVALUATED.
C                     --ALAMBA = THE SINGLE PRECISION VALUE OF LAMBDA 
C                                (THE TAIL LENGTH PARAMETER).
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 TUKEY LAMBDA DISTRIBUTION
C             WITH TAIL LENGTH PARAMETER = ALAMBA.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--FOR ALAMBA NON-POSITIVE, NO RESTRICTIONS ON X.
C                 --FOR ALAMBA POSITIVE, X SHOULD BE BETWEEN (-1/ALAMBA)
C                   AND (+1/ALAMBA), INCLUSIVELY. 
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--HASTINGS, MOSTELLER, TUKEY, AND WINDSOR,
C                 'LOW MOMENTS FOR SMALL SAMPLES:  A COMPARATIVE
C                 STUDY OF ORDER STATISTICS', ANNALS OF
C                 MATHEMATICAL STATISTICS, 18, 1947,
C                 PAGES 413-426.
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, PAGES 42-44, 53-58.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --MAY       1974. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(ALAMBA.LE.0.0)GOTO90 
      XMAX=1.0/ALAMBA
      XMIN=-XMAX
      IF(X.LT.XMIN.OR.X.GT.XMAX)GOTO50
      GOTO90
   50 WRITE(IPR,2)
      WRITE(IPR,46)X
      IF(X.LT.XMIN)CDF=0.0
      IF(X.GT.XMAX)CDF=1.0
      RETURN
   90 CONTINUE
    2 FORMAT(1H ,126H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUMEN
     1T TO THE LAMCDF SUBROUTINE IS OUTSIDE THE USUAL +-(1/ALAMBA) INTER
     1VAL *****)
   46 FORMAT(1H ,35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      IF(ALAMBA.GT.0.0)GOTO110
      GOTO120
C
  110 XMAX=1.0/ALAMBA
      XMIN=-XMAX
      IF(X.LE.XMIN)CDF=0.0
      IF(X.GE.XMAX)CDF=1.0
      IF(X.LE.XMIN.OR.X.GE.XMAX)RETURN
C
  120 CONTINUE
      IF(-0.001.LT.ALAMBA.AND.ALAMBA.LT.0.001)GOTO150
      GOTO170
  150 IF(X.GE.0.0)GOTO160
      CDF=EXP(X)/(1.0+EXP(X)) 
      RETURN
  160 CDF=1.0/(1.0+EXP(-X))
      RETURN
C
  170 IF(-0.001.LT.ALAMBA.AND.ALAMBA.LT.0.001)GOTO150
      PMIN=0.0
      PMID=0.5
      PMAX=1.0
      PLOWER=PMIN
      PUPPER=PMAX
      ICOUNT=0
  210 XCALC=(PMID**ALAMBA-(1.0-PMID)**ALAMBA)/ALAMBA
      IF(XCALC.EQ.X)GOTO240
      IF(XCALC.GT.X)GOTO220
      PLOWER=PMID
      PMID=(PMID+PUPPER)/2.0
      GOTO230
  220 PUPPER=PMID
      PMID=(PMID+PLOWER)/2.0
  230 PDEL=ABS(PMID-PLOWER)
      ICOUNT=ICOUNT+1
      IF(PDEL.LT.0.000001.OR.ICOUNT.GT.30)GOTO240 
      GOTO210
  240 CDF=PMID
      RETURN
C
      END 
      SUBROUTINE LAMPDF(X,ALAMBA,PDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT LAMPDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY
C              FUNCTION VALUE FOR THE (TUKEY) LAMBDA DISTRIBUTION
C              WITH TAIL LENGTH PARAMETER VALUE = ALAMBA.
C              IN GENERAL, THE PROBABILITY DENSITY FUNCTION 
C              FOR THIS DISTRIBUTION IS NOT SIMPLE.
C              THE PERCENT POINT FUNCTION FOR THIS DISTRIBUTION IS
C              G(P) = ((P**ALAMBA)-((1-P)**ALAMBA))/ALAMBA
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
C                                WHICH THE PROBABILITY DENSITY
C                                FUNCTION IS TO BE EVALUATED.
C                     --ALAMBA = THE SINGLE PRECISION VALUE OF LAMBDA 
C                                (THE TAIL LENGTH PARAMETER).
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 TUKEY LAMBDA DISTRIBUTION
C             WITH TAIL LENGTH PARAMETER = ALAMBA.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--FOR ALAMBA NON-POSITIVE, NO RESTRICTIONS ON X.
C                 --FOR ALAMBA POSITIVE, X SHOULD BE BETWEEN (-1/ALAMBA)
C                   AND (+1/ALAMBA), INCLUSIVELY. 
C     OTHER DATAPAC   SUBROUTINES NEEDED--LAMCDF. 
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--HASTINGS, MOSTELLER, TUKEY, AND WINDSOR,
C                 'LOW MOMENTS FOR SMALL SAMPLES:  A COMPARATIVE
C                 STUDY OF ORDER STATISTICS', ANNALS OF
C                 MATHEMATICAL STATISTICS, 18, 1947,
C                 PAGES 413-426.
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, PAGES 42-44, 53-58.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --AUGUST    1974. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(ALAMBA.LE.0.0)GOTO90 
      XMAX=1.0/ALAMBA
      XMIN=-XMAX
      IF(X.LT.XMIN.OR.X.GT.XMAX)GOTO50
      GOTO90
   50 WRITE(IPR,2)
      WRITE(IPR,46)X
      IF(X.LT.XMIN)PDF=0.0
      IF(X.GT.XMAX)PDF=1.0
      RETURN
   90 CONTINUE
    2 FORMAT(1H ,126H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUMEN
     1T TO THE LAMPDF SUBROUTINE IS OUTSIDE THE USUAL +-(1/ALAMBA) INTER
     1VAL *****)
   46 FORMAT(1H ,35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      IF(ALAMBA.GT.0.0)GOTO110
      GOTO150
  110 XMAX=1.0/ALAMBA
      XMIN=-XMAX
      IF(X.GT.XMIN.AND.X.LT.XMAX)GOTO150
      IF(X.LT.XMIN.OR.X.GT.XMAX)PDF=0.0 
      IF(X.EQ.XMIN.AND.ALAMBA.LT.1.0)PDF=0.0
      IF(X.EQ.XMAX.AND.ALAMBA.LT.1.0)PDF=0.0
      IF(X.EQ.XMIN.AND.ALAMBA.EQ.1.0)PDF=0.5
      IF(X.EQ.XMAX.AND.ALAMBA.EQ.1.0)PDF=0.5
      IF(X.EQ.XMIN.AND.ALAMBA.GT.1.0)PDF=1.0
      IF(X.EQ.XMAX.AND.ALAMBA.GT.1.0)PDF=1.0
      RETURN
C
  150 CALL LAMCDF(X,ALAMBA,CDF)
      SF =CDF**(ALAMBA-1.0)+(1.0-CDF)**(ALAMBA-1.0)
      PDF=1.0/SF
      RETURN
C
      END 
      SUBROUTINE LAMPLT(X,N,ALAMBA)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT LAMPLT
C
C     PURPOSE--THIS SUBROUTINE GENERATES A (TUKEY) LAMBDA DISTRIBUTION
C              PROBABILITY PLOT
C              (WITH TAIL LENGTH PARAMETER VALUE = ALAMBA). 
C              IN GENERAL, THE PROBABILITY DENSITY FUNCTION 
C              FOR THIS DISTRIBUTION IS NOT SIMPLE.
C              THE PERCENT POINT FUNCTION FOR THIS DISTRIBUTION IS
C              G(P) = ((P**ALAMBA)-((1-P)**ALAMBA)) / ALAMBA
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 LAMBDA 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 LAMBDA DISTRIBUTION
C              WITH TAIL LENGTH PARAMETER VALUE = ALAMBA.
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                     --ALAMBA = THE SINGLE PRECISION VALUE OF LAMBDA 
C                                (THE TAIL LENGTH PARAMETER).
C     OUTPUT--A ONE-PAGE LAMBDA PROBABILITY PLOT. 
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, PLOT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
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               --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                 PAGES 53-58.
C               --HASTINGS, MOSTELLER, TUKEY, AND WINDSOR,
C                 'LOW MOMENTS FOR SMALL SAMPLES:  A COMPARATIVE
C                 STUDY OF ORDER STATISTICS', ANNALS OF
C                 MATHEMATICAL STATISTICS, 18, 1947,
C                 PAGES 413-426.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(7500),W(7500)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501))
C
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE LAMPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 LAMPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE LAMPLT SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     SORT THE DATA 
C
      CALL SORT(X,N,Y)
C
C     GENERATE UNIFORM ORDER STATISTIC MEDIANS
C
      CALL UNIMED(N,W)
C
C     COMPUTE LAMBDA DISTRIBUTION ORDER STATISTIC MEDIANS
C
      DO100I=1,N
      Q=W(I)
      IF(-0.001.LT.ALAMBA.AND.ALAMBA.LT.0.001)W(I)=ALOG(Q/(1.0-Q))
      IF(-0.001.LT.ALAMBA.AND.ALAMBA.LT.0.001)GOTO100
      W(I)=(Q**ALAMBA-(1.0-Q)**ALAMBA)/ALAMBA
  100 CONTINUE
C
C     PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS.
C     COMPUTE THE TAIL LENGTH MEASURE OF THE DISTRIBUTION.
C     WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION 
C     AND THE SAMPLE SIZE.
C
      CALL PLOT(Y,W,N)
      IF(-0.001.LT.ALAMBA.AND.ALAMBA.LT.0.001)TAU=1.63473745
      IF(-0.001.LT.ALAMBA.AND.ALAMBA.LT.0.001)GOTO150
      Q=.9975
      PP9975=(Q**ALAMBA-(1.0-Q)**ALAMBA)/ALAMBA
      Q=.0025
      PP0025=(Q**ALAMBA-(1.0-Q)**ALAMBA)/ALAMBA
      Q=.975
      PP975 =(Q**ALAMBA-(1.0-Q)**ALAMBA)/ALAMBA
      Q=.025
      PP025 =(Q**ALAMBA-(1.0-Q)**ALAMBA)/ALAMBA
      TAU=(PP9975-PP0025)/(PP975-PP025) 
  150 WRITE(IPR,105)ALAMBA,TAU,N
C
C     COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. 
C     COMPUTE LOCATION AND SCALE ESTIMATES
C     FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. 
C     THEN WRITE THEM OUT.
C
      SUM1=0.0
      DO200I=1,N
      SUM1=SUM1+Y(I)
  200 CONTINUE
      YBAR=SUM1/AN
      WBAR=0.0
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO300I=1,N
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) 
      SUM2=SUM2+W(I)*Y(I)
      SUM3=SUM3+W(I)*W(I)
  300 CONTINUE
      CC=SUM2/SQRT(SUM3*SUM1) 
      YSLOPE=SUM2/SUM3
      YINT=YBAR-YSLOPE*WBAR
      WRITE(IPR,305)CC,YINT,YSLOPE
C
  105 FORMAT(1H ,38HLAMBDA PROBABILITY PLOT WITH LAMBDA = ,E17.10,1X,7H(
     1TAU = ,E15.8,1H),24X,20HTHE SAMPLE SIZE N = ,I7)
  305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X,
     122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) 
C
      RETURN
      END 
      SUBROUTINE LAMPPF(P,ALAMBA,PPF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT LAMPPF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE FOR THE (TUKEY) LAMBDA DISTRIBUTION
C              WITH TAIL LENGTH PARAMETER VALUE = ALAMBA.
C              IN GENERAL, THE PROBABILITY DENSITY FUNCTION 
C              FOR THIS DISTRIBUTION IS NOT SIMPLE.
C              THE PERCENT POINT FUNCTION FOR THIS DISTRIBUTION IS
C              G(P) = ((P**ALAMBA)-((1-P)**ALAMBA))/ALAMBA
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                     --ALAMBA = THE SINGLE PRECISION VALUE OF LAMBDA 
C                                (THE TAIL LENGTH PARAMETER).
C     OUTPUT ARGUMENTS--PPF    = THE SINGLE PRECISION PERCENT
C                                POINT FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION PERCENT POINT
C             FUNCTION VALUE PPF FOR THE TUKEY LAMBDA DISTRIBUTION
C             WITH TAIL LENGTH PARAMETER = ALAMBA.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--IF ALAMBA IS POSITIVE,
C                   THEN P SHOULD BE BETWEEN 0.0 AND 1.0, INCLUSIVELY.
C                   IF ALAMBA IS NON-POSITIVE,
C                   THEN P SHOULD BE BETWEEN 0.0 AND 1.0, EXCLUSIVELY.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG.
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                 PAGES 53-58.
C               --FILLIBEN, 'THE PERCENT POINT FUNCTION',
C                 (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31.
C               --HASTINGS, MOSTELLER, TUKEY, AND WINDSOR,
C                 'LOW MOMENTS FOR SMALL SAMPLES:  A COMPARATIVE
C                 STUDY OF ORDER STATISTICS', ANNALS OF
C                 MATHEMATICAL STATISTICS, 18, 1947,
C                 PAGES 413-426.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(ALAMBA.LE.0.0.AND.P.LE.0.0)GOTO50
      IF(ALAMBA.LE.0.0.AND.P.GE.1.0)GOTO50
      IF(ALAMBA.GT.0.0.AND.P.LT.0.0)GOTO50
      IF(ALAMBA.GT.0.0.AND.P.GT.1.0)GOTO50
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 LAMPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      IF(-0.001.LT.ALAMBA.AND.ALAMBA.LT.0.001)GOTO150
      GOTO250
  150 PPF=ALOG(P/(1.0-P))
      RETURN
C
  250 PPF= (P**ALAMBA-(1.0-P)**ALAMBA)/ALAMBA
      RETURN
C
      END 
      SUBROUTINE LAMRAN(N,ALAMBA,ISEED,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT LAMRAN
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE (TUKEY) LAMBDA DISTRIBUTION
C              WITH TAIL LENGTH PARAMETER VALUE = ALAMBA.
C              IN GENERAL, THE PROBABILITY DENSITY FUNCTION
C              FOR THIS DISTRIBUTION IS NOT SIMPLE.
C              THE PERCENT POINT FUNCTION FOR THIS DISTRIBUTION IS
C              G(P) = ((P**ALAMBA)-((1-P)**ALAMBA))/ALAMBA
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
C                                OF RANDOM NUMBERS TO BE
C                                GENERATED.
C                     --ALAMBA = THE SINGLE PRECISION VALUE OF LAMBDA
C                                (THE TAIL LENGTH PARAMETER).
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 (TUKEY) LAMBDA DISTRIBUTION
C             WITH TAIL LENGTH PARAMETER VALUE = ALAMBA.
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--ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--TOCHER, THE ART OF SIMULATION,
C                 1963, PAGES 14-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, PAGES 21-44, 53-58.
C               --FILLIBEN, 'THE PERCENT POINT FUNCTION',
C                 (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82.6
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
CCCCC CHARACTER*4 IFEEDB
CCCCC CHARACTER*4 IPRINT
C
CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
CCCCC COMMON /PRINT/IFEEDB,IPRINT
C
      IPR=6
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      ALAMB2=ALAMBA
      IF(N.LT.1)GOTO50
      GOTO90
   50 WRITE(IPR, 5)
      WRITE(IPR,47)N
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 LAMRAN SUBROUTINE IS NON-POSITIVE *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
C
      CALL UNIRAN(N,ISEED,X)
C
C     GENERATE N LAMBDA DISTRIBUTION RANDOM NUMBERS
C     USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD.
C
      DO100I=1,N
      Q=X(I)
      IF(-0.001.LT.ALAMB2.AND.ALAMB2.LT.0.001)X(I)=ALOG(Q/(1.0-Q))
      IF(-0.001.LT.ALAMB2.AND.ALAMB2.LT.0.001)GOTO100
      X(I)=(Q**ALAMB2-(1.0-Q)**ALAMB2)/ALAMB2
  100 CONTINUE
C
      RETURN
      END
      SUBROUTINE LAMSF(P,ALAMBA,SF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT LAMSF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE SPARSITY
C              FUNCTION VALUE FOR THE (TUKEY) LAMBDA DISTRIBUTION
C              WITH TAIL LENGTH PARAMETER VALUE = ALAMBA.
C              IN GENERAL, THE PROBABILITY DENSITY FUNCTION 
C              FOR THIS DISTRIBUTION IS NOT SIMPLE.
C              THE PERCENT POINT FUNCTION FOR THIS DISTRIBUTION IS
C              G(P) = ((P**ALAMBA)-((1-P)**ALAMBA))/ALAMBA
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                     --ALAMBA = THE SINGLE PRECISION VALUE OF LAMBDA 
C                                (THE TAIL LENGTH PARAMETER).
C     OUTPUT ARGUMENTS--SF     = THE SINGLE PRECISION
C                                SPARSITY FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION SPARSITY
C             FUNCTION VALUE SF FOR THE TUKEY LAMBDA DISTRIBUTION
C             WITH TAIL LENGTH PARAMETER = ALAMBA.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--IF ALAMBA IS POSITIVE,
C                   THEN P SHOULD BE BETWEEN 0.0 AND 1.0, INCLUSIVELY.
C                   IF ALAMBA IS NON-POSITIVE,
C                   THEN P SHOULD BE BETWEEN 0.0 AND 1.0, EXCLUSIVELY.
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--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                 PAGES 53-58.
C               --FILLIBEN, 'THE PERCENT POINT FUNCTION',
C                 (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31.
C               --HASTINGS, MOSTELLER, TUKEY, AND WINDSOR,
C                 'LOW MOMENTS FOR SMALL SAMPLES:  A COMPARATIVE
C                 STUDY OF ORDER STATISTICS', ANNALS OF
C                 MATHEMATICAL STATISTICS, 18, 1947,
C                 PAGES 413-426.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(ALAMBA.LE.0.0.AND.P.LE.0.0)GOTO50
      IF(ALAMBA.LE.0.0.AND.P.GE.1.0)GOTO50
      IF(ALAMBA.GT.0.0.AND.P.LT.0.0)GOTO50
      IF(ALAMBA.GT.0.0.AND.P.GT.1.0)GOTO50
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 LAMSF  SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      SF=P**(ALAMBA-1.0)+(1.0-P)**(ALAMBA-1.0)
C
      RETURN
      END 
      SUBROUTINE LGNCDF(X,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT LGNCDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE FOR THE LOGNORMAL
C              DISTRIBUTION.
C              THE LOGNORMAL DISTRIBUTION USED
C              HEREIN HAS MEAN = SQRT(E) = 1.64872127
C              AND STANDARD DEVIATION = SQRT(E*(E-1)) = 2.16119742.
C              THIS DISTRIBUTION IS DEFINED FOR ALL POSITIVE X
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = (1/(X*SQRT(2*PI))) * EXP(-ALOG(X)*ALOG(X)/2)
C              THE LOGNORMAL DISTRIBUTION USED HEREIN
C              IS THE DISTRIBUTION OF THE VARIATE X = EXP(Z) WHERE
C              THE VARIATE Z IS NORMALLY DISTRIBUTED
C              WITH MEAN = 0 AND STANDARD DEVIATION = 1.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE 
C                                AT WHICH THE CUMULATIVE DISTRIBUTION 
C                                FUNCTION IS TO BE EVALUATED.
C                                X 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 LOGNORMAL
C             DISTRIBUTION WITH MEAN = SQRT(E) = 1.64872127 
C             AND STANDARD DEVIATION = SQRT(E*(E-1)) = 2.16119742.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--X SHOULD BE POSITIVE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NORCDF. 
C     FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 112-136.
C               --CRAMER, MATHEMATICAL METHODS OF STATISTICS,
C                 1946, PAGES 219-220.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(X.LE.0.0)GOTO50
      GOTO90
   50 WRITE(IPR,4)
      WRITE(IPR,46)X
      CDF=0.0
      RETURN
   90 CONTINUE
    4 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE LGNCDF SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      ARG=ALOG(X)
      CALL NORCDF(ARG,CDF)
C
      RETURN
      END 
      SUBROUTINE LGNPLT(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT LGNPLT
C
C     PURPOSE--THIS SUBROUTINE GENERATES A LOGNORMAL
C              PROBABILITY PLOT.
C              THE PROTOTYPE LOGNORMAL DISTRIBUTION USED HEREIN
C              HAS MEAN = SQRT(E) = 1.64872127
C              AND STANDARD DEVIATION = SQRT(E*(E-1)) = 2.16119742.
C              THIS DISTRIBUTION IS DEFINED FOR ALL POSITIVE X
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = (1/(X*SQRT(2*PI))) * EXP(-ALOG(X)*ALOG(X)/2)
C              THE PROTOTYPE LOGNORMAL DISTRIBUTION USED HEREIN
C              IS THE DISTRIBUTION OF THE VARIATE X = EXP(Z) WHERE
C              THE VARIATE Z IS NORMALLY DISTRIBUTED
C              WITH MEAN = 0 AND STANDARD DEVIATION = 1.
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 LOGNORMAL 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 LOGNORMAL 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--A ONE-PAGE LOGNORMAL PROBABILITY PLOT.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, NORPPF, PLOT. 
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, EXP.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
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 112-136.
C               --CRAMER, MATHEMATICAL METHODS OF STATISTICS,
C                 1946, PAGES 219-220.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(7500),W(7500)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501))
C
      DATA TAU/2.37134890/
C
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE LGNPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 LGNPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE LGNPLT SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     SORT THE DATA 
C
      CALL SORT(X,N,Y)
C
C     GENERATE UNIFORM ORDER STATISTIC MEDIANS
C
      CALL UNIMED(N,W)
C
C     COMPUTE LOGNORMAL ORDER STATISTIC MEDIANS
C
      DO100I=1,N
      Q=W(I)
      CALL NORPPF(Q,Q)
      W(I)=EXP(Q)
  100 CONTINUE
C
C     PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS.
C     WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION 
C     AND THE SAMPLE SIZE.
C
      CALL PLOT(Y,W,N)
      WRITE(IPR,105)TAU,N
C
C     COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. 
C     COMPUTE LOCATION AND SCALE ESTIMATES
C     FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. 
C     THEN WRITE THEM OUT.
C
      SUM1=0.0
      SUM2=0.0
      DO200I=1,N
      SUM1=SUM1+Y(I)
      SUM2=SUM2+W(I)
  200 CONTINUE
      YBAR=SUM1/AN
      WBAR=SUM2/AN
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO300I=1,N
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) 
      SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) 
      SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 
  300 CONTINUE
      CC=SUM2/SQRT(SUM3*SUM1) 
      YSLOPE=SUM2/SUM3
      YINT=YBAR-YSLOPE*WBAR
      WRITE(IPR,305)CC,YINT,YSLOPE
C
  105 FORMAT(1H ,34HLOGNORMAL PROBABILITY PLOT (TAU = ,E15.8,1H),53X,20H
     1THE SAMPLE SIZE N = ,I7)
  305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X,
     122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) 
C
      RETURN
      END 
      SUBROUTINE LGNPPF(P,PPF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT LGNPPF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE FOR THE LOGNORMAL
C              DISTRIBUTION.
C              THE LOGNORMAL DISTRIBUTION USED
C              HEREIN HAS MEAN = SQRT(E) = 1.64872127
C              AND STANDARD DEVIATION = SQRT(E*(E-1)) = 2.16119742.
C              THIS DISTRIBUTION IS DEFINED FOR ALL POSITIVE X
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = (1/(X*SQRT(2*PI))) * EXP(-ALOG(X)*ALOG(X)/2)
C              THE LOGNORMAL DISTRIBUTION USED HEREIN
C              IS THE DISTRIBUTION OF THE VARIATE X = EXP(Z) WHERE
C              THE VARIATE Z IS NORMALLY DISTRIBUTED
C              WITH MEAN = 0 AND STANDARD DEVIATION = 1.
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 (EXCLUSIVELY) 
C                                AND 1.0 (EXCLUSIVELY))
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 FUNCTION . 
C             VALUE PPF FOR THE LOGNORMAL DISTRIBUTION
C             WITH MEAN = SQRT(E) = 1.64872127
C             AND STANDARD DEVIATION = SQRT(E*(E-1)) = 2.16119742.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C     OTHER DATAPAC   SUBROUTINES NEEDED--NORPPF. 
C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 112-136.
C               --CRAMER, MATHEMATICAL METHODS OF STATISTICS,
C                 1946, PAGES 219-220.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LE.0.0.OR.P.GE.1.0)GOTO50
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      PPF=0.0
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 LGNPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      CALL NORPPF(P,PPF)
      PPF=EXP(PPF)
C
      RETURN
      END 
      SUBROUTINE LGNRAN(N,ISEED,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT LGNRAN
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE LOGNORMAL DISTRIBUTION.
C              THE PROTOTYPE LOGNORMAL DISTRIBUTION USED
C              HEREIN HAS MEAN = SQRT(E) = 1.64872127
C              AND STANDARD DEVIATION = SQRT(E*(E-1)) = 2.16119742.
C              THIS DISTRIBUTION IS DEFINED FOR ALL POSITIVE X
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = (1/(X*SQRT(2*PI))) * EXP(-ALOG(X)*ALOG(X)/2)
C              THE PROTOTYPE LOGNORMAL DISTRIBUTION USED HEREIN
C              IS THE DISTRIBUTION OF THE VARIATE X = EXP(Z) WHERE
C              THE VARIATE Z IS NORMALLY DISTRIBUTED
C              WITH MEAN = 0 AND STANDARD DEVIATION = 1.
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             FROM THE LOGNORMAL DISTRIBUTION
C             WITH MEAN = SQRT(E) = 1.64872127
C             AND STANDARD DEVIATION = SQRT(E*(E-1)) = 2.16119742.
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--ALOG, SQRT, SIN, COS, EXP.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--TOCHER, THE ART OF SIMULATION,
C                 1963, PAGES 14-15.
C               --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS,
C                 1964, PAGE 36.
C               --CRAMER, MATHEMATICAL METHODS OF STATISTICS,
C                 1946, PAGES 219-220.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 112-136.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGE 88.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82.6
C     ORIGINAL VERSION--NOVEMBER  1975.
C     UPDATED         --JULY      1976.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
      DIMENSION Y(2)
C
C---------------------------------------------------------------------
C
CCCCC CHARACTER*4 IFEEDB
CCCCC CHARACTER*4 IPRINT
C
CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
CCCCC COMMON /PRINT/IFEEDB,IPRINT
C
      IPR=6
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(IPR, 5)
      WRITE(IPR,47)N
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 LGNRAN SUBROUTINE IS NON-POSITIVE *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
C     THEN GENERATE 2 ADDITIONAL UNIFORM (0,1) RANDOM NUMBERS
C     (TO BE USED BELOW IN FORMING THE N-TH NORMAL
C     RANDOM NUMBER WHEN THE DESIRED SAMPLE SIZE N
C     HAPPENS TO BE ODD).
C
      CALL UNIRAN(N,ISEED,X)
      CALL UNIRAN(2,ISEED,Y)
C
C     GENERATE N NORMAL RANDOM NUMBERS
C     USING THE BOX-MULLER METHOD.
C
      DO200I=1,N,2
      IP1=I+1
      U1=X(I)
      IF(I.EQ.N)GOTO210
      U2=X(IP1)
      GOTO220
  210 U2=Y(2)
  220 ARG1=-2.0*ALOG(U1)
      ARG2=2.0*PI*U2
      SQRT1=SQRT(ARG1)
      Z1=SQRT1*COS(ARG2)
      Z2=SQRT1*SIN(ARG2)
      X(I)=Z1
      IF(I.EQ.N)GOTO200
      X(IP1)=Z2
  200 CONTINUE
C
C     GENERATE N LOGNORMAL RANDOM NUMBERS
C     USING THE DEFINITION THAT
C     A LOGNORMAL VARIATE
C     EQUALS AN EXPONETIATED NORMAL VARIATE.
C
      DO400I=1,N
      X(I)=EXP(X(I))
  400 CONTINUE
C
      RETURN
      END
      SUBROUTINE LOC(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT LOC
C
C     PURPOSE--THIS SUBROUTINE COMPUTES 4 ESTIMATES OF THE
C              LOCATION (TYPICAL VALUE, MEASURE OF CENTRAL
C              TENDANCY) OF THE DATA IN THE INPUT VECTOR X. 
C              THE 4 ESTIMATORS EMPLOYED ARE--
C              1) THE SAMPLE MIDRANGE;
C              2) THE SAMPLE MEAN;
C              3) THE SAMPLE MIDMEAN; AND
C              4) THE SAMPLE MEDIAN.
C              THE ABOVE 4 ESTIMATORS ARE NEAR-OPTIMAL
C              ESTIMATORS OF LOCATION
C              FOR SHORTER-TAILED SYMMETRIC DISTRIBUTIONS,
C              MODERATE-TAILED DISTRIBUTIONS,
C              MODERATE-LONG-TAILED DISTRIBUTIONS,
C              AND LONG-TAILED DISTRIBUTIONS,
C              RESPECTIVELY.
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--1/4 PAGE OF AUTOMATIC OUTPUT
C             CONSISTING OF THE FOLLOWING 4
C             ESTIMATES OF LOCATION
C             FOR THE DATA IN THE INPUT VECTOR X--
C             1) THE SAMPLE MIDRANGE;
C             2) THE SAMPLE MEAN;
C             3) THE SAMPLE MIDMEAN; AND
C             4) THE SAMPLE MEDIAN.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--DIXON AND MASSEY, PAGES 14, 70, AND 71
C               --CROW, JOURNAL OF THE AMERICAN STATISTICAL ASSOCIATION,
C                 PAGES 357 AND 387
C               --KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 1, EDITION 2, 1963, PAGE 8.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(15000)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1))
C
      IPR=6
      IUPPER=15000
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      XMID=0.0
      XMEAN=0.0
      XMIDM=0.0
      XMED=0.0
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XMID=X(1)
      XMEAN=X(1)
      XMIDM=X(1)
      XMED=X(1)
      GOTO301
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE LOC    SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 LOC    SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE LOC    SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     SORT THE DATA,
C     THEN COMPUTE THE SAMPLE MIDRANGE. 
C
      CALL SORT(X,N,Y)
      XMID=(Y(1)+Y(N))/2.0
C
C     COMPUTE THE SAMPLE MEAN 
C
      SUM=0.0
      DO100I=1,N
      SUM=SUM+Y(I)
  100 CONTINUE
      XMEAN=SUM/AN
C
C     COMPUTE THE SAMPLE MIDMEAN
C
      IFLAG=N-(N/4)*4
      AIFLAG=IFLAG
      IMIN=N/4+1
      IMAX=N-IMIN+1 
      SUM=0.0
      SUM=SUM+Y(IMIN)*(4.0-AIFLAG)/4.0
      SUM=SUM+Y(IMAX)*(4.0-AIFLAG)/4.0
      IMINP1=IMIN+1 
      IMAXM1=IMAX-1 
      IF(IMINP1.GT.IMAXM1)GOTO250
      DO200I=IMINP1,IMAXM1
      SUM=SUM+Y(I)
  200 CONTINUE
  250 XMIDM=SUM/(AN/2.0)
C
C     COMPUTE THE SAMPLE MEDIAN
C
      IFLAG=N-(N/2)*2
      NMID=N/2
      NMIDP1=NMID+1 
      IF(IFLAG.EQ.0)XMED=(Y(NMID)+Y(NMIDP1))/2.0
      IF(IFLAG.EQ.1)XMED=Y(NMIDP1)
C
C     WRITE EVERYTHING OUT
C
  301 DO300I=1,5
      WRITE(IPR,999)
  300 CONTINUE
      WRITE(IPR,305)
      WRITE(IPR,999)
      WRITE(IPR,310)N
      WRITE(IPR,999)
      WRITE(IPR,999)
      WRITE(IPR,315)XMID
      WRITE(IPR,320)XMEAN
      WRITE(IPR,325)XMIDM
      WRITE(IPR,330)XMED
C
  305 FORMAT(1H ,30X,35HESTIMATES OF THE LOCATION PARAMETER)
  310 FORMAT(1H ,34X,21H(THE SAMPLE SIZE N = ,I5,1H))
  315 FORMAT(1H ,38HTHE SAMPLE MIDRANGE IS                ,E15.8)
  320 FORMAT(1H ,38HTHE SAMPLE MEAN IS                    ,E15.8)
  325 FORMAT(1H ,38HTHE SAMPLE 25 PERCENT TRIMMED MEAN IS ,E15.8)
  330 FORMAT(1H ,38HTHE SAMPLE MEDIAN IS                  ,E15.8)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE LOGCDF(X,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT LOGCDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE FOR THE LOGISTIC DISTRIBUTION 
C              WITH MEAN = 0 AND STANDARD DEVIATION = PI/SQRT(3).
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = EXP(X)/(1+EXP(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--EXP.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--2, 1970, PAGES 1-21.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --MAY       1974. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS.
C     NO INPUT ARGUMENT ERRORS POSSIBLE 
C     FOR THIS DISTRIBUTION.
C
C-----START POINT-----------------------------------------------------
C
      IF(X.GE.0.0)GOTO150
      CDF=EXP(X)/(1.0+EXP(X)) 
      RETURN
  150 CDF=1.0/(1.0+EXP(-X))
      RETURN
C
      END 
      SUBROUTINE LOGPDF(X,PDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT LOGPDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY
C              FUNCTION VALUE FOR THE LOGISTIC DISTRIBUTION 
C              WITH MEAN = 0 AND STANDARD DEVIATION = PI/SQRT(3).
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = EXP(X)/(1+EXP(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--EXP.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--2, 1970, PAGES 1-21.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS.
C     NO INPUT ARGUMENT ERRORS POSSIBLE 
C     FOR THIS DISTRIBUTION.
C
C-----START POINT-----------------------------------------------------
C
      PDF=EXP(X)/((1.0+EXP(X))**2)
C
      RETURN
      END 
      SUBROUTINE LOGPLT(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT LOGPLT
C
C     PURPOSE--THIS SUBROUTINE GENERATES A LOGISTIC
C              PROBABILITY PLOT.
C              THE PROTOTYPE LOGISTIC DISTRIBUTION USED HEREIN
C              HAS MEAN = 0 AND STANDARD DEVIATION = PI/SQRT(3).
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = EXP(X) / (1+EXP(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 LOGISTIC 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 LOGISTIC 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--A ONE-PAGE LOGISTIC PROBABILITY PLOT.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, PLOT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
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--2, 1970, PAGES 1-21.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(7500),W(7500)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501))
C
      DATA TAU/1.63473745/
C
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE LOGPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 LOGPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE LOGPLT SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     SORT THE DATA 
C
      CALL SORT(X,N,Y)
C
C     GENERATE UNIFORM ORDER STATISTIC MEDIANS
C
      CALL UNIMED(N,W)
C
C     COMPUTE LOGISTIC ORDER STATISTIC MEDIANS
C
      DO100I=1,N
      W(I)=ALOG(W(I)/(1.0-W(I)))
  100 CONTINUE
C
C     PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS.
C     WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION 
C     AND THE SAMPLE SIZE.
C
      CALL PLOT(Y,W,N)
      WRITE(IPR,105)TAU,N
C
C     COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. 
C     COMPUTE LOCATION AND SCALE ESTIMATES
C     FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. 
C     THEN WRITE THEM OUT.
C
      SUM1=0.0
      DO200I=1,N
      SUM1=SUM1+Y(I)
  200 CONTINUE
      YBAR=SUM1/AN
      WBAR=0.0
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO300I=1,N
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) 
      SUM2=SUM2+W(I)*Y(I)
      SUM3=SUM3+W(I)*W(I)
  300 CONTINUE
      CC=SUM2/SQRT(SUM3*SUM1) 
      YSLOPE=SUM2/SUM3
      YINT=YBAR-YSLOPE*WBAR
      WRITE(IPR,305)CC,YINT,YSLOPE
C
  105 FORMAT(1H ,33HLOGISTIC PROBABILITY PLOT (TAU = ,E15.8,1H),54X,20HT
     1HE SAMPLE SIZE N = ,I7) 
  305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X,
     122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) 
C
      RETURN
      END 
      SUBROUTINE LOGPPF(P,PPF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT LOGPPF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE FOR THE LOGISTIC DISTRIBUTION 
C              WITH MEAN = 0 AND STANDARD DEVIATION = PI/SQRT(3).
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = EXP(X)/(1+EXP(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--EXP.
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--2, 1970, PAGES 1-21.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LE.0.0.OR.P.GE.1.0)GOTO50
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 LOGPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
CCCCC CALL QCORR(P,Q)
CCCCC PPF=ALOG(P/Q) 
      PPF=ALOG(P/(1.0-P))
C
      RETURN
      END 
      SUBROUTINE LOGRAN(N,ISEED,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT LOGRAN
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE LOGISTIC DISTRIBUTION
C              WITH MEAN = 0 AND STANDARD DEVIATION = PI/SQRT(3).
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = EXP(X)/(1+EXP(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             FROM THE LOGISTIC DISTRIBUTION
C             WITH MEAN = 0 AND STANDARD DEVIATION = PI/SQRT(3).
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--ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--TOCHER, THE ART OF SIMULATION,
C                 1963, PAGES 14-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 230.
C               --FILLIBEN, 'THE PERCENT POINT FUNCTION',
C                 (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--2, 1970, PAGES 1-21.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82.6
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
CCCCC CHARACTER*4 IFEEDB
CCCCC CHARACTER*4 IPRINT
C
CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
CCCCC COMMON /PRINT/IFEEDB,IPRINT
C
      IPR=6
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      GOTO90
   50 WRITE(IPR, 5)
      WRITE(IPR,47)N
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 LOGRAN SUBROUTINE IS NON-POSITIVE *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
C
      CALL UNIRAN(N,ISEED,X)
C
C     GENERATE N LOGISTIC RANDOM NUMBERS
C     USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD.
C
      DO100I=1,N
      X(I)=ALOG(X(I)/(1.0-X(I)))
  100 CONTINUE
C
      RETURN
      END
      SUBROUTINE LOGSF(P,SF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT LOGSF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE SPARSITY
C              FUNCTION VALUE FOR THE LOGISTIC DISTRIBUTION 
C              WITH MEAN = 0 AND STANDARD DEVIATION = PI/SQRT(3).
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = EXP(X)/(1+EXP(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--NONE.
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--2, 1970, PAGES 1-21.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LE.0.0.OR.P.GE.1.0)GOTO50
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 LOGSF  SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      SF=1.0/(P-P*P)
C
      RETURN
      END 
      SUBROUTINE MAX(X,N,IWRITE,XMAX)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT MAX
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SAMPLE MAXIMUM 
C              OF THE DATA IN THE INPUT VECTOR X. 
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                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SAMPLE MAXIMUM
C                                AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SAMPLE MAXIMUM
C                                AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--XMAX   = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE MAXIMUM.
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE MAXIMUM. 
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--DAVID, ORDER STATISTICS, 1970, PAGE 7.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      XMAX=X(1)
      GOTO101
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XMAX=X(1)
      GOTO101
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE MAX    SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 MAX    SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE MAX    SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      XMAX=X(1)
      DO100I=2,N
      IF(X(I).GT.XMAX)XMAX=X(I)
  100 CONTINUE
C
  101 IF(IWRITE.EQ.0)RETURN
      WRITE(IPR,999)
      WRITE(IPR,105)N,XMAX
  105 FORMAT(1H ,26HTHE MAXIMUM OF THE SET OF ,I6,17H OBSERVATIONS IS ,E
     115.8)
  999 FORMAT(1H )
      RETURN
      END 
      SUBROUTINE MEAN(X,N,IWRITE,XMEAN) 
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT MEAN
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SAMPLE MEAN
C              OF THE DATA IN THE INPUT VECTOR X. 
C              THE SAMPLE MEAN = (SUM OF THE OBSERVATIONS)/N.
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                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SAMPLE MEAN
C                                AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SAMPLE MEAN
C                                AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--XMEAN  = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE MEAN.
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE MEAN.
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 2, EDITION 1, 1961, PAGE 4.
C               --MOOD AND GRABLE, INTRODUCTION TO THE THEORY
C                 OF STATISTICS, EDITION 2, 1963, PAGE 146. 
C               --DIXON AND MASSEY, INTRODUCTION TO STATISTICAL
C                 ANALYSIS, EDITION 2, 1957, PAGE 14.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      AN=N
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      XMEAN=X(1)
      GOTO101
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XMEAN=X(1)
      GOTO101
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE MEAN   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 MEAN   SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE MEAN   SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      SUM=0.0
      DO100I=1,N
      SUM=SUM+X(I)
  100 CONTINUE
      XMEAN=SUM/AN
C
  101 IF(IWRITE.EQ.0)RETURN
      WRITE(IPR,999)
      WRITE(IPR,105)N,XMEAN
  105 FORMAT(1H ,23HTHE SAMPLE MEAN OF THE ,I6,17H OBSERVATIONS IS ,E15.
     18)
  999 FORMAT(1H )
      RETURN
      END 
      SUBROUTINE MEDIAN(X,N,IWRITE,XMED)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT MEDIAN
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SAMPLE MEDIAN
C              OF THE DATA IN THE INPUT VECTOR X. 
C              THE SAMPLE MEDIAN = THAT VALUE SUCH THAT HALF THE
C              DATA SET IS BELOW IT AND HALF ABOVE IT.
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                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SAMPLE MEDIAN
C                                AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SAMPLE MEDIAN
C                                AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--XMED   = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE MEDIAN.
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE MEDIAN.
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 15000. 
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 1, EDITION 2, 1963, PAGE 326.
C               --KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 2, EDITION 1, 1961, PAGE 49.
C               --DAVID, ORDER STATISTICS, 1970, PAGE 139.
C               --SNEDECOR AND COCHRAN, STATISTICAL METHODS,
C                 EDITION 6, 1967, PAGE 123.
C               --DIXON AND MASSEY, INTRODUCTION TO STATISTICAL
C                 ANALYSIS, EDITION 2, 1957, PAGE 70.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(15000)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1))
C
      IPR=6
      IUPPER=15000
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      XMED=X(1)
      GOTO101
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XMED=X(1)
      GOTO101
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE MEDIAN SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 MEDIAN SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE MEDIAN SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      CALL SORT(X,N,Y)
      IFLAG=N-(N/2)*2
      NMID=N/2
      NMIDP1=NMID+1 
      IF(IFLAG.EQ.0)XMED=(Y(NMID)+Y(NMIDP1))/2.0
      IF(IFLAG.EQ.1)XMED=Y(NMIDP1)
C
  101 IF(IWRITE.EQ.0)RETURN
      WRITE(IPR,999)
      WRITE(IPR,105)N,XMED
  105 FORMAT(1H ,25HTHE SAMPLE MEDIAN OF THE ,I6,17H OBSERVATIONS IS ,E1
     15.8)
  999 FORMAT(1H )
      RETURN
      END 
      SUBROUTINE MIDM(X,N,IWRITE,XMIDM) 
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT MIDM
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SAMPLE MIDMEAN = THE
C              SAMPLE 25% (ON EACH SIDE) TRIMMED MEAN
C              OF THE DATA IN THE INPUT VECTOR X. 
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                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SAMPLE MIDMEAN
C                                AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SAMPLE MIDMEAN
C                                AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--XMIDM  = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE MIDMEAN.
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE MIDMEAN. 
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 15000. 
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--DAVID, ORDER STATISTICS, 1970, PAGES 129, 136.
C               --CROW AND SIDDIQUI, 'ROBUST ESTIMATION OF LOCATION', 
C                 JOURNAL OF THE AMERICAN STATISTICAL ASSOCIATION,
C                 1967, PAGES 357, 387. 
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).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(15000)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1))
      DATA P1,P2,PERP1,PERP2,PERP3/0.25,0.25,25.0,25.0,50.0/
C
      IPR=6
      IUPPER=15000
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      AN=N
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      XMIDM=X(1)
      GOTO201
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XMIDM=X(1)
      GOTO201
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE MIDM   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 MIDM   SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE MIDM   SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      CALL SORT(X,N,Y)
C
      AN=N
      NP1=P1*AN+0.0001
      ISTART=NP1+1
      NP2=P2*AN+0.0001
      ISTOP=N-NP2
      SUM=0.0
      K=0 
      IF(ISTART.GT.ISTOP)GOTO150
      DO100I=ISTART,ISTOP
      K=K+1
CCCCC SUM=SUM+X(I)
      SUM=SUM+Y(I)
  100 CONTINUE
      AK=K
      XMIDM=SUM/AK
      GOTO170
  150 WRITE(IPR,155)
  155 FORMAT(1H ,37HINTERNAL ERROR IN MIDM   SUBROUTINE--,
     1 45HTHE START INDEX IS HIGHER THAN THE STOP INDEX)
      XMIDM=0.0
      RETURN
  170 CONTINUE
C
  201 IF(IWRITE.EQ.0)RETURN
      WRITE(IPR,999)
      WRITE(IPR,105)N,XMIDM
      WRITE(IPR,110)PERP1,NP1 
      WRITE(IPR,115)PERP2,NP2 
      WRITE(IPR,120)PERP3,K
  105 FORMAT(1H ,26HTHE SAMPLE MIDMEAN OF THE ,I6,13H OBSERVATIONS,
     1  4H IS ,E15.8)
  110 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) ,
     1 39HOF THE DATA WERE TRIMMED     FROM BELOW)
  115 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) ,
     1 39HOF THE DATA WERE TRIMMED     FROM ABOVE)
  120 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) ,
     1 52H OF THE DATA REMAIN IN THE MIDDLE AFTER THE TRIMMING)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE MIDR(X,N,IWRITE,XMIDR) 
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT MIDR
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SAMPLE MIDRANGE
C              OF THE DATA IN THE INPUT VECTOR X. 
C              THE SAMPLE MIDRANGE = (SAMPLE MIN + SAMPLE MAX)/2.
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                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SAMPLE MIDRANGE
C                                AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SAMPLE MIDRANGE
C                                AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--XMIDR  = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE MIDRANGE.
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE MIDRANGE.
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 1, EDITION 2, 1963, PAGE 338.
C               --KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 2, EDITION 1, 1961, PAGE 91.
C               --DAVID, ORDER STATISTICS, 1970, PAGE 97.
C               --DIXON AND MASSEY, INTRODUCTION TO STATISTICAL
C                 ANALYSIS, EDITION 2, 1957, PAGE 71.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      XMIDR=X(1)
      GOTO101
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XMIDR=X(1)
      GOTO101
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE MIDR   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 MIDR   SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE MIDR   SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      XMIN=X(1)
      XMAX=X(1)
      DO100I=1,N
      IF(X(I).LT.XMIN)XMIN=X(I)
      IF(X(I).GT.XMAX)XMAX=X(I)
  100 CONTINUE
      XMIDR=(XMIN+XMAX)/2.0
C
  101 IF(IWRITE.EQ.0)RETURN
      WRITE(IPR,999)
      WRITE(IPR,105)N,XMIDR
  105 FORMAT(1H ,27HTHE SAMPLE MIDRANGE OF THE ,I6,17H OBSERVATIONS IS ,
     1E22.15)
  999 FORMAT(1H )
      RETURN
      END 
      SUBROUTINE MIN(X,N,IWRITE,XMIN)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT MIN
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SAMPLE MINIMUM 
C              OF THE DATA IN THE INPUT VECTOR X. 
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                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SAMPLE MINIMUM
C                                AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SAMPLE MINIMUM
C                                AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--XMIN   = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE MINIMUM.
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE MINIMUM. 
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--DAVID, ORDER STATISTICS, 1970, PAGE 7.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      XMIN=X(1)
      GOTO101
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XMIN=X(1)
      GOTO101
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE MIN    SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 MIN    SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE MIN    SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      XMIN=X(1)
      DO100I=2,N
      IF(X(I).LT.XMIN)XMIN=X(I)
  100 CONTINUE
C
  101 IF(IWRITE.EQ.0)RETURN
      WRITE(IPR,999)
      WRITE(IPR,105)N,XMIN
  105 FORMAT(1H ,26HTHE MINIMUM OF THE SET OF ,I6,17H OBSERVATIONS IS ,E
     115.8)
  999 FORMAT(1H )
      RETURN
      END 
      SUBROUTINE MOVE(X,M,IX1,IY1,Y)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT MOVE
C
C     PURPOSE--THIS SUBROUTINE MOVES (COPIES) M ELEMENTS OF THE
C              SINGLE PRECISION VECTOR X
C              (STARTING WITH POSITION IX1)
C              INTO THE SINGLE PRECISION VECTOR Y 
C              (STARTING WITH POSITION IY1).
C              THIS ALLOWS THE DATA ANALYST
C              TO TAKE ANY SUBVECTOR IN X AND PLACE IT
C              ANYWHERE IN THE VECTOR Y.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                                OBSERVATIONS, PART (OR ALL)
C                                OF WHICH IS TO BE MOVED
C                                (COPIED) OVER INTO THE VECTOR Y.
C                     --M      = THE INTEGER NUMBER OF ELEMENTS
C                                IN THE VECTOR X TO BE MOVED.
C                     --IX1    = THE INTEGER VALUE WHICH DEFINES
C                                THE POSITION IN THE VECTOR X
C                                OF THE FIRST ELEMENT TO BE MOVED.
C                     --IY1    = THE INTEGER VALUE WHICH DEFINES
C                                THE POSITION IN THE VECTOR Y
C                                WHERE THE FIRST ELEMENT TO BE MOVED
C                                WILL BE PLACED.
C     OUTPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR
C                                INTO WHICH THE COPIED DATA VALUES
C                                FROM THE VECTOR X WILL BE SEQUENTIALLY
C                                PLACED, STARTING IN POSITION IY1 OF Y.
C     OUTPUT--THE SINGLE PRECISION VECTOR Y.
C             IN WHICH THE M ELEMENTS IN POSITIONS
C             IY1, IY1+1, ... , IY1+M-1 
C             WILL BE IDENTICAL TO THE M ELEMENTS 
C             IN THE X VECTOR IN POSITIONS
C             IX1, IX1+1, ... , IX1+M-1.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF M FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--THE ELEMENT IN POSITION IX1 OF THE VECTOR X
C            IS COPIED INTO POSITION IY1 OF THE VECTOR Y,
C            THE ELEMENT IN POSITION (IX1+1) OF THE VECTOR X
C            IS COPIED INTO POSITION (IY1+1) OF THE VECTOR Y,
C            ... ,
C            THE ELEMENT IN POSITION (IX1+M-1) OF THE VECTOR X
C            IS COPIED INTO POSITION (IY1+M-1) OF THE VECTOR Y.
C     COMMENT--THE INPUT VECTOR X REMAINS UNALTERED.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1972. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1),Y(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(M.LT.1)GOTO50
      IF(IX1.LT.1)GOTO65
      IF(IY1.LT.1)GOTO70
      IF(M.EQ.1)GOTO55
      HOLD=X(IX1)
      ISTART=IX1+1
      IEND=IX1+M-1
      DO60I=ISTART,IEND
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,15) 
      WRITE(IPR,47)M
      RETURN
   55 WRITE(IPR,18) 
      GOTO90
   65 WRITE(IPR,25) 
      WRITE(IPR,47)IX1
      RETURN
   70 WRITE(IPR,35) 
      WRITE(IPR,47)IY1
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE MOVE   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 MOVE   SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE MOVE   SUBROUTINE HAS THE VALUE 1 *****)
   25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 MOVE   SUBROUTINE IS NON-POSITIVE *****)
   35 FORMAT(1H , 91H***** FATAL ERROR--THE FOURTH INPUT ARGUMENT TO THE
     1 MOVE   SUBROUTINE IS NON-POSITIVE *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      DO100I=1,M
      J=IX1-1+I
      K=IY1-1+I
      Y(K)=X(J)
  100 CONTINUE
C
      RETURN
      END 
      SUBROUTINE NBCDF(X,P,N,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT NBCDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE AT THE SINGLE PRECISION VALUE X
C              FOR THE NEGATIVE BINOMIAL DISTRIBUTION
C              WITH SINGLE PRECISION 'BERNOULLI PROBABILITY'
C              PARAMETER = P, 
C              AND INTEGER 'NUMBER OF SUCCESSES IN BERNOULLI TRIALS'
C              PARAMETER = N. 
C              THE NEGATIVE BINOMIAL DISTRIBUTION USED
C              HEREIN HAS MEAN = N*(1-P)/P
C              AND STANDARD DEVIATION = SQRT(N*(1-P)/(P*P))).
C              THIS DISTRIBUTION IS DEFINED FOR
C              ALL NON-NEGATIVE INTEGER X--X = 0, 1, 2, ... .
C              THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION
C              F(X) = C(N+X-1,N) * P**N * (1-P)**X.
C              WHERE C(N+X-1,N) IS THE COMBINATORIAL FUNCTION
C              EQUALING THE NUMBER OF COMBINATIONS OF N+X-1 ITEMS
C              TAKEN N AT A TIME.
C              THE NEGATIVE BINOMIAL DISTRIBUTION IS THE
C              DISTRIBUTION OF THE NUMBER OF FAILURES
C              BEFORE OBTAINING N SUCCESSES IN AN 
C              INDEFINITE SEQUENCE OF BERNOULLI (0,1)
C              TRIALS WHERE THE PROBABILITY OF SUCCESS
C              IN A SINGLE TRIAL = P.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE 
C                                AT WHICH THE CUMULATIVE DISTRIBUTION 
C                                FUNCTION IS TO BE EVALUATED.
C                                X SHOULD BE NON-NEGATIVE AND
C                                INTEGRAL-VALUED. 
C                     --P      = THE SINGLE PRECISION VALUE 
C                                OF THE 'BERNOULLI PROBABILITY'
C                                PARAMETER FOR THE NEGATIVE BINOMIAL
C                                DISTRIBUTION.
C                                P SHOULD BE BETWEEN
C                                0.0 (EXCLUSIVELY) AND
C                                1.0 (EXCLUSIVELY).
C                     --N      = THE INTEGER VALUE
C                                OF THE 'NUMBER OF SUCCESSES
C                                IN BERNOULLI TRIALS' PARAMETER.
C                                N SHOULD BE A POSITIVE INTEGER.
C     OUTPUT ARGUMENTS--CDF    = THE SINGLE PRECISION CUMULATIVE
C                                DISTRIBUTION FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION
C             FUNCTION VALUE CDF
C             FOR THE NEGATIVE BINOMIAL DISTRIBUTION
C             WITH 'BERNOULLI PROBABILITY' PARAMETER = P
C             AND 'NUMBER OF SUCCESSES IN BERNOULLI TRIALS' 
C             PARAMETER = N.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE AND INTEGRAL-VALUED.
C                 --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C                 --N SHOULD BE A POSITIVE INTEGER.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DATAN.
C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--NOTE THAT EVEN THOUGH THE INPUT
C              TO THIS CUMULATIVE
C              DISTRIBUTION FUNCTION SUBROUTINE
C              FOR THIS DISCRETE DISTRIBUTION
C              SHOULD (UNDER NORMAL CIRCUMSTANCES) BE A
C              DISCRETE INTEGER VALUE,
C              THE INPUT VARIABLE X IS SINGLE
C              PRECISION IN MODE.
C              X HAS BEEN SPECIFIED AS SINGLE
C              PRECISION SO AS TO CONFORM WITH THE DATAPAC
C              CONVENTION THAT ALL INPUT ****DATA****
C              (AS OPPOSED TO SAMPLE SIZE, FOR EXAMPLE)
C              VARIABLES TO ALL
C              DATAPAC SUBROUTINES ARE SINGLE PRECISION.
C              THIS CONVENTION IS BASED ON THE BELIEF THAT
C              1) A MIXTURE OF MODES (FLOATING POINT
C              VERSUS INTEGER) IS INCONSISTENT AND
C              AN UNNECESSARY COMPLICATION
C              IN A DATA ANALYSIS; AND
C              2) FLOATING POINT MACHINE ARITHMETIC
C              (AS OPPOSED TO INTEGER ARITHMETIC) 
C              IS THE MORE NATURAL MODE FOR DOING 
C              DATA ANALYSIS. 
C     REFERENCES--NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 945, FORMULAE 26.5.24 AND
C                 26.5.28, AND PAGE 929.
C               --JOHNSON AND KOTZ, DISCRETE
C                 DISTRIBUTIONS, 1969, PAGES 122-142,
C                 ESPECIALLY PAGE 127.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGES 92-95.
C               --FELLER, AN INTRODUCTION TO PROBABILITY
C                 THEORY AND ITS APPLICATIONS, VOLUME 1,
C                 EDITION 2, 1957, PAGES 155-157, 210.
C               --KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 130-131.
C               --WILLIAMSON AND BRETHERTON, TABLES OF
C                 THE NEGATIVE BINOMIAL PROBABILITY
C                 DISTRIBUTION, 1963.
C               --OWEN, HANDBOOK OF STATISTICAL
C                 TABLES, 1962, PAGE 304.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DX2,PI,ANU1,ANU2,Z,SUM,TERM,AI,COEF1,COEF2,ARG 
      DOUBLE PRECISION COEF
      DOUBLE PRECISION THETA,SINTH,COSTH,A,B
      DOUBLE PRECISION DSQRT,DATAN
      DATA PI/3.14159265358979D0/
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      AN=N
      IF(P.LE.0.0.OR.P.GE.1.0)GOTO50
      IF(N.LT.1)GOTO55
      IF(X.LT.0.0)GOTO60
      INTX=X+0.0001 
      FINTX=INTX
      DEL=X-FINTX
      IF(DEL.LT.0.0)DEL=-DEL
      IF(DEL.GT.0.001)GOTO65
      GOTO90
   50 WRITE(IPR,11) 
      WRITE(IPR,46)P
      CDF=0.0
      RETURN
   55 WRITE(IPR,25) 
      WRITE(IPR,47)N
      CDF=0.0
      RETURN
   60 WRITE(IPR,4)
      WRITE(IPR,46)X
      IF(X.LT.0.0)CDF=0.0
      RETURN
   65 WRITE(IPR,5)
      WRITE(IPR,46)X
   90 CONTINUE
    4 FORMAT(1H , 96H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE NBCDF  SUBROUTINE IS NEGATIVE *****)
    5 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE NBCDF  SUBROUTINE IS NON-INTEGRAL *****)
   11 FORMAT(1H ,115H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 NBCDF  SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 NBCDF  SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
C     EXPRESS THE NEGATIVE BINOMIAL CUMULATIVE DISTRIBUTION 
C     FUNCTION IN TERMS OF THE EQUIVALENT BINOMIAL
C     CUMULATIVE DISTRIBUTION FUNCTION, 
C     AND THEN OPERATE ON THE LATTER.
C
      INTX=X+0.0001 
      K=N-1
      N2=N+INTX
C
C     EXPRESS THE BINOMIAL CUMULATIVE DISTRIBUTION
C     FUNCTION IN TERMS OF THE EQUIVALENT F
C     CUMULATIVE DISTRIBUTION FUNCTION, 
C     AND THEN EVALUATE THE LATTER.
C
      AK=K
      AN2=N2
      DX2=(P/(1.0-P))*((AN2-AK)/(AK+1.0))
      NU1=2*(K+1)
      NU2=2*(N2-K)
      ANU1=NU1
      ANU2=NU2
      Z=ANU2/(ANU2+ANU1*DX2)
C
C     DETERMINE IF NU1 AND NU2 ARE EVEN OR ODD
C
      IFLAG1=NU1-2*(NU1/2)
      IFLAG2=NU2-2*(NU2/2)
      IF(IFLAG1.EQ.0)GOTO120
      IF(IFLAG2.EQ.0)GOTO150
      GOTO250
C
C     DO THE NU1 EVEN AND NU2 EVEN OR ODD CASE
C
  120 SUM=0.0D0
      TERM=1.0D0
      IMAX=(NU1-2)/2
      IF(IMAX.LE.0)GOTO110
      DO100I=1,IMAX 
      AI=I
      COEF1=2.0D0*(AI-1.0D0)
      COEF2=2.0D0*AI
      TERM=TERM*((ANU2+COEF1)/COEF2)*(1.0D0-Z)
      SUM=SUM+TERM
  100 CONTINUE
C
  110 SUM=SUM+1.0D0 
      SUM=(Z**(ANU2/2.0D0))*SUM
      CDF=1.0D0-SUM 
      RETURN
C
C     DO THE NU1 ODD AND NU2 EVEN CASE
C
  150 SUM=0.0D0
      TERM=1.0D0
      IMAX=(NU2-2)/2
      IF(IMAX.LE.0)GOTO210
      DO200I=1,IMAX 
      AI=I
      COEF1=2.0D0*(AI-1.0D0)
      COEF2=2.0D0*AI
      TERM=TERM*((ANU1+COEF1)/COEF2)*Z
      SUM=SUM+TERM
  200 CONTINUE
C
  210 SUM=SUM+1.0D0 
      CDF=((1.0D0-Z)**(ANU1/2.0D0))*SUM 
      RETURN
C
C     DO THE NU1 ODD AND NU2 ODD CASE
C
  250 SUM=0.0D0
      TERM=1.0D0
      ARG=DSQRT((ANU1/ANU2)*DX2)
      THETA=DATAN(ARG)
      SINTH=ARG/DSQRT(1.0D0+ARG*ARG)
      COSTH=1.0D0/DSQRT(1.0D0+ARG*ARG)
      IF(NU2.EQ.1)GOTO320
      IF(NU2.EQ.3)GOTO310
      IMAX=NU2-2
      DO300I=3,IMAX,2
      AI=I
      COEF1=AI-1.0D0
      COEF2=AI
      TERM=TERM*(COEF1/COEF2)*(COSTH*COSTH)
      SUM=SUM+TERM
  300 CONTINUE
C
  310 SUM=SUM+1.0D0 
      SUM=SUM*SINTH*COSTH
C
  320 A=(2.0D0/PI)*(THETA+SUM)
  350 SUM=0.0D0
      TERM=1.0D0
      IF(NU1.EQ.1)B=0.0D0
      IF(NU1.EQ.1)GOTO450
      IF(NU1.EQ.3)GOTO410
      IMAX=NU1-3
      DO400I=1,IMAX,2
      AI=I
      COEF1=AI
      COEF2=AI+2.0D0
      TERM=TERM*((ANU2+COEF1)/COEF2)*(SINTH*SINTH)
      SUM=SUM+TERM
  400 CONTINUE
C
  410 SUM=SUM+1.0D0 
      SUM=SUM*SINTH*(COSTH**N)
      COEF=1.0D0
      IEVODD=NU2-2*(NU2/2)
      IMIN=3
      IF(IEVODD.EQ.0)IMIN=2
      IF(IMIN.GT.NU2)GOTO420
      DO430I=IMIN,NU2,2
      AI=I
      COEF=((AI-1.0D0)/AI)*COEF
  430 CONTINUE
C
  420 COEF=COEF*ANU2
      IF(IEVODD.EQ.0)GOTO440
      COEF=COEF*(2.0D0/PI)
C
  440 B=COEF*SUM
C
  450 CDF=A-B
      RETURN
C
      END 
      SUBROUTINE NBPPF(P,PPAR,N,PPF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT NBPPF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE AT THE SINGLE PRECISION VALUE P
C              FOR THE NEGATIVE BINOMIAL DISTRIBUTION
C              WITH SINGLE PRECISION 'BERNOULLI PROBABILITY'
C              PARAMETER = PPAR,
C              AND INTEGER 'NUMBER OF SUCCESSES IN BERNOULLI TRIALS'
C              PARAMETER = N. 
C              THE NEGATIVE BINOMIAL DISTRIBUTION USED
C              HEREIN HAS MEAN = N*(1-PPAR)/PPAR
C              AND STANDARD DEVIATION = SQRT(N*(1-PPAR)/(PPAR*PPAR))).
C              THIS DISTRIBUTION IS DEFINED FOR
C              ALL NON-NEGATIVE INTEGER X--X = 0, 1, 2, ... .
C              THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION
C              F(X) = C(N+X-1,N) * PPAR**N * (1-PPAR)**X.
C              WHERE C(N+X-1,N) IS THE COMBINATORIAL FUNCTION
C              EQUALING THE NUMBER OF COMBINATIONS OF N+X-1 ITEMS
C              TAKEN N AT A TIME.
C              THE NEGATIVE BINOMIAL DISTRIBUTION IS THE
C              DISTRIBUTION OF THE NUMBER OF FAILURES
C              BEFORE OBTAINING N SUCCESSES IN AN 
C              INDEFINITE SEQUENCE OF BERNOULLI (0,1)
C              TRIALS WHERE THE PROBABILITY OF SUCCESS
C              IN A SINGLE TRIAL = PPAR.
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                     --PPAR   = THE SINGLE PRECISION VALUE 
C                                OF THE 'BERNOULLI PROBABILITY'
C                                PARAMETER FOR THE NEGATIVE BINOMIAL
C                                DISTRIBUTION.
C                                PPAR SHOULD BE BETWEEN
C                                0.0 (EXCLUSIVELY) AND
C                                1.0 (EXCLUSIVELY).
C                     --N      = THE INTEGER VALUE
C                                OF THE 'NUMBER OF SUCCESSES
C                                IN BERNOULLI TRIALS' PARAMETER.
C                                N SHOULD BE A POSITIVE INTEGER.
C     OUTPUT ARGUMENTS--PPF    = THE SINGLE PRECISION PERCENT
C                                POINT FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION PERCENT POINT  .
C             FUNCTION VALUE PPF
C             FOR THE NEGATIVE BINOMIAL DISTRIBUTION
C             WITH 'BERNOULLI PROBABILITY' PARAMETER = PPAR 
C             AND 'NUMBER OF SUCCESSES IN BERNOULLI TRIALS' 
C             PARAMETER = N.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--PPAR SHOULD BE BETWEEN 0.0 (EXCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C                 --N SHOULD BE A POSITIVE INTEGER.
C                 --P SHOULD BE BETWEEN 0.0 (INCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C     OTHER DATAPAC   SUBROUTINES NEEDED--NORPPF, NBCDF.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, EXP, ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION AND DOUBLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--NOTE THAT EVEN THOUGH THE OUTPUT
C              FROM THIS DISCRETE DISTRIBUTION
C              PERCENT POINT FUNCTION
C              SUBROUTINE MUST NECESSARILY BE A
C              DISCRETE INTEGER VALUE,
C              THE OUTPUT VARIABLE PPF IS SINGLE
C              PRECISION IN MODE.
C              PPF HAS BEEN SPECIFIED AS SINGLE
C              PRECISION SO AS TO CONFORM WITH THE DATAPAC
C              CONVENTION THAT ALL OUTPUT VARIABLES FROM ALL
C              DATAPAC SUBROUTINES ARE SINGLE PRECISION.
C              THIS CONVENTION IS BASED ON THE BELIEF THAT
C              1) A MIXTURE OF MODES (FLOATING POINT
C              VERSUS INTEGER) IS INCONSISTENT AND
C              AN UNNECESSARY COMPLICATION
C              IN A DATA ANALYSIS; AND
C              2) FLOATING POINT MACHINE ARITHMETIC
C              (AS OPPOSED TO INTEGER ARITHMETIC) 
C              IS THE MORE NATURAL MODE FOR DOING 
C              DATA ANALYSIS. 
C     REFERENCES--JOHNSON AND KOTZ, DISCRETE
C                 DISTRIBUTIONS, 1969, PAGES 122-142,
C                 ESPECIALLY PAGE 127, FORMULA 22.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGES 92-95.
C               --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 929.
C               --FELLER, AN INTRODUCTION TO PROBABILITY
C                 THEORY AND ITS APPLICATIONS, VOLUME 1,
C                 EDITION 2, 1957, PAGES 155-157, 210.
C               --KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 130-131.
C               --WILLIAMSON AND BRETHERTON, TABLES OF
C                 THE NEGATIVE BINOMIAL PROBABILITY
C                 DISTRIBUTION, 1963.
C               --OWEN, HANDBOOK OF STATISTICAL
C                 TABLES, 1962, PAGE 304.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DPPAR
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LT.0.0.OR.P.GE.1.0)GOTO50
      IF(PPAR.LE.0.0.OR.PPAR.GE.1.0)GOTO55
      IF(N.LT.1)GOTO60
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      PPF=0.0
      RETURN
   55 WRITE(IPR,11) 
      WRITE(IPR,46)PPAR
      PPF=0.0
      RETURN
   60 WRITE(IPR,25) 
      WRITE(IPR,47)N
      PPF=0.0
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 NBPPF  SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   11 FORMAT(1H ,115H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 NBPPF  SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 NBPPF  SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
      DPPAR=PPAR
      PPF=0.0
      IX0=0
      IX1=0
      IX2=0
      P0=0.0
      P1=0.0
      P2=0.0
C
C     TREAT CERTAIN SPECIAL CASES IMMEDIATELY--
C     1) P = 0.0
C     2) P = 0.5 AND PPAR = 0.5
C     3) PPF = 0
C
      IF(P.EQ.0.0)GOTO110
      IF(P.EQ.0.5.AND.PPAR.EQ.0.5)GOTO130
      PF0=DPPAR**N
      IF(P.LE.PF0)GOTO110
      GOTO190
  110 PPF=0.0
      RETURN
  130 PPF=N-1
      RETURN
  190 CONTINUE
C
C     DETERMINE AN INITIAL APPROXIMATION TO THE NEGATIVE BINOMIAL
C     PERCENT POINT BY USE OF THE HYPERBOLIC ARCSIN
C     TRANSFORMATION OF THE NEGATIVE BINOMIAL
C     TO APPROXIMATE NORMALITY.
C     (SEE JOHNSON AND KOTZ, DISCRETE DISTRIBUTIONS,
C     PAGE 127, FORMULA 22).
C
      AMEAN=AN*(1.0-PPAR)/PPAR
      SD=SQRT(AN*(1.0-PPAR)/(PPAR*PPAR))
      ARG=SQRT((AMEAN+0.375)/(AN-0.75)) 
      ARCSH=ALOG(ARG+SQRT(ARG*ARG+1.0)) 
      YMEAN=(SQRT(AN-0.5))*ARCSH
      YSD=0.5
      CALL NORPPF(P,ZPPF)
      YPPF=YMEAN+ZPPF*YSD
      ARG=YPPF/SQRT(AN-0.5)
      E=EXP(ARG)
      SINH=(E-1.0/E)/2.0
      X2=-0.375+(AN-0.75)*SINH*SINH
      X2=X2+0.5
      IX2=X2
C
C     CHECK AND MODIFY (IF NECESSARY) THIS INITIAL
C     ESTIMATE OF THE PERCENT POINT
C     TO ASSURE THAT IT BE NON-NEGATIVE.
C
      IF(IX2.LT.0)IX2=0
C
C     DETERMINE UPPER AND LOWER BOUNDS ON THE DESIRED
C     PERCENT POINT BY ITERATING OUT (BOTH BELOW AND ABOVE) 
C     FROM THE ORIGINAL APPROXIMATION AT STEPS
C     OF 1 STANDARD DEVIATION.
C     THE RESULTING BOUNDS WILL BE AT MOST
C     1 STANDARD DEVIATION APART.
C
      IX0=0
      IX1=10**10
      ISD=SD+1.0
      X2=IX2
      CALL NBCDF(X2,PPAR,N,P2)
C
      IF(P2.LT.P)GOTO210
      GOTO250
C
  210 IX0=IX2
      DO220I=1,100000
      IX2=IX0+ISD
      IF(IX2.GE.IX1)GOTO275
      X2=IX2
      CALL NBCDF(X2,PPAR,N,P2)
      IF(P2.GE.P)GOTO230
      IX0=IX2
  220 CONTINUE
      WRITE(IPR,249)
      WRITE(IPR,222)
      GOTO950
  230 IX1=IX2
      GOTO275
C
  250 IX1=IX2
      DO260I=1,100000
      IX2=IX1-ISD
      IF(IX2.LE.IX0)GOTO275
      X2=IX2
      CALL NBCDF(X2,PPAR,N,P2)
      IF(P2.LT.P)GOTO270
      IX1=IX2
  260 CONTINUE
      WRITE(IPR,249)
      WRITE(IPR,262)
      GOTO950
  270 IX0=IX2
C
  275 IF(IX0.EQ.IX1)GOTO280
      GOTO295
  280 IF(IX0.EQ.0)GOTO285
      IF(IX0.EQ.N)GOTO290
      WRITE(IPR,249)
      WRITE(IPR,282)
      GOTO950
  285 IX1=IX1+1
      GOTO295
  290 IX0=IX0-1
  295 CONTINUE
C
C     COMPUTE NEGATIVE BINOMIAL PROBABILITIES FOR THE
C     DERIVED LOWER AND UPPER BOUNDS.
C
      X0=IX0
      X1=IX1
      CALL NBCDF(X0,PPAR,N,P0)
      CALL NBCDF(X1,PPAR,N,P1)
C
C     CHECK THE PROBABILITIES FOR PROPER ORDERING 
C
      IF(P0.LT.P.AND.P.LE.P1)GOTO490
      IF(P0.EQ.P)GOTO410
      IF(P1.EQ.P)GOTO420
      IF(P0.GT.P1)GOTO430
      IF(P0.GT.P)GOTO440
      IF(P1.LT.P)GOTO450
      WRITE(IPR,249)
      WRITE(IPR,401)
      GOTO950
  410 PPF=IX0
      RETURN
  420 PPF=IX1
      RETURN
  430 WRITE(IPR,249)
      WRITE(IPR,431)
      GOTO950
  440 WRITE(IPR,249)
      WRITE(IPR,441)
      GOTO950
  450 WRITE(IPR,249)
      WRITE(IPR,451)
      GOTO950
  490 CONTINUE
C
C     THE STOPPING CRITERION IS THAT THE LOWER BOUND
C     AND UPPER BOUND ARE EXACTLY 1 UNIT APART.
C     CHECK TO SEE IF IX1 = IX0 + 1;
C     IF SO, THE ITERATIONS ARE COMPLETE;
C     IF NOT, THEN BISECT, COMPUTE PROBABILIIES,
C     CHECK PROBABILITIES, AND CONTINUE ITERATING 
C     UNTIL IX1 = IX0 + 1.
C
  300 IX0P1=IX0+1
      IF(IX1.EQ.IX0P1)GOTO690 
      IX2=(IX0+IX1)/2
      IF(IX2.EQ.IX0)GOTO610
      IF(IX2.EQ.IX1)GOTO620
      X2=IX2
      CALL NBCDF(X2,PPAR,N,P2)
      IF(P0.LT.P2.AND.P2.LT.P1)GOTO630
      IF(P2.LE.P0)GOTO640
      IF(P2.GE.P1)GOTO650
  610 WRITE(IPR,249)
      WRITE(IPR,611)
      GOTO950
  620 WRITE(IPR,249)
      WRITE(IPR,611)
      GOTO950
  630 IF(P2.LE.P)GOTO635
      IX1=IX2
      P1=P2
      GOTO300
  635 IX0=IX2
      P0=P2
      GOTO300
  640 WRITE(IPR,249)
      WRITE(IPR,641)
      GOTO950
  650 WRITE(IPR,249)
      WRITE(IPR,651)
      GOTO950
  690 PPF=IX1
      IF(P0.EQ.P)PPF=IX0
      RETURN
C
  950 WRITE(IPR,240)IX0,P0
      WRITE(IPR,241)IX1,P1
      WRITE(IPR,242)IX2,P2
      WRITE(IPR,244)P
      WRITE(IPR,245)PPAR,N
      RETURN
C
  222 FORMAT(1H ,43HNO UPPER BOUND FOUND AFTER 10**7 ITERATIONS)
  240 FORMAT(1H ,7HIX0  = ,I8,10X,5HP0 = ,F14.7)
  241 FORMAT(1H ,7HIX1  = ,I8,10X,5HP1 = ,F14.7)
  242 FORMAT(1H ,7HIX2  = ,I8,10X,5HP2 = ,F14.7)
  244 FORMAT(1H ,7HP    = ,F14.7)
  245 FORMAT(1H ,7HPPAR = ,F14.7,10X,5HN  = ,I8)
  249 FORMAT(1H ,47H***** INTERNAL ERROR IN NBPPF  SUBROUTINE *****)
  262 FORMAT(1H ,43HNO LOWER BOUND FOUND AFTER 10**7 ITERATIONS)
  282 FORMAT(1H ,31HLOWER AND UPPER BOUND IDENTICAL)
  401 FORMAT(1H ,39HIMPOSSIBLE BRANCH CONDITION ENCOUNTERED)
  431 FORMAT(1H ,42HLOWER BOUND PROBABILITY (P0) GREATER THAN ,
     1 28HUPPER BOUND PROBABILITY (P1)) 
  441 FORMAT(1H ,42HLOWER BOUND PROBABILITY (P0) GREATER THAN ,
     1 21HINPUT PROBABILITY (P))
  451 FORMAT(1H ,42HUPPER BOUND PROBABILITY (P1) LESS    THAN ,
     1 21HINPUT PROBABILITY (P))
  611 FORMAT(1H ,39HBISECTION VALUE (X2) = LOWER BOUND (X0))
  621 FORMAT(1H ,39HBISECTION VALUE (X2) = UPPER BOUND (X1))
  641 FORMAT(1H ,33HBISECTION VALUE PROBABILITY (P2) ,
     1 38HLESS THAN LOWER BOUND PROBABILITY (P0)) 
  651 FORMAT(1H ,33HBISECTION VALUE PROBABILITY (P2) ,
     1 41HGREATER THAN UPPER BOUND PROBABILITY (P1))
C
      END 
      SUBROUTINE NBRAN(N,P,NPAR,ISTART,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT NBRAN
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE NEGATIVE BINOMIAL DISTRIBUTION
C              WITH SINGLE PRECISION 'BERNOULLI PROBABILITY'
C              PARAMETER = P, 
C              AND INTEGER 'NUMBER OF SUCCESSES IN BERNOULLI TRIALS'
C              PARAMETER = NPAR.
C              THE NEGATIVE BINOMIAL DISTRIBUTION USED
C              HEREIN HAS MEAN = NPAR*(1-P)/P
C              AND STANDARD DEVIATION = SQRT(NPAR*(1-P)/(P*P))).
C              THIS DISTRIBUTION IS DEFINED FOR
C              ALL NON-NEGATIVE INTEGER X--X = 0, 1, 2, ... .
C              THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION
C              F(X) = C(NPAR+X-1,NPAR) * P**NPAR * (1-P)**X.
C              WHERE C(NPAR+X-1,NPAR) IS THE COMBINATORIAL FUNCTION
C              EQUALING THE NUMBER OF COMBINATIONS OF NPAR+X-1 ITEMS
C              TAKEN NPAR AT A TIME.
C              THE NEGATIVE BINOMIAL DISTRIBUTION IS THE
C              DISTRIBUTION OF THE NUMBER OF FAILURES
C              BEFORE OBTAINING NPAR SUCCESSES IN AN
C              INDEFINITE SEQUENCE OF BERNOULLI (0,1)
C              TRIALS WHERE THE PROBABILITY OF SUCCESS
C              IN A SINGLE TRIAL = P.
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER 
C                                OF RANDOM NUMBERS TO BE
C                                GENERATED.
C                     --P      = THE SINGLE PRECISION VALUE 
C                                OF THE 'BERNOULLI PROBABILITY'
C                                PARAMETER FOR THE NEGATIVE BINOMIAL
C                                DISTRIBUTION.
C                                P SHOULD BE BETWEEN
C                                0.0 (EXCLUSIVELY) AND
C                                1.0 (EXCLUSIVELY).
C                     --NPAR   = THE INTEGER VALUE
C                                OF THE 'NUMBER OF SUCCESSES
C                                IN BERNOULLI TRIALS' PARAMETER.
C                                NPAR SHOULD BE A POSITIVE INTEGER.
C                     --ISTART = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL START THE
C                                GENERATOR OVER AND HENCE
C                                PRODUCE THE SAME RANDOM SAMPLE
C                                OVER AND OVER AGAIN
C                                UPON SUCCESSIVE CALLS TO
C                                THIS SUBROUTINE WITHIN A RUN; OR
C                                (IF SET TO SOME INTEGER
C                                VALUE NOT EQUAL TO 0,
C                                LIKE, SAY, 1) WILL ALLOW
C                                THE GENERATOR TO CONTINUE
C                                FROM WHERE IT STOPPED
C                                AND HENCE PRODUCE DIFFERENT
C                                RANDOM SAMPLES UPON
C                                SUCCESSIVE CALLS TO
C                                THIS SUBROUTINE WITHIN A RUN.
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 NEGATIVE BINOMIAL DISTRIBUTION
C             WITH 'BERNOULLI PROBABILITY' PARAMETER = P
C             AND 'NUMBER OF SUCCESSES IN BERNOULLI TRIALS' 
C             PARAMETER = NPAR.
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                 --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C                 --NPAR SHOULD BE A POSITIVE INTEGER.
C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN, BINRAN, GEORAN.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--NOTE THAT EVEN THOUGH THE OUTPUT
C              FROM THIS DISCRETE RANDOM NUMBER
C              GENERATOR MUST NECESSARILY BE A
C              SEQUENCE OF ***INTEGER*** VALUES,
C              THE OUTPUT VECTOR X IS SINGLE
C              PRECISION IN MODE.
C              X HAS BEEN SPECIFIED AS SINGLE
C              PRECISION SO AS TO CONFORM WITH THE DATAPAC
C              CONVENTION THAT ALL OUTPUT VECTORS FROM ALL
C              DATAPAC SUBROUTINES ARE SINGLE PRECISION.
C              THIS CONVENTION IS BASED ON THE BELIEF THAT
C              1) A MIXTURE OF MODES (FLOATING POINT
C              VERSUS INTEGER) IS INCONSISTENT AND
C              AN UNNECESSARY COMPLICATION
C              IN A DATA ANALYSIS; AND
C              2) FLOATING POINT MACHINE ARITHMETIC
C              (AS OPPOSED TO INTEGER ARITHMETIC) 
C              IS THE MORE NATURAL MODE FOR DOING 
C              DATA ANALYSIS. 
C     REFERENCES--HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGE 95.
C               --JOHNSON AND KOTZ, DISCRETE
C                 DISTRIBUTIONS, 1969, PAGES 122-142.
C               --FELLER, AN INTRODUCTION TO PROBABILITY
C                 THEORY AND ITS APPLICATIONS, VOLUME 1,
C                 EDITION 2, 1957, PAGES 155-157, 210.
C               --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 929.
C               --KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 130-131.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(P.LE.0.0.OR.P.GE.1.0)GOTO55
      IF(NPAR.LT.1)GOTO60
      GOTO90
   50 WRITE(IPR, 5) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,11) 
      WRITE(IPR,46)P
      RETURN
   60 WRITE(IPR,25) 
      WRITE(IPR,47)NPAR
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 BINRAN SUBROUTINE IS NON-POSITIVE *****)
   11 FORMAT(1H ,115H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 BINRAN SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 BINRAN SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      CALL UNIRAN(1,ISTART,G) 
C
C     CHECK ON THE MAGNITUDE OF P,
C     AND BRANCH TO THE FASTER
C     GENERATION METHOD ACCORDINGLY.
C
      IF(P.LT.0.1)GOTO450
C
C     IF P IS MODERATE OR LARGE,
C     GENERATE N NEGATIVE BINOMIAL NUMBERS
C     USING THE FACT THAT THE 
C     WAITING TIME FOR NPAR SUCCESSES IN
C     BERNOULLI TRIALS HAS A
C     NEGATIVE BINOMIAL DISTRIBUTION.
C
      DO100I=1,N
      ISUM=0
      J=1 
  150 CALL BINRAN(1,P,1,1,B)
      IB=B+0.5
      ISUM=ISUM+IB
      IF(ISUM.EQ.NPAR)GOTO250 
      J=J+1
      GOTO150
  250 X(I)=J
  100 CONTINUE
      RETURN
C
C     IF P IS SMALL,
C     GENERATE N NEGATIVE BINOMIAL NUMBERS
C     BY USING THE FACT THAT THE SUM
C     OF GEOMETRIC VARIATES IS A
C     NEGATIVE BINOMIAL VARIATE.
C
  450 DO500I=1,N
      ISUM=0
      DO600J=1,NPAR 
      CALL GEORAN(1,P,1,G)
      IG=G+0.5
      ISUM=ISUM+IG
  600 CONTINUE
      X(I)=ISUM
  500 CONTINUE
      RETURN
C
      END 
      SUBROUTINE NORCDF(X,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT NORCDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE FOR THE NORMAL (GAUSSIAN)
C              DISTRIBUTION WITH MEAN = 0 AND STANDARD DEVIATION = 1. 
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = (1/SQRT(2*PI))*EXP(-X*X/2). 
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--EXP.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 932, FORMULA 26.2.17.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 40-111.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DATA B1,B2,B3,B4,B5,P/.319381530,-0.356563782,1.781477937,-1.82125
     15978,1.330274429,.2316419/
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS.
C     NO INPUT ARGUMENT ERRORS POSSIBLE 
C     FOR THIS DISTRIBUTION.
C
C-----START POINT-----------------------------------------------------
C
      Z=X 
      IF(X.LT.0.0)Z=-Z
      T=1.0/(1.0+P*Z)
      CDF=1.0-((0.39894228040143  )*EXP(-0.5*Z*Z))*(B1*T+B2*T**2+B3*T**3
     1+B4*T**4+B5*T**5)
      IF(X.LT.0.0)CDF=1.0-CDF 
C
      RETURN
      END 
      SUBROUTINE NOROUT(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT NOROUT
C
C     PURPOSE--THIS SUBROUTINE PERFORMS A NORMAL OUTLIER ANALYSIS
C              ON THE DATA IN THE INPUT VECTOR X. 
C              THIS ANALYSIS CONSISTS OF--
C              1) VARIOUS NORMAL OUTLIER STATISTICS;
C              2) VARIOUS PARTIAL SAMPLE MEANS
C              3) VARIOUS PARTIAL SAMPLE STANDARD DEVIATIONS;
C              4) THE FIRST 40 AND LAST 40 ORDERED OBSERVATIONS;
C              5) A LINE PLOT; AND
C              6) A NORMAL PROBABILITY PLOT.
C              WHEN THE FIRST 40 AND LAST 40 ORDERED OBSERVATIONS
C              ARE PRINTED OUT, ALSO INCLUDED FOR EACH
C              OF THE 40+40 = 80 LISTED DATA VALUES
C              IS THE CORRESPONDING RESIDUAL ABOUT
C              THE (FULL) SAMPLE MEAN,
C              THE STANDARDIZED RESIDUAL,
C              THE NORMAL N(0,1) VALUE FOR THE STANDARDIZED 
C              RESIDUAL,
C              AND THE POSITION NUMBER
C              IN THE ORIGINAL DATA VECTOR X.
C              THIS LAST PIECE OF INFORMATION ALLOWS
C              THE DATA ANALYST TO EASILY LOCATE
C              BACK IN THE ORIGINAL DATA VECTOR . 
C              A SUSPECTED OUTLIER OR OTHERWISE
C              INTERESTING OBSERVATION. 
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--4 PAGES OF AUTOMATIC PRINTOUT--
C             1) VARIOUS NORMAL OUTLIER STATISTICS;
C             2) VARIOUS PARTIAL SAMPLE MEANS
C             3) VARIOUS PARTIAL SAMPLE STANDARD DEVIATIONS;
C             4) THE FIRST 40 AND LAST 40 ORDERED OBSERVATIONS;
C             5) A LINE PLOT; AND
C             6) A NORMAL PROBABILITY PLOT.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORTP, NORCDF, NORPLT,
C                                         SORT, UNIMED, NORPPF, PLOT. 
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     WRITE OUT THE FIRST 40 AND LAST 40 ORDERED OBSERVATIONS,
C     INCLUDING THEIR RESIDUALS ABOUT THE (FULL) SAMPLE MEAN,
C     THE STANDARDIZED RESIDUALS,
C     THE NORMAL N(0,1) CUMULATIVE DISTRIBUTION FUNCTION VALUE
C     OF THE STANDARDIZED RESIDUAL, AND 
C     THE POSITION NUMBER IN THE ORIGINAL DATA VECTOR X.
C     REFERENCES--GRUBBS, TECHNOMETRICS, 1969, PAGES 1-21
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX
      CHARACTER*4 ILINE1
      CHARACTER*4 ILINE2
C
      DIMENSION X(1)
      DIMENSION Y(7500),XPOS(7500)
      DIMENSION ILINE1(130),ILINE2(130) 
      DIMENSION XLINE(13)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(XPOS(1),WS(7501)) 
C
      DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/
C
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      RETURN
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE NOROUT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 NOROUT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE NOROUT SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      NM1=N-1
      NM2=N-2
      NM3=N-3
      NM4=N-4
      NM5=N-5
      AN=N
      ANM1=NM1
      ANM2=NM2
      ANM3=NM3
      ANM4=NM4
      ANM5=NM5
C
C     SORT THE DATA AND ALSO CARRY ALONG THE OBSERVATION NUMBER--THAT IS,
C     THE  POSITION IN THE ORIGINAL DATA SET OF THE I-TH ORDER STATISTIC
C
      CALL SORTP(X,N,Y,XPOS)
C
C     COMPUTE PARTIAL SAMPLE MEANS
C
      SUM=0.0
      DO100I=3,NM2
      SUM=SUM+Y(I)
  100 CONTINUE
      XB23=SUM/ANM4 
      XB13=(SUM+Y(2))/ANM3
      XB24=(SUM+Y(NM1))/ANM3
      XB3=(SUM+Y(1)+Y(2))/ANM2
      XB2=(SUM+Y(NM1)+Y(N))/ANM2
      XB14=(SUM+Y(2)+Y(NM1))/ANM2
      XB4=(SUM+Y(1)+Y(2)+Y(NM1))/ANM1
      XB1=(SUM+Y(2)+Y(NM1)+Y(N))/ANM1
      XB=(SUM+Y(1)+Y(2)+Y(NM1)+Y(N))/AN 
C
C     COMPUTE PARTIAL SUMS OF SQUARED DEVIATIONS
C     ABOUT THE PARTIAL SAMPLE MEANS
C
      SSQ=0.0
      SSQ1=0.0
      SSQ4=0.0
      SSQ14=0.0
      SSQ2=0.0
      SSQ3=0.0
      SSQ24=0.0
      SSQ13=0.0
      SSQ23=0.0
      DO210I=1,N
      SSQ=SSQ+(Y(I)-XB)**2
  210 CONTINUE
      DO220I=2,N
      SSQ1=SSQ1+(Y(I)-XB1)**2 
  220 CONTINUE
      DO230I=1,NM1
      SSQ4=SSQ4+(Y(I)-XB4)**2 
  230 CONTINUE
      DO240I=2,NM1
      SSQ14=SSQ14+(Y(I)-XB14)**2
  240 CONTINUE
      DO250I=3,N
      SSQ2=SSQ2+(Y(I)-XB2)**2 
  250 CONTINUE
      DO260I=1,NM2
      SSQ3=SSQ3+(Y(I)-XB3)**2 
  260 CONTINUE
      DO270I=3,NM1
      SSQ24=SSQ24+(Y(I)-XB24)**2
  270 CONTINUE
      DO280I=2,NM2
      SSQ13=SSQ13+(Y(I)-XB13)**2
  280 CONTINUE
      DO290I=3,NM2
      SSQ23=SSQ23+(Y(I)-XB23)**2
  290 CONTINUE
C
C     COMPUTE PARTIAL SAMPLE STANDARD DEVIATIONS
C
      S=SQRT(SSQ/ANM1)
      S1=SQRT(SSQ1/ANM2)
      S4=SQRT(SSQ4/ANM2)
      S14=SQRT(SSQ14/ANM3)
      S2=SQRT(SSQ2/ANM3)
      S3=SQRT(SSQ3/ANM3)
      S24=SQRT(SSQ24/ANM4)
      S13=SQRT(SSQ13/ANM4)
      S23=SQRT(SSQ23/ANM5)
C
C     COMPUTE OUTLIER STATISTICS
C     OMIT NO OBSERVATIONS, TEST FOR X(1)
      ST1=(XB-Y(1))/S
C     OMIT NO OBSERVATIONS, TEST FOR X(N)
      ST2=(Y(N)-XB)/S
C     OMIT NO OBSERVATIONS, TEST FOR X(1) AND X(N) SIMULTANEOUSLY
      ST3=(Y(N)-Y(1))/S
C     OMIT X(1), TEST FOR X(2)
      ST4=SSQ2/SSQ
C     OMIT X(N), TEST FOR X(N-1)
      ST5=SSQ3/SSQ
C     OMIT X(1) AND X(N), TEST FOR X(2) 
      ST6=(XB14-Y(2))/S14
C     OMIT X(1) AND X(N), TEST FOR X(N-1)
      ST7=(Y(NM1)-XB14)/S14
C     OMIT X(1) AND X(N), TEST FOR X(2) AND X(N-1)
      ST8=(Y(NM1)-Y(2))/S14
      SUM4=0.0
      DO300I=2,NM2
      SUM4=SUM4+(Y(I)-XB14)**4
  300 CONTINUE
      ST9=(AN-2.0)*SUM4/(SSQ14**2)
      ST9=ST9+3.0
C
C     COMPUTE THE LINE PLOT WHICH SHOWS THE DISTRIBUTION OF THE OBSERVED
C     VALUES IN TERMS OF MULTIPLES OF SAMPLE STANDARD DEVIATIONS AWAY FROM
C     THE SAMPLE MEAN
C
      DO1000I=1,130 
      ILINE1(I)=BLANK
      ILINE2(I)=BLANK
 1000 CONTINUE
      ICOUNT=0
      DO1100I=1,N
      MX=10.0*(((X(I)-XB  )/S)+6.0)+0.5 
      MX=MX+7
      IF(MX.LT. 7.OR.MX.GT.127)ICOUNT=ICOUNT+1
      IF(MX.LT. 7.OR.MX.GT.127)GOTO1100 
      ILINE1(MX)=ALPHAX
 1100 CONTINUE
      DO1200I=7,127 
      ILINE2(I)=HYPHEN
 1200 CONTINUE
      DO1300I=7,127,10
      ILINE2(I)=ALPHAI
 1300 CONTINUE
      XLINE(7)=XB
      DO1400I=1,6
      IREV=13-I+1
      AI=I
      XLINE(I)=XB  -(7.0-AI)*S
      XLINE(IREV)=XB  +(7.0-AI)*S
 1400 CONTINUE
C
C     WRITE EVERYTHING OUT
C
C     WRITE OUT THE OUTLIER STATISTICS
C
      WRITE(IPR,998)
      WRITE(IPR,3010)
      WRITE(IPR,999)
      WRITE(IPR,3020)N
      WRITE(IPR,999)
      WRITE(IPR,3023)
      DO3025I=1,6
      WRITE(IPR,999)
 3025 CONTINUE
      WRITE(IPR,3030)
      WRITE(IPR,999)
      WRITE(IPR,999)
      WRITE(IPR,3040)
      WRITE(IPR,3041)
      WRITE(IPR,999)
      WRITE(IPR,3051)ST1,N
      WRITE(IPR,3052)ST2,N
      WRITE(IPR,3053)ST3,N
      WRITE(IPR,3054)ST4,N
      WRITE(IPR,3055)ST5,N
      WRITE(IPR,3056)ST6,NM2
      WRITE(IPR,3057)ST7,NM2
      WRITE(IPR,3058)ST8,NM2
      WRITE(IPR,3059)ST9,NM2
      DO3070I=1,10
      WRITE(IPR,999)
 3070 CONTINUE
C
C     WRITE OUT THE PARTIAL SAMPLE MEANS
C     AND THE PARTIAL SAMPLE STANDARD DEVIATIONS. 
C
      WRITE(IPR,3110)
      WRITE(IPR,999)
      WRITE(IPR,999)
      WRITE(IPR,3120)
      WRITE(IPR,3121)
      WRITE(IPR,999)
      WRITE(IPR,3131)XB  ,S
      WRITE(IPR,3132)XB1 ,S1
      WRITE(IPR,3133)XB4 ,S4
      WRITE(IPR,3134)XB14,S14 
      WRITE(IPR,3135)XB2,S2
      WRITE(IPR,3136)XB3,S3
      WRITE(IPR,3137)XB24,S24 
      WRITE(IPR,3138)XB13,S13 
      WRITE(IPR,3139)XB23,S23 
C
C     WRITE OUT THE FIRST 40 AND LAST 40 ORDERED OBSERVATIONS,
C     INCLUDING THEIR RESIDUALS ABOUT THE (FULL) SAMPLE MEAN,
C     THE STANDARDIZED RESIDUALS,
C     THE NORMAL N(0,1) CUMULATIVE DISTRIBUTION FUNCTION VALUE
C     OF THE STANDARDIZED RESIDUAL, AND 
C     THE POSITION NUMBER IN THE ORIGINAL DATA VECTOR X.
C
      WRITE(IPR,998)
      WRITE(IPR,3210)
      WRITE(IPR,999)
      WRITE(IPR,999)
      WRITE(IPR,3220)
      WRITE(IPR,3221)
      WRITE(IPR,3222)
      WRITE(IPR,3223)
      WRITE(IPR,999)
      IF(N.LE.80)GOTO3225
      DO3226I=1,80
      IF(I.LE.40)J=I
      IF(I.GE.41)J=I+N-80
      RES=Y(J)-XB
      STRES=RES/S
      CALL NORCDF(STRES,CDF)
      WRITE(IPR,3231)J,Y(J),RES,STRES,CDF,XPOS(J) 
      IFLAG=I-(I/10)*10
      IF(IFLAG.EQ.0)WRITE(IPR,999)
 3226 CONTINUE
      GOTO3227
 3225 DO3230I=1,N
      RES=Y(I)-XB
      STRES=RES/S
      CALL NORCDF(STRES,CDF)
      WRITE(IPR,3231)I,Y(I),RES,STRES,CDF,XPOS(I) 
      IFLAG=I-(I/10)*10
      IF(IFLAG.EQ.0)WRITE(IPR,999)
 3230 CONTINUE
 3227 DO3240I=1,10
      WRITE(IPR,999)
 3240 CONTINUE
C
C     WRITE OUT THE LINE PLOT SHOWING THE DEVIATIONS
C     OF THE OBSERVATIONS ABOUT THE (FULL) SAMPLE MEAN
C     IN TERMS OF MULTIPLES OF THE (FULL) SAMPLE STANDARD
C     DEVIATION.
C
      WRITE(IPR,3310)
      WRITE(IPR,999)
      WRITE(IPR,999)
      WRITE(IPR,3321)(ILINE1(I),I=1,130)
      WRITE(IPR,3321)(ILINE2(I),I=1,130)
      WRITE(IPR,3323)
      WRITE(IPR,3326)(XLINE(I),I=1,13)
      WRITE(IPR,999)
      WRITE(IPR,3324)ICOUNT
C
C     WRITE OUT A NORMAL PROBABILITY PLOT
C
      CALL NORPLT(Y,N)
C
  998 FORMAT(1H1)
  999 FORMAT(1H )
 3010 FORMAT(1H ,48X,23HNORMAL OUTLIER ANALYSIS)
 3020 FORMAT(1H ,46X,21H(THE SAMPLE SIZE N = ,I5,1H))
 3023 FORMAT(1H ,39X,50HREFERENCE--GRUBBS, TECHNOMETRICS, 1969, PAGES 1-
     121) 
 3030 FORMAT(1H ,49X,18HOUTLIER STATISTICS)
 3040 FORMAT(1H ,114H    OMIT             TEST                    FORM
     1                VALUE       PSEUDO-SAMPLE SIZE            TABLE)
 3041 FORMAT(1H ,116HAS AN OUTLIER    AS AN OUTLIER           OF STATIST
     1IC           OF STATISTIC   FOR TABLE LOOK-UP           REFERENCE)
 3051 FORMAT(1H ,65H    NONE             X(1)              (XBAR - X(1))
     1/S           ,F8.4,15H           N = ,I5,31H     GRUBBS, TECH., 19
     169, P.  4)
 3052 FORMAT(1H ,65H    NONE             X(N)              (X(N) - XBAR)
     1/S           ,F8.4,15H           N = ,I5,31H     GRUBBS, TECH., 19
     169, P.  4)
 3053 FORMAT(1H ,65H    NONE         X(1) AND X(N)             RANGE/S
     1             ,F8.4,15H           N = ,I5,31H     GRUBBS, TECH., 19
     169, P.  8)
 3054 FORMAT(1H ,65H    X(1)             X(2)               SSQD(1,2)/SS
     1QD           ,F8.4,15H           N = ,I5,31H     GRUBBS, TECH., 19
     169, P. 11)
 3055 FORMAT(1H ,65H    X(N)            X(N-1)             SSQD(N-1,N)/S
     1SQD          ,F8.4,15H           N = ,I5,31H     GRUBBS, TECH., 19
     169, P. 11)
 3056 FORMAT(1H ,65HX(1) AND X(N)        X(2)          (XBAR(1,N) - X(2)
     1)/S(1,N)     ,F8.4,15H         N-2 = ,I5,31H     GRUBBS, TECH., 19
     169, P.  4)
 3057 FORMAT(1H ,65HX(1) AND X(N)       X(N-1)        (X(N-1) - XBAR(1,N
     1))/S(1,N)    ,F8.4,15H         N-2 = ,I5,31H     GRUBBS, TECH., 19
     169, P.  4)
 3058 FORMAT(1H ,65HX(1) AND X(N)   X(2) AND X(N-1)       RANGE(1,N)/S(1
     1,N)          ,F8.4,15H         N-2 = ,I5,31H     GRUBBS, TECH., 19
     169, P.  8)
 3059 FORMAT(1H ,65HX(1) AND X(N)   X(2) AND X(N-1)      SAMPLE KURTOSIS
     1(1,N)        ,F8.4,15H         N-2 = ,I5,31H     GRUBBS, TECH., 19
     169, P. 14)
 3110 FORMAT(1H ,30X,59HPARTIAL SAMPLE MEANS AND PARTIAL SAMPLE STANDARD
     1 DEVIATIONS)
 3120 FORMAT(1H ,65H            OMIT               PARTIAL SAMPLE      P
     1ARTIAL SAMPLE)
 3121 FORMAT(1H ,67H        AS AN OUTLIER               MEAN         STA
     1NDARD DEVIATION)
 3131 FORMAT(1H ,29H            NONE             ,E15.8,5X,E15.8)
 3132 FORMAT(1H ,29H            X(1)             ,E15.8,5X,E15.8)
 3133 FORMAT(1H ,29H            X(N)             ,E15.8,5X,E15.8)
 3134 FORMAT(1H ,29H       X(1) AND X(N)         ,E15.8,5X,E15.8)
 3135 FORMAT(1H ,29H       X(1) AND X(2)         ,E15.8,5X,E15.8)
 3136 FORMAT(1H ,29H      X(N-1) AND X(N)        ,E15.8,5X,E15.8)
 3137 FORMAT(1H ,29H    X(1), X(2), AND X(N)     ,E15.8,5X,E15.8)
 3138 FORMAT(1H ,29H   X(1), X(N-1), AND X(N)    ,E15.8,5X,E15.8)
 3139 FORMAT(1H ,29HX(1), X(2), X(N-1), AND X(N) ,E15.8,5X,E15.8)
 3210 FORMAT(1H ,130HORDER STATISTICS, RESIDUALS ABOUT THE SAMPLE MEAN,
     1STANDARDIZED RESIDUALS, AND NORMAL(0,1) CUMULATIVE DISTRIBUTION FU
     1NCTION VALUES)
 3220 FORMAT(1H ,95H  INDEX       ORDERED        RESIDUALS        STANDA
     1RDIZED       NORMAL(0,1)        OBSERVATION)
 3221 FORMAT(1H ,92H            OBSERVATIONS     ABOUT THE         RESID
     1UALS      CDF VALUES OF THE       NUMBER)
 3222 FORMAT(1H ,76H                            SAMPLE MEAN 
     1            STANDARDIZED)
 3223 FORMAT(1H ,74H
     1             RESIDUALS) 
 3231 FORMAT(1H ,I5,4X,E15.8,1X,E15.8,7X,F7.2,11X,F8.5,11X,F7.0)
 3310 FORMAT(1H ,131HLINE PLOT SHOWING THE DISTRIBUTION OF THE OBSERVATI
     1ONS ABOUT THE SAMPLE MEAN IN TERMS OF MULTIPLES OF THE SAMPLE STAN
     1DARD DEVIATION)
 3321 FORMAT(1H ,130A1)
 3323 FORMAT(1H ,   127H     -6        -5        -4        -3        -2
     1       -1         0         1         2         3         4
     1  5         6)
 3324 FORMAT(1H ,10X,I5,105H OBSERVATIONS WERE IN EXCESS OF 6 SAMPLE STA
     1NDARD DEVIATIONS FROM THE SAMPLE MEAN AND SO WERE NOT PLOTTED)
 3326 FORMAT(1H ,13F10.4)
C
      RETURN
      END 
      SUBROUTINE NORPDF(X,PDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT NORPDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY
C              FUNCTION VALUE FOR THE NORMAL (GAUSSIAN)
C              DISTRIBUTION WITH MEAN = 0 AND STANDARD DEVIATION = 1. 
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = (1/SQRT(2*PI))*EXP(-X*X/2). 
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--EXP.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 40-111.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DATA C/.3989422804/
C
      IPR=6
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*EXP(-(X*X)/2.0)
C
      RETURN
      END 
      SUBROUTINE NORPLT(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT NORPLT
C
C     PURPOSE--THIS SUBROUTINE GENERATES A NORMAL (GAUSSIAN)
C              PROBABILITY PLOT.
C              THE PROTOTYPE NORMAL DISTRIBUTION USED HEREIN
C              HAS MEAN = 0 AND STANDARD DEVIATION = 1.
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = (1/SQRT(2*PI)) * EXP(-X*X/2).
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 NORMAL 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 NORMAL 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--A ONE-PAGE NORMAL PROBABILITY PLOT. 
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, NORPPF, PLOT. 
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
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               --FILLIBEN, 'THE PROBABILITY PLOT CORRELATION COEFFICIENT
C                 TEST FOR NORMALITY', TECHNOMETRICS, 1975, PAGES 111-117.
C               --RYAN AND JOINER, 'NORMAL PROBABILITY PLOTS AND TESTS
C                 FOR NORMALITY'  PENNSYLVANIA
C                 STATE UNIVERSITY REPORT.
C               --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING,
C                 1967, PAGES 260-308.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 40-111.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(7500),W(7500)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501))
C
      DATA TAU/1.43218641/
C
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE NORPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 NORPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE NORPLT SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     SORT THE DATA 
C
      CALL SORT(X,N,Y)
C
C     GENERATE UNIFORM ORDER STATISTIC MEDIANS
C
      CALL UNIMED(N,W)
C
C     COMPUTE NORMAL ORDER STATISTIC MEDIANS
C
      DO100I=1,N
      CALL NORPPF(W(I),W(I))
  100 CONTINUE
C
C     PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS.
C     WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION 
C     AND THE SAMPLE SIZE.
C
      CALL PLOT(Y,W,N)
      WRITE(IPR,105)TAU,N
C
C     COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. 
C     COMPUTE LOCATION AND SCALE ESTIMATES
C     FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. 
C     THEN WRITE THEM OUT.
C
      SUM1=0.0
      DO200I=1,N
      SUM1=SUM1+Y(I)
  200 CONTINUE
      YBAR=SUM1/AN
      WBAR=0.0
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO300I=1,N
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) 
      SUM2=SUM2+W(I)*Y(I)
      SUM3=SUM3+W(I)*W(I)
  300 CONTINUE
      CC=SUM2/SQRT(SUM3*SUM1) 
      YSLOPE=SUM2/SUM3
      YINT=YBAR-YSLOPE*WBAR
      WRITE(IPR,305)CC,YINT,YSLOPE
C
  105 FORMAT(1H ,31HNORMAL PROBABILITY PLOT (TAU = ,E15.8,1H),56X,20HTHE
     1 SAMPLE SIZE N = ,I7)
  305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X,
     122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) 
C
      RETURN
      END 
      SUBROUTINE NORPPF(P,PPF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT NORPPF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE FOR THE NORMAL (GAUSSIAN)
C              DISTRIBUTION WITH MEAN = 0 AND STANDARD DEVIATION = 1. 
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = (1/SQRT(2*PI))*EXP(-X*X/2). 
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--SQRT, ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--ODEH AND EVANS, THE PERCENTAGE POINTS
C                 OF THE NORMAL DISTRIBUTION, ALGORTIHM 70, 
C                 APPLIED STATISTICS, 1974, PAGES 96-97.
C               --EVANS, ALGORITHMS FOR MINIMAL DEGREE
C                 POLYNOMIAL AND RATIONAL APPROXIMATION,
C                 M. SC. THESIS, 1972, UNIVERSITY 
C                 OF VICTORIA, B. C., CANADA.
C               --HASTINGS, APPROXIMATIONS FOR DIGITAL
C                 COMPUTERS, 1955, PAGES 113, 191, 192.
C               --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 933, FORMULA 26.2.23.
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, 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 40-111.
C               --THE KELLEY STATISTICAL TABLES, 1948.
C               --OWEN, HANDBOOK OF STATISTICAL TABLES,
C                 1962, PAGES 3-16.
C               --PEARSON AND HARTLEY, BIOMETRIKA TABLES
C                 FOR STATISTICIANS, VOLUME 1, 1954,
C                 PAGES 104-113.
C     COMMENTS--THE CODING AS PRESENTED BELOW
C               IS ESSENTIALLY IDENTICAL TO THAT
C               PRESENTED BY ODEH AND EVANS
C               AS ALGORTIHM 70 OF APPLIED STATISTICS.
C               THE PRESENT AUTHOR HAS MODIFIED THE
C               ORIGINAL ODEH AND EVANS CODE WITH ONLY
C               MINOR STYLISTIC CHANGES.
C             --AS POINTED OUT BY ODEH AND EVANS
C               IN APPLIED STATISTICS,
C               THEIR ALGORITHM REPRESENTES A
C               SUBSTANTIAL IMPROVEMENT OVER THE
C               PREVIOUSLY EMPLOYED
C               HASTINGS APPROXIMATION FOR THE
C               NORMAL PERCENT POINT FUNCTION--
C               THE ACCURACY OF APPROXIMATION
C               BEING IMPROVED FROM 4.5*(10**-4)
C               TO 1.5*(10**-8).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --OCTOBER   1976. 
C
C---------------------------------------------------------------------
C
      DATA P0,P1,P2,P3,P4
     1/-.322232431088,-1.0,
     1 -.342242088547,-.204231210245E-1,
     1 -.453642210148E-4/
      DATA Q0,Q1,Q2,Q3,Q4
     1/.993484626060E-1,.588581570495,
     1 .531103462366,.103537752850,
     1 .38560700634E-2/
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LE.0.0.OR.P.GE.1.0)GOTO50
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 NORPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      IF(P.NE.0.5)GOTO150
      PPF=0.0
      RETURN
C
  150 R=P 
      IF(P.GT.0.5)R=1.0-R
      T=SQRT(-2.0*ALOG(R))
      ANUM=((((T*P4+P3)*T+P2)*T+P1)*T+P0)
      ADEN=((((T*Q4+Q3)*T+Q2)*T+Q1)*T+Q0)
      PPF=T+(ANUM/ADEN)
      IF(P.LT.0.5)PPF=-PPF
      RETURN
C
      END 
      SUBROUTINE NORRAN(N,ISEED,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT NORRAN
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE THE NORMAL (GAUSSIAN)
C              DISTRIBUTION WITH MEAN = 0 AND STANDARD DEVIATION = 1.
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = (1/SQRT(2*PI))*EXP(-X*X/2).
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             FROM THE NORMAL DISTRIBUTION
C             WITH MEAN = 0 AND STANDARD DEVIATION = 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--ALOG, SQRT, SIN, COS.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     METHOD--BOX-MULLER ALGORITHM.
C     REFERENCES--BOX AND MULLER, 'A NOTE ON THE GENERATION
C                 OF RANDOM NORMAL DEVIATES', JOURNAL OF THE
C                 ASSOCIATION FOR COMPUTING MACHINERY, 1958,
C                 PAGES 610-611.
C               --TOCHER, THE ART OF SIMULATION,
C                 1963, PAGES 33-34.
C               --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS,
C                 1964, PAGE 39.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 40-111.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82.6
C     ORIGINAL VERSION--JUNE      1972.
C     UPDATED         --SEPTEMBER 1975.
C     UPDATED         --NOVEMBER  1975.
C     UPDATED         --JULY      1976.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
      DIMENSION Y(2)
C
C---------------------------------------------------------------------
C
CCCCC CHARACTER*4 IFEEDB
CCCCC CHARACTER*4 IPRINT
C
CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
CCCCC COMMON /PRINT/IFEEDB,IPRINT
C
      IPR=6
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(IPR, 5)
      WRITE(IPR,47)N
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 NORRAN SUBROUTINE IS NON-POSITIVE *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
C     THEN GENERATE 2 ADDITIONAL UNIFORM (0,1) RANDOM NUMBERS
C     (TO BE USED BELOW IN FORMING THE N-TH NORMAL
C     RANDOM NUMBER WHEN THE DESIRED SAMPLE SIZE N
C     HAPPENS TO BE ODD).
C
      CALL UNIRAN(N,ISEED,X)
      CALL UNIRAN(2,ISEED,Y)
C
C     GENERATE N NORMAL RANDOM NUMBERS
C     USING THE BOX-MULLER METHOD.
C
      DO200I=1,N,2
      IP1=I+1
      U1=X(I)
      IF(I.EQ.N)GOTO210
      U2=X(IP1)
      GOTO220
  210 U2=Y(2)
  220 ARG1=-2.0*ALOG(U1)
      ARG2=2.0*PI*U2
      SQRT1=SQRT(ARG1)
      Z1=SQRT1*COS(ARG2)
      Z2=SQRT1*SIN(ARG2)
      X(I)=Z1
      IF(I.EQ.N)GOTO200
      X(IP1)=Z2
  200 CONTINUE
C
      RETURN
      END
      SUBROUTINE NORSF(P,SF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT NORSF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE SPARSITY
C              FUNCTION VALUE FOR THE NORMAL (GAUSSIAN)
C              DISTRIBUTION WITH MEAN = 0 AND STANDARD DEVIATION = 1. 
C              THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = (1/SQRT(2*PI))*EXP(-X*X/2). 
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--NORPPF. 
C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
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 40-111.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DATA C/.3989422804/
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LE.0.0.OR.P.GE.1.0)GOTO50
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 NORSF  SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      CALL NORPPF(P,PPF)
      PDF=C*EXP(-(PPF*PPF)/2.0)
      SF=1.0/PDF
C
      RETURN
      END 
      SUBROUTINE PARCDF(X,GAMMA,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PARCDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE FOR THE PARETO
C              DISTRIBUTION WITH SINGLE PRECISION 
C              TAIL LENGTH PARAMETER = GAMMA.
C              THE PARETO DISTRIBUTION USED
C              HEREIN IS DEFINED FOR ALL X GREATER THAN
C              OR EQUAL TO 1, 
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = GAMMA / (X**(GAMMA+1)).
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE 
C                                AT WHICH THE CUMULATIVE DISTRIBUTION 
C                                FUNCTION IS TO BE EVALUATED.
C                                X SHOULD BE GREATER THAN
C                                OR EQUAL TO 1.
C                     --GAMMA  = THE SINGLE PRECISION VALUE 
C                                OF THE TAIL LENGTH PARAMETER.
C                                GAMMA 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 PARETO
C             DISTRIBUTION WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--GAMMA SHOULD BE POSITIVE.
C                 --X SHOULD BE GREATER THAN
C                   OR EQUAL TO 1.
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 233-249.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGE 102.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(X.LT.1.0)GOTO50
      IF(GAMMA.LE.0.0)GOTO55
      GOTO90
   50 WRITE(IPR,4)
      WRITE(IPR,46)X
      CDF=0.0
      RETURN
   55 WRITE(IPR,15) 
      WRITE(IPR,46)GAMMA
      CDF=0.0
      RETURN
   90 CONTINUE
    4 FORMAT(1H ,101H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE PARCDF SUBROUTINE IS LESS THAN 1.0 *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 PARCDF SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      CDF=1.0-(X**(-GAMMA))
C
      RETURN
      END 
      SUBROUTINE PARPLT(X,N,GAMMA)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PARPLT
C
C     PURPOSE--THIS SUBROUTINE GENERATES A PARETO 
C              PROBABILITY PLOT
C              (WITH TAIL LENGTH PARAMETER VALUE = GAMMA).
C              THE PROTOTYPE PARETO DISTRIBUTION USED
C              HEREIN IS DEFINED FOR ALL X EQUAL TO
C              OR GREATER THAN 1,
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = GAMMA / (X**(GAMMA+1)).
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 PARETO 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  PARETO DISTRIBUTION
C              WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
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                     --GAMMA  = THE SINGLE PRECISION VALUE OF THE
C                                TAIL LENGTH PARAMETER.
C                                GAMMA SHOULD BE POSITIVE.
C     OUTPUT--A ONE-PAGE PARETO PROBABILITY PLOT. 
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C                 --GAMMA SHOULD BE POSITIVE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, PLOT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
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 233-249.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(7500),W(7500)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501))
C
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      IF(GAMMA.LE.0.0)GOTO60
      HOLD=X(1)
      DO65I=2,N
      IF(X(I).NE.HOLD)GOTO90
   65 CONTINUE
      WRITE(IPR, 9)HOLD
      RETURN
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   60 WRITE(IPR,25) 
      WRITE(IPR,46)GAMMA
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE PARPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 PARPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE PARPLT SUBROUTINE HAS THE VALUE 1 *****)
   25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 PARPLT SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     SORT THE DATA 
C
      CALL SORT(X,N,Y)
C
C     GENERATE UNIFORM ORDER STATISTIC MEDIANS
C
      CALL UNIMED(N,W)
C
C     COMPUTE PARETO DISTRIBUTION ORDER STATISTIC MEDIANS
C
      DO100I=1,N
      W(I)=(1.0-W(I))**(-1.0/GAMMA)
  100 CONTINUE
C
C     PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS.
C     COMPUTE THE TAIL LENGTH MEASURE OF THE DISTRIBUTION.
C     WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION 
C     AND THE SAMPLE SIZE.
C
      CALL PLOT(Y,W,N)
      Q=.9975
      PP9975=(1.0-Q)**(-1.0/GAMMA)
      Q=.0025
      PP0025=(1.0-Q)**(-1.0/GAMMA)
      Q=.975
      PP975 =(1.0-Q)**(-1.0/GAMMA)
      Q=.025
      PP025 =(1.0-Q)**(-1.0/GAMMA)
      TAU=(PP9975-PP0025)/(PP975-PP025) 
      WRITE(IPR,105)GAMMA,TAU,N
C
C     COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. 
C     COMPUTE LOCATION AND SCALE ESTIMATES
C     FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. 
C     THEN WRITE THEM OUT.
C
      SUM1=0.0
      SUM2=0.0
      DO200I=1,N
      SUM1=SUM1+Y(I)
      SUM2=SUM2+W(I)
  200 CONTINUE
      YBAR=SUM1/AN
      WBAR=SUM2/AN
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO300I=1,N
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) 
      SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) 
      SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 
  300 CONTINUE
      CC=SUM2/SQRT(SUM3*SUM1) 
      YSLOPE=SUM2/SUM3
      YINT=YBAR-YSLOPE*WBAR
      WRITE(IPR,305)CC,YINT,YSLOPE
C
  105 FORMAT(1H ,50HPARETO PROBABILITY PLOT WITH EXPONENT PARAMETER = ,
     1E17.10,1X,7H(TAU = ,E15.8,1H),11X,20HTHE SAMPLE SIZE N = ,I7)
  305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X,
     122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) 
C
      RETURN
      END 
      SUBROUTINE PARPPF(P,GAMMA,PPF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PARPPF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE FOR THE PARETO
C              DISTRIBUTION WITH SINGLE PRECISION 
C              TAIL LENGTH PARAMETER = GAMMA.
C              THE PARETO DISTRIBUTION USED
C              HEREIN IS DEFINED FOR ALL X GREATER THAN
C              OR EQUAL TO 1, 
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = GAMMA / (X**(GAMMA+1)).
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                     --GAMMA  = THE SINGLE PRECISION VALUE 
C                                OF THE TAIL LENGTH PARAMETER.
C                                GAMMA 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 PARETO DISTRIBUTION
C             WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--GAMMA SHOULD BE POSITIVE.
C                 --P SHOULD BE BETWEEN 0.0 (INCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
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 233-249.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGE 102.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LT.0.0.OR.P.GE.1.0)GOTO50
      IF(GAMMA.LE.0.0)GOTO55
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      PPF=0.0
      RETURN
   55 WRITE(IPR,15) 
      WRITE(IPR,46)GAMMA
      PPF=0.0
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 PARPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 PARPPF SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      PPF=(1.0-P)**(-1.0/GAMMA)
C
      RETURN
      END 
      SUBROUTINE PARRAN(N,GAMMA,ISEED,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PARRAN
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE PARETO DISTRIBUTION
C              WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
C              THE PROTOTYPE PARETO DISTRIBUTION USED
C              HEREIN IS DEFINED FOR ALL X GREATER THAN
C              OR EQUAL TO 1,
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = GAMMA / (X**(GAMMA+1)).
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
C                                OF RANDOM NUMBERS TO BE
C                                GENERATED.
C                     --GAMMA  = THE SINGLE PRECISION VALUE OF THE
C                                TAIL LENGTH PARAMETER.
C                                GAMMA SHOULD BE POSITIVE.
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 PARETO DISTRIBUTION
C             WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
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                 --GAMMA 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     REFERENCES--TOCHER, THE ART OF SIMULATION,
C                 1963, PAGES 14-15.
C               --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS,
C                 1964, PAGE 36.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 233-249.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGE 104.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82.6
C     ORIGINAL VERSION--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
CCCCC CHARACTER*4 IFEEDB
CCCCC CHARACTER*4 IPRINT
C
CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
CCCCC COMMON /PRINT/IFEEDB,IPRINT
C
      IPR=6
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(GAMMA.LE.0.0)GOTO60
      GOTO90
   50 WRITE(IPR, 5)
      WRITE(IPR,47)N
      RETURN
   60 WRITE(IPR,15)
      WRITE(IPR,46)GAMMA
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 PARRAN SUBROUTINE IS NON-POSITIVE *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 PARRAN SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
C
      CALL UNIRAN(N,ISEED,X)
C
C     GENERATE N PARETO DISTRIBUTION RANDOM NUMBERS
C     USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD.
C
      DO100I=1,N
      X(I)=(1.0-X(I))**(-1.0/GAMMA)
  100 CONTINUE
C
      RETURN
      END
      SUBROUTINE PLOT(Y,X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PLOT
C
C     PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT
C              OF Y(I) VERSUS X(I).
C     INPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED VERTICALLY.
C                    --X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED HORIZONTALLY. 
C                    --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR Y.
C     OUTPUT--A ONE-PAGE PRINTER PLOT OF Y(I) VERSUS X(I).
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (Y)
C              OR THE HORIZONTAL AXIS VECTOR (X) WHICH ARE
C              EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE
C              PLOTTED.
C              THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM
C              OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y
C              (OR X) ARE 'MISSING DATA', OR WHEN WE PURPOSELY
C              WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y
C              (OR X) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT
C              WANT CERTAIN ELEMENTS IN Y (OR X) TO BE PLOTTED).
C              TO CAUSE SPECIFIC ELEMENTS IN Y (OR X) TO BE 
C              IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND
C              (BY, FOR EXAMPLE, USE OF THE   REPLAC   SUBROUTINE)
C              BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND
C              THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOT
C              SUBROUTINE.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --OCTOBER   1974. 
C     UPDATED         --NOVEMBER  1974. 
C     UPDATED         --JANUARY   1975. 
C     UPDATED         --JULY      1975. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --OCTOBER   1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C     UPDATED         --FEBRUARY  1977. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IGRAPH
      CHARACTER*4 SBNAM1,SBNAM2
      CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 
      CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX
      CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL
      DIMENSION Y(1)
      DIMENSION X(1)
      DIMENSION YLABLE(11)
      COMMON /BLOCK1/ IGRAPH(55,130)
C
      DATA SBNAM1,SBNAM2/'PLOT','    '/ 
      DATA ALPH11,ALPH12/'FIRS','T   '/ 
      DATA ALPH21,ALPH22/'SECO','ND  '/ 
      DATA ALPH31,ALPH32/'THIR','D   '/ 
      DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/
      DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/
C
      IPR=6
      CUTOFF=(10.0**10)-1000.0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      WRITE(IPR,998)
      IF(N.LT.1)GOTO52
      GOTO54
   52 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,20)N
      WRITE(IPR,5)
      RETURN
   54 CONTINUE
      IF(N.EQ.1)GOTO56
      GOTO58
   56 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,22)N
      WRITE(IPR,5)
      RETURN
   58 CONTINUE
C
      HOLD=Y(1)
      DO60I=2,N
      IF(Y(I).NE.HOLD)GOTO62
   60 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   62 CONTINUE
      HOLD=X(1)
      DO64I=2,N
      IF(X(I).NE.HOLD)GOTO66
   64 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   66 CONTINUE
C
      DO76I=1,N
      IF(Y(I).LT.CUTOFF)GOTO78
   76 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   78 CONTINUE
      DO80I=1,N
      IF(X(I).LT.CUTOFF)GOTO82
   80 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   82 CONTINUE
C
      N2=0
      DO96I=1,N
      IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF)GOTO98 
      GOTO96
   98 N2=N2+1
      IF(N2.GE.2)GOTO99
   96 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22
      WRITE(IPR,19)SBNAM1,SBNAM2
      WRITE(IPR,40) 
      WRITE(IPR,41)N2
      WRITE(IPR,5)
      RETURN
   99 CONTINUE
C
    5 FORMAT(1H ,'**************************************************',
     1'********************') 
   10 FORMAT(1H ,'                   FATAL ERROR                    ')
   15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4,
     1' SUBROUTINE')
   18 FORMAT(1H ,'THE ',A4,A4,', AND ',A4,A4)
   19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE')
   20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,1H))
   22 FORMAT(1H ,'HAS THE VALUE 1')
   30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8)
   32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF')
   33 FORMAT(1H ,'VALUE OF ',E15.8)
   40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 
     1' EXCLUDED FROM THE PLOT.')
   41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.')
C
C-----START POINT-----------------------------------------------------
C
C     DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS
C
      DO200I=1,N
      IF(Y(I).GE.CUTOFF)GOTO200
      IF(X(I).GE.CUTOFF)GOTO200
      YMIN=Y(I)
      YMAX=Y(I)
      GOTO250
  200 CONTINUE
  250 DO300I=1,N
      IF(Y(I).GE.CUTOFF)GOTO300
      IF(X(I).GE.CUTOFF)GOTO300
      IF(Y(I).LT.YMIN)YMIN=Y(I)
      IF(Y(I).GT.YMAX)YMAX=Y(I)
  300 CONTINUE
      DO400I=1,9
      AIM1=I-1
      YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN)
  400 CONTINUE
C
C     DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS 
C     DETERMINE XMIN, XMAX, XMID, X25 (=THE 25% POINT), AND 
C     X75 (=THE 75% POINT)
C
      DO600I=1,N
      IF(Y(I).GE.CUTOFF)GOTO600
      IF(X(I).GE.CUTOFF)GOTO600
      XMIN=X(I)
      XMAX=X(I)
      GOTO650
  600 CONTINUE
  650 DO700I=1,N
      IF(Y(I).GE.CUTOFF)GOTO700
      IF(X(I).GE.CUTOFF)GOTO700
      IF(X(I).LT.XMIN)XMIN=X(I)
      IF(X(I).GT.XMAX)XMAX=X(I)
  700 CONTINUE
      XMID=(XMIN+XMAX)/2.0
      X25=0.75*XMIN+0.25*XMAX 
      X75=0.25*XMIN+0.75*XMAX 
C
C     BLANK OUT THE GRAPH
C
      DO1100I=1,45
      DO1200J=1,109 
      IGRAPH(I,J)=BLANK
 1200 CONTINUE
 1100 CONTINUE
C
C     PRODUCE THE VERTICAL AXES
C
      DO1300I=3,43
      IGRAPH(I,5)=ALPHAI
      IGRAPH(I,109)=ALPHAI
 1300 CONTINUE
      DO1400I=3,43,5
      IGRAPH(I,5)=HYPHEN
      IGRAPH(I,109)=HYPHEN
 1400 CONTINUE
      IGRAPH(3,1)=EQUAL
      IGRAPH(3,2)=ALPHAM
      IGRAPH(3,3)=ALPHAA
      IGRAPH(3,4)=ALPHAX
      IGRAPH(23,1)=EQUAL
      IGRAPH(23,2)=ALPHAM
      IGRAPH(23,3)=ALPHAI
      IGRAPH(23,4)=ALPHAD
      IGRAPH(43,1)=EQUAL
      IGRAPH(43,2)=ALPHAM
      IGRAPH(43,3)=ALPHAI
      IGRAPH(43,4)=ALPHAN
C
C     PRODUCE THE HORIZONTAL AXES
C
      DO1500J=7,107 
      IGRAPH(1,J)=HYPHEN
      IGRAPH(45,J)=HYPHEN
 1500 CONTINUE
      DO1600J=7,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1600 CONTINUE
      DO1700J=20,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1700 CONTINUE
C
C     DETERMINE THE (X,Y) PLOT POSITIONS
C
      RATIOY=40.0/(YMAX-YMIN) 
      RATIOX=100.0/(XMAX-XMIN)
      DO1800I=1,N
      IF(Y(I).GE.CUTOFF)GOTO1800
      IF(X(I).GE.CUTOFF)GOTO1800
      MX=RATIOX*(X(I)-XMIN)+0.5
      MX=MX+7
      MY=RATIOY*(Y(I)-YMIN)+0.5
      MY=43-MY
      IGRAPH(MY,MX)=ALPHAX
 1800 CONTINUE
C
C     WRITE OUT THE GRAPH
C
      DO2100I=1,45
      IP2=I+2
      IFLAG=IP2-(IP2/5)*5
      K=IP2/5
      IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109)
      IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109)
 2100 CONTINUE
      WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX
C
 2105 FORMAT(1H ,20X,109A1)
 2106 FORMAT(1H ,F20.7,109A1) 
 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7)
  998 FORMAT(1H1)
C
      RETURN
      END 
      SUBROUTINE PLOT10(Y,X,CHAR,N,YMIN,YMAX,XMIN,XMAX,
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
     1                  D,DMIN,DMAX,YAXID,XAXID,PLCHID)
      DLL_EXPORT PLOT10
C
C     PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT
C              OF Y(I) VERSUS X(I): 
C              1) WITH SPECIAL PLOT CHARACTERS;
C              2) WITH THE VERTICAL (Y) AXIS MIN AND MAX
C                 AND THE HORIZONTAL (X) AXIS MIN AND MAX
C                 VALUES SPECIFIED BY THE DATA ANALYST;
C              3) WITH ONLY THOSE POINTS (X(I),Y(I)) PLOTTED
C                 FOR WHICH THE CORRESPONDING VALUE OF D(I) 
C                 IS BETWEEN THE SPECIFIED VALUES OF DMIN AND DMAX; AND
C              3) WITH HOLLARITH LABELS (AT MOST 6 CHARACTERS)
C                 FOR THE VERTICAL AXIS VARIABLE, 
C                 THE HORIZONTAL AXIS VARIABLE, AND
C                 THE PLOTTING CHARACTER VARIABLE 
C                 ALSO BEING PROVIDED BY THE DATA ANALYST.
C
C              THE 'SPECIAL PLOTTING CHARACTER' CAPABILITY
C              ALLOWS THE DATA ANALYST TO INCORPORATE INFORMATION
C              FROM A THIRD VARIABLE (ASIDE FROM Y AND X) INTO
C              THE PLOT.
C              THE PLOT CHARACTER USED AT THE I-TH PLOTTING 
C              POSITION (THAT IS, AT THE COORDINATE (X(I),Y(I)))
C              WILL BE
C              1 IF CHAR(I) IS BETWEEN  0.5 AND  1.5
C              2 IF CHAR(I) IS BETWEEN  1.5 AND  2.5
C                .
C                .
C                .
C              9 IF CHAR(I) IS BETWEEN  8.5 AND  9.5
C              0 IF CHAR(I) IS BETWEEN  9.5 AND 10.5
C              A IF CHAR(I) IS BETWEEN 10.5 AND 11.5
C              B IF CHAR(I) IS BETWEEN 11.5 AND 12.5
C              C IF CHAR(I) IS BETWEEN 12.5 AND 13.5
C                .
C                .
C                .
C              W IF CHAR(I) IS BETWEEN 32.5 AND 33.5
C              X IF CHAR(I) IS BETWEEN 33.5 AND 34.5
C              Y IF CHAR(I) IS BETWEEN 34.5 AND 35.5
C              Z IF CHAR(I) IS BETWEEN 35.5 AND 36.5
C              X IF CHAR(I) IS ANY VALUE OUTSIDE THE RANGE
C                                       0.5 TO  36.5.
C
C              THE USE OF THE YMIN, YMAX, XMIN, AND XMAX
C              SPECIFICATIONS ALLOWS THE DATA ANALYST
C              TO CONTROL FULLY THE PLOT AXIS LIMITS,
C              SO AS, FOR EXAMPLE, TO ZERO-IN ON AN
C              INTERESTING SUB-REGION OF A PREVIOUS PLOT.
C
C              THE USE OF THE SUBSET DEFINTION VECTOR D
C              GIVES THE DATA ANALYST THE CAPABILITY OF
C              PLOTTING SUBSETS OF THE DATA,
C              WHERE THE SUBSET IS DEFINED
C              BY VALUES IN THE VECTOR D.
C
C              THE USE OF HOLLARITH IDENTIFYING LABELS
C              ALLOWS THE DATA ANALYST TO AUTOMATICALLY
C              HAVE THE PLOTS LABELED.  THIS IS PARTICULARLY
C              USEFUL IN A LARGE ANALYSIS WHEN MANY
C              PLOTS ARE BEING GENERATED.
C
C     INPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED VERTICALLY.
C                    --X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED HORIZONTALLY. 
C                    --CHAR   = THE SINGLE PRECISION VECTOR OF
C                               OBSERVATIONS WHICH CONTROL THE
C                               VALUE OF EACH INDIVIDUAL PLOT
C                               CHARACTER.
C                    --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR Y.
C                    --YMIN   = THE SINGLE PRECISION VALUE OF
C                               DESIRED MINIMUM FOR THE VERTICAL AXIS.
C                    --YMAX   = THE SINGLE PRECISION VALUE OF
C                               DESIRED MAXIMUM FOR THE VERTICAL AXIS.
C                    --XMIN   = THE SINGLE PRECISION VALUE OF
C                               DESIRED MINIMUM FOR THE HORIZONTAL AXIS.
C                    --XMAX   = THE SINGLE PRECISION VALUE OF
C                               DESIRED MAXIMUM FOR THE HORIZONTAL AXIS.
C                    --D      = THE SINGLE PRECISION VECTOR 
C                               WHICH 'DEFINES' THE VARIOUS 
C                               POSSIBLE SUBSETS. 
C                    --DMIN   = THE SINGLE PRECISION VALUE
C                               WHICH DEFINES THE LOWER BOUND
C                               (INCLUSIVELY) OF THE PARTICULAR
C                               SUBSET OF INTEREST TO BE PLOTTED.
C                    --DMAX   = THE SINGLE PRECISION VALUE
C                               WHICH DEFINES THE UPPER BOUND
C                               (INCLUSIVELY) OF THE PARTICULAR
C                               SUBSET OF INTEREST TO BE PLOTTED.
C                    --YAXID  = THE HOLLARITH VALUE
C                               (AT MOST 6 CHARACTERS)
C                               OF THE DESIRED LABEL FOR THE
C                               VERTICAL AXIS VARIABLE.
C                    --XAXID  = THE HOLLARITH VALUE
C                               (AT MOST 6 CHARACTERS)
C                               OF THE DESIRED LABEL FOR THE
C                               HORIZONTAL AXIS VARIABLE.
C                    --PLCHID = THE HOLLARITH VALUE
C                               (AT MOST 6 CHARACTERS)
C                               OF THE DESIRED LABEL FOR THE
C                               PLOTTING CHARACTER VARIABLE.
C     OUTPUT--A ONE-PAGE PRINTER PLOT OF Y(I) VERSUS X(I),
C             WITH SPECIAL PLOT CHARACTERS,
C             WITH SPECIFIED AXIS LIMITS,
C             FOR ONLY OF A SPECIFIED SUBSET OF THE DATA, AND
C             WITH SPECIFIED LABELS.
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (Y)
C              WHICH ARE SMALLER THAN YMIN OR LARGER THAN YMAX,
C              OR VALUES IN THE HORIZONTAL AXIS VECTOR (X)
C              WHICH ARE SMALLER THAN XMIN OR LARGER THAN XMAX
C              WILL NOT BE PLOTTED.
C            --FOR A GIVEN DUMMY INDEX I,
C              IF D(I) IS SMALLER THAN DMIN OR LARGER THAN DMAX,
C              THEN THE CORRESPONDING POINT (X(I),Y(I))
C              WILL NOT BE PLOTTED.
C            --VALUES IN THE VERTICAL AXIS VECTOR (Y),
C              THE HORIZONTAL AXIS VECTOR (X),
C              OR THE PLOT CHARACTER VECTOR (CHAR) WHICH ARE
C              EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE
C              PLOTTED.
C              THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM
C              OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y
C              (OR X, OR CHAR) ARE 'MISSING DATA', OR WHEN WE PURPOSELY
C              WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y
C              (OR X, OR CHAR) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT
C              WANT CERTAIN ELEMENTS IN Y (OR X, OR CHAR) TO BE
C              PLOTTED).
C              TO CAUSE SPECIFIC ELEMENTS IN Y (OR X, OR CHAR) TO BE
C              IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND
C              (BY, FOR EXAMPLE, USE OF THE   REPLAC   SUBROUTINE)
C              BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND
C              THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTC
C              SUBROUTINE.
C     REFERENCES--FILLIBEN, 'STATISTICAL ANALYSIS OF INTERLAB
C                 FATIGUE TIME DATA', UNPUBLISHED MANUSCRIPT
C                 (AVAILABLE FROM AUTHOR)
C                 PRESENTED AT THE 'COMPUTER-ASSISTED DATA
C                 ANALYSIS' SESSION AT THE NATIONAL MEETING 
C                 OF THE AMERICAN STATISTICAL ASSOCIATION,
C                 NEW YORK CITY, DECEMBER 27-30, 1973.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JANUARY   1974. 
C     UPDATED         --OCTOBER   1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C     UPDATED         --FEBRUARY  1977. 
C     UPDATED         --JUNE      1977. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IGRAPH
      CHARACTER*4 IPLOTC
      CHARACTER*4 SBNAM1,SBNAM2
      CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 
      CHARACTER*4 ALPH41,ALPH42,ALPH91,ALPH92
      CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX
      CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL
C
      DIMENSION Y(1)
      DIMENSION X(1)
      DIMENSION D(1)
      DIMENSION CHAR(1)
      DIMENSION YLABLE(11)
      DIMENSION IPLOTC(37)
      COMMON /BLOCK1/ IGRAPH(55,130)
C
      DATA SBNAM1,SBNAM2/'PLOT','10  '/ 
      DATA ALPH11,ALPH12/'FIRS','T   '/ 
      DATA ALPH21,ALPH22/'SECO','ND  '/ 
      DATA ALPH31,ALPH32/'THIR','D   '/ 
      DATA ALPH41,ALPH42/'FOUR','TH  '/ 
      DATA ALPH91,ALPH92/'FIFT','H   '/ 
      DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/
      DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/
      DATA IPLOTC(1),IPLOTC(2),IPLOTC(3),IPLOTC(4),IPLOTC(5),
     1IPLOTC(6),IPLOTC(7),IPLOTC(8),IPLOTC(9),IPLOTC(10),
     1IPLOTC(11),IPLOTC(12),IPLOTC(13),IPLOTC(14),IPLOTC(15),
     1IPLOTC(16),IPLOTC(17),IPLOTC(18),IPLOTC(19),IPLOTC(20),
     1IPLOTC(21),IPLOTC(22),IPLOTC(23),IPLOTC(24),IPLOTC(25),
     1IPLOTC(26),IPLOTC(27),IPLOTC(28),IPLOTC(29),IPLOTC(30),
     1IPLOTC(31),IPLOTC(32),IPLOTC(33),IPLOTC(34),IPLOTC(35),
     1IPLOTC(36),IPLOTC(37)
     1/'1','2','3','4','5','6','7','8','9','0','A','B','C','D','E','F',
     1'G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V',
     1'W','X','Y','Z','X'/
C
      IPR=6
      CUTOFF=(10.0**10)-1000.0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      WRITE(IPR,998)
      IF(N.LT.1)GOTO52
      GOTO54
   52 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,20)N
      WRITE(IPR,5)
      RETURN
   54 CONTINUE
      IF(N.EQ.1)GOTO56
      GOTO58
   56 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,22)N
      WRITE(IPR,5)
      RETURN
   58 CONTINUE
C
      HOLD=Y(1)
      DO60I=2,N
      IF(Y(I).NE.HOLD)GOTO62
   60 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   62 CONTINUE
      HOLD=X(1)
      DO64I=2,N
      IF(X(I).NE.HOLD)GOTO66
   64 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   66 CONTINUE
      HOLD=CHAR(1)
      DO68I=2,N
      IF(CHAR(I).NE.HOLD)GOTO70
   68 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,11) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
   70 CONTINUE
      HOLD=D(1)
      DO72I=2,N
      IF(D(I).NE.HOLD)GOTO74
   72 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,11) 
      WRITE(IPR,15)ALPH91,ALPH92,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
   74 CONTINUE
C
      DO76I=1,N
      IF(Y(I).LT.CUTOFF)GOTO78
   76 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   78 CONTINUE
      DO80I=1,N
      IF(X(I).LT.CUTOFF)GOTO82
   80 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   82 CONTINUE
      DO84I=1,N
      IF(CHAR(I).LT.CUTOFF)GOTO86
   84 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   86 CONTINUE
      DO88I=1,N
      IF(D(I).LT.CUTOFF)GOTO90
   88 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH91,ALPH92,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   90 CONTINUE
C
      DO92I=1,N
      IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)GOTO94
   92 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH91,ALPH92,SBNAM1,SBNAM2
      WRITE(IPR,34) 
      WRITE(IPR,35)DMIN,DMAX
      WRITE(IPR,36) 
      WRITE(IPR,5)
      RETURN
   94 CONTINUE
C
      N2=0
      DO96I=1,N
      IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF.AND.CHAR(I).LT.CUTOFF.AND. 
     1D(I).LT.CUTOFF)GOTO98
      GOTO96
   98 IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)N2=N2+1
      IF(N2.GE.2)GOTO99
   96 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32,
     1ALPH91,ALPH92 
      WRITE(IPR,19)SBNAM1,SBNAM2
      WRITE(IPR,40) 
      WRITE(IPR,41)N2
      WRITE(IPR,5)
      RETURN
   99 CONTINUE
C
    5 FORMAT(1H ,'**************************************************',
     1'********************') 
   10 FORMAT(1H ,'                   FATAL ERROR                    ')
   11 FORMAT(1H ,'               NON-FATAL DIAGNOSTIC               ')
   15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4,
     1' SUBROUTINE')
   18 FORMAT(1H ,'THE ',A4,A4,', ',A4,A4,', ',A4,A4,', AND ',A4,A4)
   19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE')
   20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,')')
   22 FORMAT(1H ,'HAS THE VALUE 1')
   30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8)
   32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF')
   33 FORMAT(1H ,'VALUE OF ',E15.8)
   34 FORMAT(1H ,'HAS ALL ELEMENTS OUTSIDE THE INTERVAL')
   35 FORMAT(1H ,'(',E15.8,',',E15.8,')',' AS DEFINED BY')
   36 FORMAT(1H ,'THE TENTH  AND ELEVENTH INPUT ARGUMENTS.')
   40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 
     1' EXCLUDED FROM THE PLOT.')
   41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.')
C
C-----START POINT-----------------------------------------------------
C
C     DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS
C
      DO400I=1,9
      AIM1=I-1
      YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN)
  400 CONTINUE
C
C     DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS 
C     DETERMINE XMID, X25 (=THE 25% POINT), AND
C     X75 (=THE 75% POINT)
C
      XMID=(XMIN+XMAX)/2.0
      X25=0.75*XMIN+0.25*XMAX 
      X75=0.25*XMIN+0.75*XMAX 
C
C     BLANK OUT THE GRAPH
C
      DO1100I=1,45
      DO1200J=1,109 
      IGRAPH(I,J)=BLANK
 1200 CONTINUE
 1100 CONTINUE
C
C     PRODUCE THE VERTICAL AXES
C
      DO1300I=3,43
      IGRAPH(I,5)=ALPHAI
      IGRAPH(I,109)=ALPHAI
 1300 CONTINUE
      DO1400I=3,43,5
      IGRAPH(I,5)=HYPHEN
      IGRAPH(I,109)=HYPHEN
 1400 CONTINUE
      IGRAPH(3,1)=EQUAL
      IGRAPH(3,2)=ALPHAM
      IGRAPH(3,3)=ALPHAA
      IGRAPH(3,4)=ALPHAX
      IGRAPH(23,1)=EQUAL
      IGRAPH(23,2)=ALPHAM
      IGRAPH(23,3)=ALPHAI
      IGRAPH(23,4)=ALPHAD
      IGRAPH(43,1)=EQUAL
      IGRAPH(43,2)=ALPHAM
      IGRAPH(43,3)=ALPHAI
      IGRAPH(43,4)=ALPHAN
C
C     PRODUCE THE HORIZONTAL AXES
C
      DO1500J=7,107 
      IGRAPH(1,J)=HYPHEN
      IGRAPH(45,J)=HYPHEN
 1500 CONTINUE
      DO1600J=7,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1600 CONTINUE
      DO1700J=20,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1700 CONTINUE
C
C     DETERMINE THE (X,Y) PLOT POSITIONS
C
      RATIOY=40.0/(YMAX-YMIN) 
      RATIOX=100.0/(XMAX-XMIN)
      DO1800I=1,N
      IF(Y(I).GE.CUTOFF)GOTO1800
      IF(X(I).GE.CUTOFF)GOTO1800
      IF(CHAR(I).GE.CUTOFF)GOTO1800
      IF(Y(I).LT.YMIN.OR.Y(I).GT.YMAX)GOTO1800
      IF(X(I).LT.XMIN.OR.X(I).GT.XMAX)GOTO1800
      IF(D(I).LT.DMIN)GOTO1800
      IF(D(I).GT.DMAX)GOTO1800
      MX=RATIOX*(X(I)-XMIN)+0.5
      MX=MX+7
      MY=RATIOY*(Y(I)-YMIN)+0.5
      MY=43-MY
      IARG=37
      IF(0.5.LT.CHAR(I).AND.CHAR(I).LT.36.5)IARG=CHAR(I)+0.5
      IGRAPH(MY,MX)=IPLOTC(IARG)
 1800 CONTINUE
C
C     WRITE OUT THE GRAPH
C
      DO2100I=1,45
      IP2=I+2
      IFLAG=IP2-(IP2/5)*5
      K=IP2/5
      IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109)
      IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109)
 2100 CONTINUE
      WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX
      WRITE(IPR,2115)YAXID,XAXID,PLCHID 
      WRITE(IPR,2116)N
C
 2105 FORMAT(1H ,20X,109A1)
 2106 FORMAT(1H ,F20.7,109A1) 
 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7)
 2115 FORMAT(1H ,9X,A4,A4,' (VERTICAL AXIS) VERSUS ',A4,A4, 
     1' (HORIZONTAL AXIS) ',20X,'THE PLOTTING CHARACTER IS ',A4,A4)
 2116 FORMAT(1H ,83X,'THE NUMBER OF OBSERVATIONS PLOTTED IS ',I8)
  998 FORMAT(1H1)
C
      RETURN
      END 
      SUBROUTINE PLOT6(Y,X,N,YMIN,YMAX,XMIN,XMAX) 
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PLOT6
C
C     PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT
C              OF Y(I) VERSUS X(I): 
C              1) WITH THE VERTICAL (Y) AXIS MIN AND MAX
C                 AND THE HORIZONTAL (X) AXIS MIN AND MAX
C                 VALUES SPECIFIED BY THE DATA ANALYST.
C
C              THE USE OF THE YMIN, YMAX, XMIN, AND XMAX
C              SPECIFICATIONS ALLOWS THE DATA ANALYST
C              TO CONTROL FULLY THE PLOT AXIS LIMITS,
C              SO AS, FOR EXAMPLE, TO ZERO-IN ON AN
C              INTERESTING SUB-REGION OF A PREVIOUS PLOT.
C
C     INPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED VERTICALLY.
C                    --X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED HORIZONTALLY. 
C                    --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR Y.
C                    --YMIN   = THE SINGLE PRECISION VALUE OF
C                               DESIRED MINIMUM FOR THE VERTICAL AXIS.
C                    --YMAX   = THE SINGLE PRECISION VALUE OF
C                               DESIRED MAXIMUM FOR THE VERTICAL AXIS.
C                    --XMIN   = THE SINGLE PRECISION VALUE OF
C                               DESIRED MINIMUM FOR THE HORIZONTAL AXIS.
C                    --XMAX   = THE SINGLE PRECISION VALUE OF
C                               DESIRED MAXIMUM FOR THE HORIZONTAL AXIS.
C     OUTPUT--A ONE-PAGE PRINTER PLOT OF Y(I) VERSUS X(I),
C             WITH SPECIFIED AXIS LIMITS.
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (Y)
C              WHICH ARE SMALLER THAN YMIN OR LARGER THAN YMAX,
C              OR VALUES IN THE HORIZONTAL AXIS VECTOR (X)
C              WHICH ARE SMALLER THAN XMIN OR LARGER THAN XMAX
C              WILL NOT BE PLOTTED.
C            --VALUES IN THE VERTICAL AXIS VECTOR (Y)
C              OR THE HORIZONTAL AXIS VECTOR (X) WHICH ARE
C              EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE
C              PLOTTED.
C              THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM
C              OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y
C              (OR X) ARE 'MISSING DATA', OR WHEN WE PURPOSELY
C              WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y
C              (OR X) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT
C              WANT CERTAIN ELEMENTS IN Y (OR X) TO BE PLOTTED).
C              TO CAUSE SPECIFIC ELEMENTS IN Y (OR X) TO BE 
C              IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND
C              (BY, FOR EXAMPLE, USE OF THE   REPLAC   SUBROUTINE)
C              BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND
C              THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOT
C              SUBROUTINE.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --OCTOBER   1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C     UPDATED         --FEBRUARY  1977. 
C     UPDATED         --JUNE      1977. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IGRAPH
      CHARACTER*4 SBNAM1,SBNAM2
      CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 
      CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX
      CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL
C
      DIMENSION Y(1)
      DIMENSION X(1)
      DIMENSION YLABLE(11)
      COMMON /BLOCK1/ IGRAPH(55,130)
C
      DATA SBNAM1,SBNAM2/'PLOT','6   '/ 
      DATA ALPH11,ALPH12/'FIRS','T   '/ 
      DATA ALPH21,ALPH22/'SECO','ND  '/ 
      DATA ALPH31,ALPH32/'THIR','D   '/ 
      DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/
      DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/
C
      IPR=6
      CUTOFF=(10.0**10)-1000.0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      WRITE(IPR,998)
      IF(N.LT.1)GOTO52
      GOTO54
   52 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,20)N
      WRITE(IPR,5)
      RETURN
   54 CONTINUE
      IF(N.EQ.1)GOTO56
      GOTO58
   56 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,22)N
      WRITE(IPR,5)
      RETURN
   58 CONTINUE
C
      HOLD=Y(1)
      DO60I=2,N
      IF(Y(I).NE.HOLD)GOTO62
   60 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   62 CONTINUE
      HOLD=X(1)
      DO64I=2,N
      IF(X(I).NE.HOLD)GOTO66
   64 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   66 CONTINUE
C
      DO76I=1,N
      IF(Y(I).LT.CUTOFF)GOTO78
   76 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   78 CONTINUE
      DO80I=1,N
      IF(X(I).LT.CUTOFF)GOTO82
   80 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   82 CONTINUE
C
      N2=0
      DO96I=1,N
      IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF)GOTO98 
      GOTO96
   98 N2=N2+1
      IF(N2.GE.2)GOTO99
   96 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22
      WRITE(IPR,19)SBNAM1,SBNAM2
      WRITE(IPR,40) 
      WRITE(IPR,41)N2
      WRITE(IPR,5)
      RETURN
   99 CONTINUE
C
    5 FORMAT(1H ,'**************************************************',
     1'********************') 
   10 FORMAT(1H ,'                   FATAL ERROR                    ')
   15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4,
     1' SUBROUTINE')
   18 FORMAT(1H ,'THE ',A4,A4,', AND ',A4,A4)
   19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE')
   20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,1H))
   22 FORMAT(1H ,'HAS THE VALUE 1')
   30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8)
   32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF')
   33 FORMAT(1H ,'VALUE OF ',E15.8)
   40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 
     1' EXCLUDED FROM THE PLOT.')
   41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.')
C
C-----START POINT-----------------------------------------------------
C
C     DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS
C
      DO400I=1,9
      AIM1=I-1
      YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN)
  400 CONTINUE
C
C     DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS 
C     DETERMINE XMID, X25 (=THE 25% POINT), AND
C     X75 (=THE 75% POINT)
C
      XMID=(XMIN+XMAX)/2.0
      X25=0.75*XMIN+0.25*XMAX 
      X75=0.25*XMIN+0.75*XMAX 
C
C     BLANK OUT THE GRAPH
C
      DO1100I=1,45
      DO1200J=1,109 
      IGRAPH(I,J)=BLANK
 1200 CONTINUE
 1100 CONTINUE
C
C     PRODUCE THE VERTICAL AXES
C
      DO1300I=3,43
      IGRAPH(I,5)=ALPHAI
      IGRAPH(I,109)=ALPHAI
 1300 CONTINUE
      DO1400I=3,43,5
      IGRAPH(I,5)=HYPHEN
      IGRAPH(I,109)=HYPHEN
 1400 CONTINUE
      IGRAPH(3,1)=EQUAL
      IGRAPH(3,2)=ALPHAM
      IGRAPH(3,3)=ALPHAA
      IGRAPH(3,4)=ALPHAX
      IGRAPH(23,1)=EQUAL
      IGRAPH(23,2)=ALPHAM
      IGRAPH(23,3)=ALPHAI
      IGRAPH(23,4)=ALPHAD
      IGRAPH(43,1)=EQUAL
      IGRAPH(43,2)=ALPHAM
      IGRAPH(43,3)=ALPHAI
      IGRAPH(43,4)=ALPHAN
C
C     PRODUCE THE HORIZONTAL AXES
C
      DO1500J=7,107 
      IGRAPH(1,J)=HYPHEN
      IGRAPH(45,J)=HYPHEN
 1500 CONTINUE
      DO1600J=7,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1600 CONTINUE
      DO1700J=20,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1700 CONTINUE
C
C     DETERMINE THE (X,Y) PLOT POSITIONS
C
      RATIOY=40.0/(YMAX-YMIN) 
      RATIOX=100.0/(XMAX-XMIN)
      DO1800I=1,N
      IF(Y(I).GE.CUTOFF)GOTO1800
      IF(X(I).GE.CUTOFF)GOTO1800
      IF(Y(I).LT.YMIN.OR.Y(I).GT.YMAX)GOTO1800
      IF(X(I).LT.XMIN.OR.X(I).GT.XMAX)GOTO1800
      MX=RATIOX*(X(I)-XMIN)+0.5
      MX=MX+7
      MY=RATIOY*(Y(I)-YMIN)+0.5
      MY=43-MY
      IGRAPH(MY,MX)=ALPHAX
 1800 CONTINUE
C
C     WRITE OUT THE GRAPH
C
      DO2100I=1,45
      IP2=I+2
      IFLAG=IP2-(IP2/5)*5
      K=IP2/5
      IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109)
      IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109)
 2100 CONTINUE
      WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX
C
 2105 FORMAT(1H ,20X,109A1)
 2106 FORMAT(1H ,F20.7,109A1) 
 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7)
  998 FORMAT(1H1)
C
      RETURN
      END 
      SUBROUTINE PLOT7(Y,X,CHAR,N,YMIN,YMAX,XMIN,XMAX)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PLOT7
C
C     PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT
C              OF Y(I) VERSUS X(I): 
C              1) WITH SPECIAL PLOT CHARACTERS; AND
C              2) WITH THE VERTICAL (Y) AXIS MIN AND MAX
C                 AND THE HORIZONTAL (X) AXIS MIN AND MAX
C                 VALUES SPECIFIED BY THE DATA ANALYST.
C
C              THE 'SPECIAL PLOTTING CHARACTER' CAPABILITY
C              ALLOWS THE DATA ANALYST TO INCORPORATE INFORMATION
C              FROM A THIRD VARIABLE (ASIDE FROM Y AND X) INTO
C              THE PLOT.
C              THE PLOT CHARACTER USED AT THE I-TH PLOTTING 
C              POSITION (THAT IS, AT THE COORDINATE (X(I),Y(I)))
C              WILL BE
C              1 IF CHAR(I) IS BETWEEN  0.5 AND  1.5
C              2 IF CHAR(I) IS BETWEEN  1.5 AND  2.5
C                .
C                .
C                .
C              9 IF CHAR(I) IS BETWEEN  8.5 AND  9.5
C              0 IF CHAR(I) IS BETWEEN  9.5 AND 10.5
C              A IF CHAR(I) IS BETWEEN 10.5 AND 11.5
C              B IF CHAR(I) IS BETWEEN 11.5 AND 12.5
C              C IF CHAR(I) IS BETWEEN 12.5 AND 13.5
C                .
C                .
C                .
C              W IF CHAR(I) IS BETWEEN 32.5 AND 33.5
C              X IF CHAR(I) IS BETWEEN 33.5 AND 34.5
C              Y IF CHAR(I) IS BETWEEN 34.5 AND 35.5
C              Z IF CHAR(I) IS BETWEEN 35.5 AND 36.5
C              X IF CHAR(I) IS ANY VALUE OUTSIDE THE RANGE
C                                       0.5 TO  36.5.
C
C              THE USE OF THE YMIN, YMAX, XMIN, AND XMAX
C              SPECIFICATIONS ALLOWS THE DATA ANALYST
C              TO CONTROL FULLY THE PLOT AXIS LIMITS,
C              SO AS, FOR EXAMPLE, TO ZERO-IN ON AN
C              INTERESTING SUB-REGION OF A PREVIOUS PLOT.
C
C     INPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED VERTICALLY.
C                    --X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED HORIZONTALLY. 
C                    --CHAR   = THE SINGLE PRECISION VECTOR OF
C                               OBSERVATIONS WHICH CONTROL THE
C                               VALUE OF EACH INDIVIDUAL PLOT
C                               CHARACTER.
C                    --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR Y.
C                    --YMIN   = THE SINGLE PRECISION VALUE OF
C                               DESIRED MINIMUM FOR THE VERTICAL AXIS.
C                    --YMAX   = THE SINGLE PRECISION VALUE OF
C                               DESIRED MAXIMUM FOR THE VERTICAL AXIS.
C                    --XMIN   = THE SINGLE PRECISION VALUE OF
C                               DESIRED MINIMUM FOR THE HORIZONTAL AXIS.
C                    --XMAX   = THE SINGLE PRECISION VALUE OF
C                               DESIRED MAXIMUM FOR THE HORIZONTAL AXIS.
C     OUTPUT--A ONE-PAGE PRINTER PLOT OF Y(I) VERSUS X(I),
C             WITH SPECIAL PLOT CHARACTERS,
C             AND WITH SPECIFIED AXIS LIMITS.
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (Y)
C              WHICH ARE SMALLER THAN YMIN OR LARGER THAN YMAX,
C              OR VALUES IN THE HORIZONTAL AXIS VECTOR (X)
C              WHICH ARE SMALLER THAN XMIN OR LARGER THAN XMAX
C              WILL NOT BE PLOTTED.
C            --VALUES IN THE VERTICAL AXIS VECTOR (Y),
C              THE HORIZONTAL AXIS VECTOR (X),
C              OR THE PLOT CHARACTER VECTOR (CHAR) WHICH ARE
C              EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE
C              PLOTTED.
C              THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM
C              OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y
C              (OR X, OR CHAR) ARE 'MISSING DATA', OR WHEN WE PURPOSELY
C              WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y
C              (OR X, OR CHAR) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT
C              WANT CERTAIN ELEMENTS IN Y (OR X, OR CHAR) TO BE
C              PLOTTED).
C              TO CAUSE SPECIFIC ELEMENTS IN Y (OR X, OR CHAR) TO BE
C              IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND
C              (BY, FOR EXAMPLE, USE OF THE   REPLAC   SUBROUTINE)
C              BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND
C              THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTC
C              SUBROUTINE.
C     REFERENCES--FILLIBEN, 'STATISTICAL ANALYSIS OF INTERLAB
C                 FATIGUE TIME DATA', UNPUBLISHED MANUSCRIPT
C                 (AVAILABLE FROM AUTHOR)
C                 PRESENTED AT THE 'COMPUTER-ASSISTED DATA
C                 ANALYSIS' SESSION AT THE NATIONAL MEETING 
C                 OF THE AMERICAN STATISTICAL ASSOCIATION,
C                 NEW YORK CITY, DECEMBER 27-30, 1973.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --JUNE      1974. 
C     UPDATED         --OCTOBER   1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C     UPDATED         --FEBRUARY  1977. 
C     UPDATED         --JUNE      1977. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IGRAPH
      CHARACTER*4 IPLOTC
      CHARACTER*4 SBNAM1,SBNAM2
      CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 
      CHARACTER*4 ALPH41,ALPH42
      CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX
      CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL
C
      DIMENSION Y(1)
      DIMENSION X(1)
      DIMENSION CHAR(1)
      DIMENSION YLABLE(11)
      DIMENSION IPLOTC(37)
      COMMON /BLOCK1/ IGRAPH(55,130)
C
      DATA SBNAM1,SBNAM2/'PLOT','7   '/ 
      DATA ALPH11,ALPH12/'FIRS','T   '/ 
      DATA ALPH21,ALPH22/'SECO','ND  '/ 
      DATA ALPH31,ALPH32/'THIR','D   '/ 
      DATA ALPH41,ALPH42/'FOUR','TH  '/ 
      DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/
      DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/
      DATA IPLOTC(1),IPLOTC(2),IPLOTC(3),IPLOTC(4),IPLOTC(5),
     1IPLOTC(6),IPLOTC(7),IPLOTC(8),IPLOTC(9),IPLOTC(10),
     1IPLOTC(11),IPLOTC(12),IPLOTC(13),IPLOTC(14),IPLOTC(15),
     1IPLOTC(16),IPLOTC(17),IPLOTC(18),IPLOTC(19),IPLOTC(20),
     1IPLOTC(21),IPLOTC(22),IPLOTC(23),IPLOTC(24),IPLOTC(25),
     1IPLOTC(26),IPLOTC(27),IPLOTC(28),IPLOTC(29),IPLOTC(30),
     1IPLOTC(31),IPLOTC(32),IPLOTC(33),IPLOTC(34),IPLOTC(35),
     1IPLOTC(36),IPLOTC(37)
     1/'1','2','3','4','5','6','7','8','9','0','A','B','C','D','E','F',
     1'G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V',
     1'W','X','Y','Z','X'/
C
      IPR=6
      CUTOFF=(10.0**10)-1000.0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      WRITE(IPR,998)
      IF(N.LT.1)GOTO52
      GOTO54
   52 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,20)N
      WRITE(IPR,5)
      RETURN
   54 CONTINUE
      IF(N.EQ.1)GOTO56
      GOTO58
   56 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,22)N
      WRITE(IPR,5)
      RETURN
   58 CONTINUE
C
      HOLD=Y(1)
      DO60I=2,N
      IF(Y(I).NE.HOLD)GOTO62
   60 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   62 CONTINUE
      HOLD=X(1)
      DO64I=2,N
      IF(X(I).NE.HOLD)GOTO66
   64 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   66 CONTINUE
      HOLD=CHAR(1)
      DO68I=2,N
      IF(CHAR(I).NE.HOLD)GOTO70
   68 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,11) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
   70 CONTINUE
C
      DO76I=1,N
      IF(Y(I).LT.CUTOFF)GOTO78
   76 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   78 CONTINUE
      DO80I=1,N
      IF(X(I).LT.CUTOFF)GOTO82
   80 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   82 CONTINUE
      DO84I=1,N
      IF(CHAR(I).LT.CUTOFF)GOTO86
   84 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   86 CONTINUE
C
      N2=0
      DO96I=1,N
      IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF.AND.CHAR(I).LT.CUTOFF)GOTO98
      GOTO96
   98 N2=N2+1
      IF(N2.GE.2)GOTO99
   96 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32
      WRITE(IPR,19)SBNAM1,SBNAM2
      WRITE(IPR,40) 
      WRITE(IPR,41)N2
      WRITE(IPR,5)
      RETURN
   99 CONTINUE
C
    5 FORMAT(1H ,'**************************************************',
     1'********************') 
   10 FORMAT(1H ,'                   FATAL ERROR                    ')
   11 FORMAT(1H ,'               NON-FATAL DIAGNOSTIC               ')
   15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4,
     1' SUBROUTINE')
   18 FORMAT(1H ,'THE ',A4,A4,', ',A4,A4,', AND ',A4,A4)
   19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE')
   20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,')')
   22 FORMAT(1H ,'HAS THE VALUE 1')
   30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8)
   32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF')
   33 FORMAT(1H ,'VALUE OF ',E15.8)
   40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 
     1' EXCLUDED FROM THE PLOT.')
   41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.')
C
C-----START POINT-----------------------------------------------------
C
C     DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS
C
      DO400I=1,9
      AIM1=I-1
      YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN)
  400 CONTINUE
C
C     DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS 
C     DETERMINE XMID, X25 (=THE 25% POINT), AND
C     X75 (=THE 75% POINT)
C
      XMID=(XMIN+XMAX)/2.0
      X25=0.75*XMIN+0.25*XMAX 
      X75=0.25*XMIN+0.75*XMAX 
C
C     BLANK OUT THE GRAPH
C
      DO1100I=1,45
      DO1200J=1,109 
      IGRAPH(I,J)=BLANK
 1200 CONTINUE
 1100 CONTINUE
C
C     PRODUCE THE VERTICAL AXES
C
      DO1300I=3,43
      IGRAPH(I,5)=ALPHAI
      IGRAPH(I,109)=ALPHAI
 1300 CONTINUE
      DO1400I=3,43,5
      IGRAPH(I,5)=HYPHEN
      IGRAPH(I,109)=HYPHEN
 1400 CONTINUE
      IGRAPH(3,1)=EQUAL
      IGRAPH(3,2)=ALPHAM
      IGRAPH(3,3)=ALPHAA
      IGRAPH(3,4)=ALPHAX
      IGRAPH(23,1)=EQUAL
      IGRAPH(23,2)=ALPHAM
      IGRAPH(23,3)=ALPHAI
      IGRAPH(23,4)=ALPHAD
      IGRAPH(43,1)=EQUAL
      IGRAPH(43,2)=ALPHAM
      IGRAPH(43,3)=ALPHAI
      IGRAPH(43,4)=ALPHAN
C
C     PRODUCE THE HORIZONTAL AXES
C
      DO1500J=7,107 
      IGRAPH(1,J)=HYPHEN
      IGRAPH(45,J)=HYPHEN
 1500 CONTINUE
      DO1600J=7,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1600 CONTINUE
      DO1700J=20,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1700 CONTINUE
C
C     DETERMINE THE (X,Y) PLOT POSITIONS
C
      RATIOY=40.0/(YMAX-YMIN) 
      RATIOX=100.0/(XMAX-XMIN)
      DO1800I=1,N
      IF(Y(I).GE.CUTOFF)GOTO1800
      IF(X(I).GE.CUTOFF)GOTO1800
      IF(CHAR(I).GE.CUTOFF)GOTO1800
      IF(Y(I).LT.YMIN.OR.Y(I).GT.YMAX)GOTO1800
      IF(X(I).LT.XMIN.OR.X(I).GT.XMAX)GOTO1800
      MX=RATIOX*(X(I)-XMIN)+0.5
      MX=MX+7
      MY=RATIOY*(Y(I)-YMIN)+0.5
      MY=43-MY
      IARG=37
      IF(0.5.LT.CHAR(I).AND.CHAR(I).LT.36.5)IARG=CHAR(I)+0.5
      IGRAPH(MY,MX)=IPLOTC(IARG)
 1800 CONTINUE
C
C     WRITE OUT THE GRAPH
C
      DO2100I=1,45
      IP2=I+2
      IFLAG=IP2-(IP2/5)*5
      K=IP2/5
      IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109)
      IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109)
 2100 CONTINUE
      WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX
C
 2105 FORMAT(1H ,20X,109A1)
 2106 FORMAT(1H ,F20.7,109A1) 
 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7)
  998 FORMAT(1H1)
C
      RETURN
      END 
      SUBROUTINE PLOT8(Y,X,CHAR,N,YMIN,YMAX,XMIN,XMAX,
     1                  D,DMIN,DMAX)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PLOT8
C
C     PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT
C              OF Y(I) VERSUS X(I): 
C              1) WITH SPECIAL PLOT CHARACTERS;
C              2) WITH THE VERTICAL (Y) AXIS MIN AND MAX
C                 AND THE HORIZONTAL (X) AXIS MIN AND MAX
C                 VALUES SPECIFIED BY THE DATA ANALYST; AND 
C              3) WITH ONLY THOSE POINTS (X(I),Y(I)) PLOTTED
C                 FOR WHICH THE CORRESPONDING VALUE OF D(I) 
C                 IS BETWEEN THE SPECIFIED VALUES OF DMIN AND DMAX.
C
C              THE 'SPECIAL PLOTTING CHARACTER' CAPABILITY
C              ALLOWS THE DATA ANALYST TO INCORPORATE INFORMATION
C              FROM A THIRD VARIABLE (ASIDE FROM Y AND X) INTO
C              THE PLOT.
C              THE PLOT CHARACTER USED AT THE I-TH PLOTTING 
C              POSITION (THAT IS, AT THE COORDINATE (X(I),Y(I)))
C              WILL BE
C              1 IF CHAR(I) IS BETWEEN  0.5 AND  1.5
C              2 IF CHAR(I) IS BETWEEN  1.5 AND  2.5
C                .
C                .
C                .
C              9 IF CHAR(I) IS BETWEEN  8.5 AND  9.5
C              0 IF CHAR(I) IS BETWEEN  9.5 AND 10.5
C              A IF CHAR(I) IS BETWEEN 10.5 AND 11.5
C              B IF CHAR(I) IS BETWEEN 11.5 AND 12.5
C              C IF CHAR(I) IS BETWEEN 12.5 AND 13.5
C                .
C                .
C                .
C              W IF CHAR(I) IS BETWEEN 32.5 AND 33.5
C              X IF CHAR(I) IS BETWEEN 33.5 AND 34.5
C              Y IF CHAR(I) IS BETWEEN 34.5 AND 35.5
C              Z IF CHAR(I) IS BETWEEN 35.5 AND 36.5
C              X IF CHAR(I) IS ANY VALUE OUTSIDE THE RANGE
C                                       0.5 TO  36.5.
C
C              THE USE OF THE YMIN, YMAX, XMIN, AND XMAX
C              SPECIFICATIONS ALLOWS THE DATA ANALYST
C              TO CONTROL FULLY THE PLOT AXIS LIMITS,
C              SO AS, FOR EXAMPLE, TO ZERO-IN ON AN
C              INTERESTING SUB-REGION OF A PREVIOUS PLOT.
C
C              THE USE OF THE SUBSET DEFINTION VECTOR D
C              GIVES THE DATA ANALYST THE CAPABILITY OF
C              PLOTTING SUBSETS OF THE DATA,
C              WHERE THE SUBSET IS DEFINED
C              BY VALUES IN THE VECTOR D.
C
C     INPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED VERTICALLY.
C                    --X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED HORIZONTALLY. 
C                    --CHAR   = THE SINGLE PRECISION VECTOR OF
C                               OBSERVATIONS WHICH CONTROL THE
C                               VALUE OF EACH INDIVIDUAL PLOT
C                               CHARACTER.
C                    --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR Y.
C                    --YMIN   = THE SINGLE PRECISION VALUE OF
C                               DESIRED MINIMUM FOR THE VERTICAL AXIS.
C                    --YMAX   = THE SINGLE PRECISION VALUE OF
C                               DESIRED MAXIMUM FOR THE VERTICAL AXIS.
C                    --XMIN   = THE SINGLE PRECISION VALUE OF
C                               DESIRED MINIMUM FOR THE HORIZONTAL AXIS.
C                    --XMAX   = THE SINGLE PRECISION VALUE OF
C                               DESIRED MAXIMUM FOR THE HORIZONTAL AXIS.
C                    --D      = THE SINGLE PRECISION VECTOR 
C                               WHICH 'DEFINES' THE VARIOUS 
C                               POSSIBLE SUBSETS. 
C                    --DMIN   = THE SINGLE PRECISION VALUE
C                               WHICH DEFINES THE LOWER BOUND
C                               (INCLUSIVELY) OF THE PARTICULAR
C                               SUBSET OF INTEREST TO BE PLOTTED.
C                    --DMAX   = THE SINGLE PRECISION VALUE
C                               WHICH DEFINES THE UPPER BOUND
C                               (INCLUSIVELY) OF THE PARTICULAR
C                               SUBSET OF INTEREST TO BE PLOTTED.
C     OUTPUT--A ONE-PAGE PRINTER PLOT OF Y(I) VERSUS X(I),
C             WITH SPECIAL PLOT CHARACTERS,
C             WITH SPECIFIED AXIS LIMITS,
C             AND ONLY FOR A SPECIFIED SUBSET OF THE DATA.
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (Y)
C              WHICH ARE SMALLER THAN YMIN OR LARGER THAN YMAX,
C              OR VALUES IN THE HORIZONTAL AXIS VECTOR (X)
C              WHICH ARE SMALLER THAN XMIN OR LARGER THAN XMAX
C              WILL NOT BE PLOTTED.
C            --FOR A GIVEN DUMMY INDEX I,
C              IF D(I) IS SMALLER THAN DMIN OR LARGER THAN DMAX,
C              THEN THE CORRESPONDING POINT (X(I),Y(I))
C              WILL NOT BE PLOTTED.
C            --VALUES IN THE VERTICAL AXIS VECTOR (Y),
C              THE HORIZONTAL AXIS VECTOR (X),
C              OR THE PLOT CHARACTER VECTOR (CHAR) WHICH ARE
C              EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE
C              PLOTTED.
C              THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM
C              OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y
C              (OR X, OR CHAR) ARE 'MISSING DATA', OR WHEN WE PURPOSELY
C              WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y
C              (OR X, OR CHAR) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT
C              WANT CERTAIN ELEMENTS IN Y (OR X, OR CHAR) TO BE
C              PLOTTED).
C              TO CAUSE SPECIFIC ELEMENTS IN Y (OR X, OR CHAR) TO BE
C              IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND
C              (BY, FOR EXAMPLE, USE OF THE   REPLAC   SUBROUTINE)
C              BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND
C              THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTC
C              SUBROUTINE.
C     REFERENCES--FILLIBEN, 'STATISTICAL ANALYSIS OF INTERLAB
C                 FATIGUE TIME DATA', UNPUBLISHED MANUSCRIPT
C                 (AVAILABLE FROM AUTHOR)
C                 PRESENTED AT THE 'COMPUTER-ASSISTED DATA
C                 ANALYSIS' SESSION AT THE NATIONAL MEETING 
C                 OF THE AMERICAN STATISTICAL ASSOCIATION,
C                 NEW YORK CITY, DECEMBER 27-30, 1973.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JANUARY   1974. 
C     UPDATED         --OCTOBER   1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C     UPDATED         --FEBRUARY  1977. 
C     UPDATED         --JUNE      1977. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IGRAPH
      CHARACTER*4 IPLOTC
      CHARACTER*4 SBNAM1,SBNAM2
      CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 
      CHARACTER*4 ALPH41,ALPH42,ALPH91,ALPH92
      CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX
      CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL
C
      DIMENSION Y(1)
      DIMENSION X(1)
      DIMENSION D(1)
      DIMENSION CHAR(1)
      DIMENSION YLABLE(11)
      DIMENSION IPLOTC(37)
      COMMON /BLOCK1/ IGRAPH(55,130)
C
      DATA SBNAM1,SBNAM2/'PLOT','8   '/ 
      DATA ALPH11,ALPH12/'FIRS','T   '/ 
      DATA ALPH21,ALPH22/'SECO','ND  '/ 
      DATA ALPH31,ALPH32/'THIR','D   '/ 
      DATA ALPH41,ALPH42/'FOUR','TH  '/ 
      DATA ALPH91,ALPH92/'NINT','H   '/ 
      DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/
      DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/
      DATA IPLOTC(1),IPLOTC(2),IPLOTC(3),IPLOTC(4),IPLOTC(5),
     1IPLOTC(6),IPLOTC(7),IPLOTC(8),IPLOTC(9),IPLOTC(10),
     1IPLOTC(11),IPLOTC(12),IPLOTC(13),IPLOTC(14),IPLOTC(15),
     1IPLOTC(16),IPLOTC(17),IPLOTC(18),IPLOTC(19),IPLOTC(20),
     1IPLOTC(21),IPLOTC(22),IPLOTC(23),IPLOTC(24),IPLOTC(25),
     1IPLOTC(26),IPLOTC(27),IPLOTC(28),IPLOTC(29),IPLOTC(30),
     1IPLOTC(31),IPLOTC(32),IPLOTC(33),IPLOTC(34),IPLOTC(35),
     1IPLOTC(36),IPLOTC(37)
     1/'1','2','3','4','5','6','7','8','9','0','A','B','C','D','E','F',
     1'G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V',
     1'W','X','Y','Z','X'/
C
      IPR=6
      CUTOFF=(10.0**10)-1000.0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      WRITE(IPR,998)
      IF(N.LT.1)GOTO52
      GOTO54
   52 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,20)N
      WRITE(IPR,5)
      RETURN
   54 CONTINUE
      IF(N.EQ.1)GOTO56
      GOTO58
   56 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,22)N
      WRITE(IPR,5)
      RETURN
   58 CONTINUE
C
      HOLD=Y(1)
      DO60I=2,N
      IF(Y(I).NE.HOLD)GOTO62
   60 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   62 CONTINUE
      HOLD=X(1)
      DO64I=2,N
      IF(X(I).NE.HOLD)GOTO66
   64 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   66 CONTINUE
      HOLD=CHAR(1)
      DO68I=2,N
      IF(CHAR(I).NE.HOLD)GOTO70
   68 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,11) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
   70 CONTINUE
      HOLD=D(1)
      DO72I=2,N
      IF(D(I).NE.HOLD)GOTO74
   72 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,11) 
      WRITE(IPR,15)ALPH91,ALPH92,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
   74 CONTINUE
C
      DO76I=1,N
      IF(Y(I).LT.CUTOFF)GOTO78
   76 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   78 CONTINUE
      DO80I=1,N
      IF(X(I).LT.CUTOFF)GOTO82
   80 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   82 CONTINUE
      DO84I=1,N
      IF(CHAR(I).LT.CUTOFF)GOTO86
   84 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   86 CONTINUE
      DO88I=1,N
      IF(D(I).LT.CUTOFF)GOTO90
   88 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH91,ALPH92,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   90 CONTINUE
C
      DO92I=1,N
      IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)GOTO94
   92 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH91,ALPH92,SBNAM1,SBNAM2
      WRITE(IPR,34) 
      WRITE(IPR,35)DMIN,DMAX
      WRITE(IPR,36) 
      WRITE(IPR,5)
      RETURN
   94 CONTINUE
C
      N2=0
      DO96I=1,N
      IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF.AND.CHAR(I).LT.CUTOFF.AND. 
     1D(I).LT.CUTOFF)GOTO98
      GOTO96
   98 IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)N2=N2+1
      IF(N2.GE.2)GOTO99
   96 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32,
     1ALPH91,ALPH92 
      WRITE(IPR,19)SBNAM1,SBNAM2
      WRITE(IPR,40) 
      WRITE(IPR,41)N2
      WRITE(IPR,5)
      RETURN
   99 CONTINUE
C
    5 FORMAT(1H ,'**************************************************',
     1'********************') 
   10 FORMAT(1H ,'                   FATAL ERROR                    ')
   11 FORMAT(1H ,'               NON-FATAL DIAGNOSTIC               ')
   15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4,
     1' SUBROUTINE')
   18 FORMAT(1H ,'THE ',A4,A4,', ',A4,A4,', ',A4,A4,', AND ',A4,A4)
   19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE')
   20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,')')
   22 FORMAT(1H ,'HAS THE VALUE 1')
   30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8)
   32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF')
   33 FORMAT(1H ,'VALUE OF ',E15.8)
   34 FORMAT(1H ,'HAS ALL ELEMENTS OUTSIDE THE INTERVAL')
   35 FORMAT(1H ,'(',E15.8,',',E15.8,')',' AS DEFINED BY')
   36 FORMAT(1H ,'THE FIFTH  AND SIXTH  INPUT ARGUMENTS.')
   40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 
     1' EXCLUDED FROM THE PLOT.')
   41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.')
C
C-----START POINT-----------------------------------------------------
C
C     DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS
C
      DO400I=1,9
      AIM1=I-1
      YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN)
  400 CONTINUE
C
C     DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS 
C     DETERMINE XMID, X25 (=THE 25% POINT), AND
C     X75 (=THE 75% POINT)
C
      XMID=(XMIN+XMAX)/2.0
      X25=0.75*XMIN+0.25*XMAX 
      X75=0.25*XMIN+0.75*XMAX 
C
C     BLANK OUT THE GRAPH
C
      DO1100I=1,45
      DO1200J=1,109 
      IGRAPH(I,J)=BLANK
 1200 CONTINUE
 1100 CONTINUE
C
C     PRODUCE THE VERTICAL AXES
C
      DO1300I=3,43
      IGRAPH(I,5)=ALPHAI
      IGRAPH(I,109)=ALPHAI
 1300 CONTINUE
      DO1400I=3,43,5
      IGRAPH(I,5)=HYPHEN
      IGRAPH(I,109)=HYPHEN
 1400 CONTINUE
      IGRAPH(3,1)=EQUAL
      IGRAPH(3,2)=ALPHAM
      IGRAPH(3,3)=ALPHAA
      IGRAPH(3,4)=ALPHAX
      IGRAPH(23,1)=EQUAL
      IGRAPH(23,2)=ALPHAM
      IGRAPH(23,3)=ALPHAI
      IGRAPH(23,4)=ALPHAD
      IGRAPH(43,1)=EQUAL
      IGRAPH(43,2)=ALPHAM
      IGRAPH(43,3)=ALPHAI
      IGRAPH(43,4)=ALPHAN
C
C     PRODUCE THE HORIZONTAL AXES
C
      DO1500J=7,107 
      IGRAPH(1,J)=HYPHEN
      IGRAPH(45,J)=HYPHEN
 1500 CONTINUE
      DO1600J=7,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1600 CONTINUE
      DO1700J=20,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1700 CONTINUE
C
C     DETERMINE THE (X,Y) PLOT POSITIONS
C
      RATIOY=40.0/(YMAX-YMIN) 
      RATIOX=100.0/(XMAX-XMIN)
      DO1800I=1,N
      IF(Y(I).GE.CUTOFF)GOTO1800
      IF(X(I).GE.CUTOFF)GOTO1800
      IF(CHAR(I).GE.CUTOFF)GOTO1800
      IF(Y(I).LT.YMIN.OR.Y(I).GT.YMAX)GOTO1800
      IF(X(I).LT.XMIN.OR.X(I).GT.XMAX)GOTO1800
      IF(D(I).LT.DMIN)GOTO1800
      IF(D(I).GT.DMAX)GOTO1800
      MX=RATIOX*(X(I)-XMIN)+0.5
      MX=MX+7
      MY=RATIOY*(Y(I)-YMIN)+0.5
      MY=43-MY
      IARG=37
      IF(0.5.LT.CHAR(I).AND.CHAR(I).LT.36.5)IARG=CHAR(I)+0.5
      IGRAPH(MY,MX)=IPLOTC(IARG)
 1800 CONTINUE
C
C     WRITE OUT THE GRAPH
C
      DO2100I=1,45
      IP2=I+2
      IFLAG=IP2-(IP2/5)*5
      K=IP2/5
      IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109)
      IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109)
 2100 CONTINUE
      WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX
C
 2105 FORMAT(1H ,20X,109A1)
 2106 FORMAT(1H ,F20.7,109A1) 
 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7)
  998 FORMAT(1H1)
C
      RETURN
      END 
      SUBROUTINE PLOT9(Y,X,CHAR,N,YMIN,YMAX,XMIN,XMAX,
     1                 YAXID,XAXID,PLCHID)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PLOT9
C
C     PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT
C              OF Y(I) VERSUS X(I): 
C              1) WITH SPECIAL PLOT CHARACTERS;
C              2) WITH THE VERTICAL (Y) AXIS MIN AND MAX
C                 AND THE HORIZONTAL (X) AXIS MIN AND MAX
C                 VALUES SPECIFIED BY THE DATA ANALYST; AND 
C              3) WITH HOLLARITH LABELS (AT MOST 6 CHARACTERS)
C                 FOR THE VERTICAL AXIS VARIABLE, 
C                 THE HORIZONTAL AXIS VARIABLE, AND
C                 THE PLOTTING CHARACTER VARIABLE 
C                 ALSO BEING PROVIDED BY THE DATA ANALYST.
C
C              THE 'SPECIAL PLOTTING CHARACTER' CAPABILITY
C              ALLOWS THE DATA ANALYST TO INCORPORATE INFORMATION
C              FROM A THIRD VARIABLE (ASIDE FROM Y AND X) INTO
C              THE PLOT.
C              THE PLOT CHARACTER USED AT THE I-TH PLOTTING 
C              POSITION (THAT IS, AT THE COORDINATE (X(I),Y(I)))
C              WILL BE
C              1 IF CHAR(I) IS BETWEEN  0.5 AND  1.5
C              2 IF CHAR(I) IS BETWEEN  1.5 AND  2.5
C                .
C                .
C                .
C              9 IF CHAR(I) IS BETWEEN  8.5 AND  9.5
C              0 IF CHAR(I) IS BETWEEN  9.5 AND 10.5
C              A IF CHAR(I) IS BETWEEN 10.5 AND 11.5
C              B IF CHAR(I) IS BETWEEN 11.5 AND 12.5
C              C IF CHAR(I) IS BETWEEN 12.5 AND 13.5
C                .
C                .
C                .
C              W IF CHAR(I) IS BETWEEN 32.5 AND 33.5
C              X IF CHAR(I) IS BETWEEN 33.5 AND 34.5
C              Y IF CHAR(I) IS BETWEEN 34.5 AND 35.5
C              Z IF CHAR(I) IS BETWEEN 35.5 AND 36.5
C              X IF CHAR(I) IS ANY VALUE OUTSIDE THE RANGE
C                                       0.5 TO  36.5.
C
C              THE USE OF THE YMIN, YMAX, XMIN, AND XMAX
C              SPECIFICATIONS ALLOWS THE DATA ANALYST
C              TO CONTROL FULLY THE PLOT AXIS LIMITS,
C              SO AS, FOR EXAMPLE, TO ZERO-IN ON AN
C              INTERESTING SUB-REGION OF A PREVIOUS PLOT.
C
C              THE USE OF HOLLARITH IDENTIFYING LABELS
C              ALLOWS THE DATA ANALYST TO AUTOMATICALLY
C              HAVE THE PLOTS LABELED.  THIS IS PARTICULARLY
C              USEFUL IN A LARGE ANALYSIS WHEN MANY
C              PLOTS ARE BEING GENERATED.
C
C     INPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED VERTICALLY.
C                    --X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED HORIZONTALLY. 
C                    --CHAR   = THE SINGLE PRECISION VECTOR OF
C                               OBSERVATIONS WHICH CONTROL THE
C                               VALUE OF EACH INDIVIDUAL PLOT
C                               CHARACTER.
C                    --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR Y.
C                    --YMIN   = THE SINGLE PRECISION VALUE OF
C                               DESIRED MINIMUM FOR THE VERTICAL AXIS.
C                    --YMAX   = THE SINGLE PRECISION VALUE OF
C                               DESIRED MAXIMUM FOR THE VERTICAL AXIS.
C                    --XMIN   = THE SINGLE PRECISION VALUE OF
C                               DESIRED MINIMUM FOR THE HORIZONTAL AXIS.
C                    --XMAX   = THE SINGLE PRECISION VALUE OF
C                               DESIRED MAXIMUM FOR THE HORIZONTAL AXIS.
C                    --YAXID  = THE HOLLARITH VALUE
C                               (AT MOST 6 CHARACTERS)
C                               OF THE DESIRED LABEL FOR THE
C                               VERTICAL AXIS VARIABLE.
C                    --XAXID  = THE HOLLARITH VALUE
C                               (AT MOST 6 CHARACTERS)
C                               OF THE DESIRED LABEL FOR THE
C                               HORIZONTAL AXIS VARIABLE.
C                    --PLCHID = THE HOLLARITH VALUE
C                               (AT MOST 6 CHARACTERS)
C                               OF THE DESIRED LABEL FOR THE
C                               PLOTTING CHARACTER VARIABLE.
C     OUTPUT--A ONE-PAGE PRINTER PLOT OF Y(I) VERSUS X(I),
C             WITH SPECIAL PLOT CHARACTERS,
C             WITH SPECIFIED AXIS LIMITS,
C             AND WITH SPECIFIED LABELS.
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (Y)
C              WHICH ARE SMALLER THAN YMIN OR LARGER THAN YMAX,
C              OR VALUES IN THE HORIZONTAL AXIS VECTOR (X)
C              WHICH ARE SMALLER THAN XMIN OR LARGER THAN XMAX
C              WILL NOT BE PLOTTED.
C            --VALUES IN THE VERTICAL AXIS VECTOR (Y),
C              THE HORIZONTAL AXIS VECTOR (X),
C              OR THE PLOT CHARACTER VECTOR (CHAR) WHICH ARE
C              EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE
C              PLOTTED.
C              THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM
C              OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y
C              (OR X, OR CHAR) ARE 'MISSING DATA', OR WHEN WE PURPOSELY
C              WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y
C              (OR X, OR CHAR) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT
C              WANT CERTAIN ELEMENTS IN Y (OR X, OR CHAR) TO BE
C              PLOTTED).
C              TO CAUSE SPECIFIC ELEMENTS IN Y (OR X, OR CHAR) TO BE
C              IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND
C              (BY, FOR EXAMPLE, USE OF THE   REPLAC   SUBROUTINE)
C              BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND
C              THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTC
C              SUBROUTINE.
C     REFERENCES--FILLIBEN, 'STATISTICAL ANALYSIS OF INTERLAB
C                 FATIGUE TIME DATA', UNPUBLISHED MANUSCRIPT
C                 (AVAILABLE FROM AUTHOR)
C                 PRESENTED AT THE 'COMPUTER-ASSISTED DATA
C                 ANALYSIS' SESSION AT THE NATIONAL MEETING 
C                 OF THE AMERICAN STATISTICAL ASSOCIATION,
C                 NEW YORK CITY, DECEMBER 27-30, 1973.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --JUNE      1974. 
C     UPDATED         --OCTOBER   1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C     UPDATED         --FEBRUARY  1977. 
C     UPDATED         --JUNE      1977. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IGRAPH
      CHARACTER*4 IPLOTC
      CHARACTER*4 SBNAM1,SBNAM2
      CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 
      CHARACTER*4 ALPH41,ALPH42
      CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX
      CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL
C
      DIMENSION Y(1)
      DIMENSION X(1)
      DIMENSION CHAR(1)
      DIMENSION YLABLE(11)
      DIMENSION IPLOTC(37)
      COMMON /BLOCK1/ IGRAPH(55,130)
C
      DATA SBNAM1,SBNAM2/'PLOT','9   '/ 
      DATA ALPH11,ALPH12/'FIRS','T   '/ 
      DATA ALPH21,ALPH22/'SECO','ND  '/ 
      DATA ALPH31,ALPH32/'THIR','D   '/ 
      DATA ALPH41,ALPH42/'FOUR','TH  '/ 
      DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/
      DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/
      DATA IPLOTC(1),IPLOTC(2),IPLOTC(3),IPLOTC(4),IPLOTC(5),
     1IPLOTC(6),IPLOTC(7),IPLOTC(8),IPLOTC(9),IPLOTC(10),
     1IPLOTC(11),IPLOTC(12),IPLOTC(13),IPLOTC(14),IPLOTC(15),
     1IPLOTC(16),IPLOTC(17),IPLOTC(18),IPLOTC(19),IPLOTC(20),
     1IPLOTC(21),IPLOTC(22),IPLOTC(23),IPLOTC(24),IPLOTC(25),
     1IPLOTC(26),IPLOTC(27),IPLOTC(28),IPLOTC(29),IPLOTC(30),
     1IPLOTC(31),IPLOTC(32),IPLOTC(33),IPLOTC(34),IPLOTC(35),
     1IPLOTC(36),IPLOTC(37)
     1/'1','2','3','4','5','6','7','8','9','0','A','B','C','D','E','F',
     1'G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V',
     1'W','X','Y','Z','X'/
C
      IPR=6
      CUTOFF=(10.0**10)-1000.0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      WRITE(IPR,998)
      IF(N.LT.1)GOTO52
      GOTO54
   52 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,20)N
      WRITE(IPR,5)
      RETURN
   54 CONTINUE
      IF(N.EQ.1)GOTO56
      GOTO58
   56 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,22)N
      WRITE(IPR,5)
      RETURN
   58 CONTINUE
C
      HOLD=Y(1)
      DO60I=2,N
      IF(Y(I).NE.HOLD)GOTO62
   60 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   62 CONTINUE
      HOLD=X(1)
      DO64I=2,N
      IF(X(I).NE.HOLD)GOTO66
   64 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   66 CONTINUE
      HOLD=CHAR(1)
      DO68I=2,N
      IF(CHAR(I).NE.HOLD)GOTO70
   68 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,11) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
   70 CONTINUE
C
      DO76I=1,N
      IF(Y(I).LT.CUTOFF)GOTO78
   76 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   78 CONTINUE
      DO80I=1,N
      IF(X(I).LT.CUTOFF)GOTO82
   80 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   82 CONTINUE
      DO84I=1,N
      IF(CHAR(I).LT.CUTOFF)GOTO86
   84 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   86 CONTINUE
C
      N2=0
      DO96I=1,N
      IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF.AND.CHAR(I).LT.CUTOFF)GOTO98
      GOTO96
   98 N2=N2+1
      IF(N2.GE.2)GOTO99
   96 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32
      WRITE(IPR,19)SBNAM1,SBNAM2
      WRITE(IPR,40) 
      WRITE(IPR,41)N2
      WRITE(IPR,5)
      RETURN
   99 CONTINUE
C
    5 FORMAT(1H ,'**************************************************',
     1'********************') 
   10 FORMAT(1H ,'                   FATAL ERROR                    ')
   11 FORMAT(1H ,'               NON-FATAL DIAGNOSTIC               ')
   15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4,
     1' SUBROUTINE')
   18 FORMAT(1H ,'THE ',A4,A4,', ',A4,A4,', AND ',A4,A4)
   19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE')
   20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,')')
   22 FORMAT(1H ,'HAS THE VALUE 1')
   30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8)
   32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF')
   33 FORMAT(1H ,'VALUE OF ',E15.8)
   40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 
     1' EXCLUDED FROM THE PLOT.')
   41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.')
C
C-----START POINT-----------------------------------------------------
C
C     DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS
C
      DO400I=1,9
      AIM1=I-1
      YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN)
  400 CONTINUE
C
C     DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS 
C     DETERMINE XMID, X25 (=THE 25% POINT), AND
C     X75 (=THE 75% POINT)
C
      XMID=(XMIN+XMAX)/2.0
      X25=0.75*XMIN+0.25*XMAX 
      X75=0.25*XMIN+0.75*XMAX 
C
C     BLANK OUT THE GRAPH
C
      DO1100I=1,45
      DO1200J=1,109 
      IGRAPH(I,J)=BLANK
 1200 CONTINUE
 1100 CONTINUE
C
C     PRODUCE THE VERTICAL AXES
C
      DO1300I=3,43
      IGRAPH(I,5)=ALPHAI
      IGRAPH(I,109)=ALPHAI
 1300 CONTINUE
      DO1400I=3,43,5
      IGRAPH(I,5)=HYPHEN
      IGRAPH(I,109)=HYPHEN
 1400 CONTINUE
      IGRAPH(3,1)=EQUAL
      IGRAPH(3,2)=ALPHAM
      IGRAPH(3,3)=ALPHAA
      IGRAPH(3,4)=ALPHAX
      IGRAPH(23,1)=EQUAL
      IGRAPH(23,2)=ALPHAM
      IGRAPH(23,3)=ALPHAI
      IGRAPH(23,4)=ALPHAD
      IGRAPH(43,1)=EQUAL
      IGRAPH(43,2)=ALPHAM
      IGRAPH(43,3)=ALPHAI
      IGRAPH(43,4)=ALPHAN
C
C     PRODUCE THE HORIZONTAL AXES
C
      DO1500J=7,107 
      IGRAPH(1,J)=HYPHEN
      IGRAPH(45,J)=HYPHEN
 1500 CONTINUE
      DO1600J=7,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1600 CONTINUE
      DO1700J=20,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1700 CONTINUE
C
C     DETERMINE THE (X,Y) PLOT POSITIONS
C
      RATIOY=40.0/(YMAX-YMIN) 
      RATIOX=100.0/(XMAX-XMIN)
      DO1800I=1,N
      IF(Y(I).GE.CUTOFF)GOTO1800
      IF(X(I).GE.CUTOFF)GOTO1800
      IF(CHAR(I).GE.CUTOFF)GOTO1800
      IF(Y(I).LT.YMIN.OR.Y(I).GT.YMAX)GOTO1800
      IF(X(I).LT.XMIN.OR.X(I).GT.XMAX)GOTO1800
      MX=RATIOX*(X(I)-XMIN)+0.5
      MX=MX+7
      MY=RATIOY*(Y(I)-YMIN)+0.5
      MY=43-MY
      IARG=37
      IF(0.5.LT.CHAR(I).AND.CHAR(I).LT.36.5)IARG=CHAR(I)+0.5
      IGRAPH(MY,MX)=IPLOTC(IARG)
 1800 CONTINUE
C
C     WRITE OUT THE GRAPH
C
      DO2100I=1,45
      IP2=I+2
      IFLAG=IP2-(IP2/5)*5
      K=IP2/5
      IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109)
      IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109)
 2100 CONTINUE
      WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX
C
      WRITE(IPR,2115)YAXID,XAXID,PLCHID 
      WRITE(IPR,2116)N
 2105 FORMAT(1H ,20X,109A1)
 2106 FORMAT(1H ,F20.7,109A1) 
 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7)
 2115 FORMAT(1H ,9X,A4,A4,' (VERTICAL AXIS) VERSUS ',A4,A4, 
     1' (HORIZONTAL AXIS)',20X,'THE PLOTTING CHARACTER IS ',A4,A4)
 2116 FORMAT(1H ,83X,'THE NUMBER OF OBSERVATIONS PLOTTED IS ',I8)
  998 FORMAT(1H1)
C
      RETURN
      END 
      SUBROUTINE PLOTC(Y,X,CHAR,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PLOTC
C
C     PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT
C              OF Y(I) VERSUS X(I) WITH SPECIAL PLOTTING
C              CHARACTERS.
C              THIS 'SPECIAL PLOTTING CHARACTER' CAPABILITY 
C              ALLOWS THE DATA ANALYST TO INCORPORATE INFORMATION
C              FROM A THIRD VARIABLE (ASIDE FROM Y AND X) INTO
C              THE PLOT.
C              THE PLOT CHARACTER USED AT THE I-TH PLOTTING 
C              POSITION (THAT IS, AT THE COORDINATE (X(I),Y(I)))
C              WILL BE
C              1 IF CHAR(I) IS BETWEEN  0.5 AND  1.5
C              2 IF CHAR(I) IS BETWEEN  1.5 AND  2.5
C                .
C                .
C                .
C              9 IF CHAR(I) IS BETWEEN  8.5 AND  9.5
C              0 IF CHAR(I) IS BETWEEN  9.5 AND 10.5
C              A IF CHAR(I) IS BETWEEN 10.5 AND 11.5
C              B IF CHAR(I) IS BETWEEN 11.5 AND 12.5
C              C IF CHAR(I) IS BETWEEN 12.5 AND 13.5
C                .
C                .
C                .
C              W IF CHAR(I) IS BETWEEN 32.5 AND 33.5
C              X IF CHAR(I) IS BETWEEN 33.5 AND 34.5
C              Y IF CHAR(I) IS BETWEEN 34.5 AND 35.5
C              Z IF CHAR(I) IS BETWEEN 35.5 AND 36.5
C              X IF CHAR(I) IS ANY VALUE OUTSIDE THE RANGE
C                                       0.5 TO  36.5.
C     INPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED VERTICALLY.
C                    --X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED HORIZONTALLY. 
C                    --CHAR   = THE SINGLE PRECISION VECTOR OF
C                               OBSERVATIONS WHICH CONTROL THE
C                               VALUE OF EACH INDIVIDUAL PLOT
C                               CHARACTER.
C                    --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR Y.
C     OUTPUT--A ONE-PAGE PRINTER PLOT OF Y(I) VERSUS X(I)
C             WITH SPECIAL PLOT CHARACTERS.
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (Y),
C              THE HORIZONTAL AXIS VECTOR (X),
C              OR THE PLOT CHARACTER VECTOR (CHAR) WHICH ARE
C              EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE
C              PLOTTED.
C              THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM
C              OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y
C              (OR X, OR CHAR) ARE 'MISSING DATA', OR WHEN WE PURPOSELY
C              WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y
C              (OR X, OR CHAR) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT
C              WANT CERTAIN ELEMENTS IN Y (OR X, OR CHAR) TO BE
C              PLOTTED).
C              TO CAUSE SPECIFIC ELEMENTS IN Y (OR X, OR CHAR) TO BE
C              IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND
C              (BY, FOR EXAMPLE, USE OF THE   REPLAC   SUBROUTINE)
C              BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND
C              THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTC
C              SUBROUTINE.
C     REFERENCES--FILLIBEN, 'STATISTICAL ANALYSIS OF INTERLAB
C                 FATIGUE TIME DATA', UNPUBLISHED MANUSCRIPT
C                 (AVAILABLE FROM AUTHOR)
C                 PRESENTED AT THE 'COMPUTER-ASSISTED DATA
C                 ANALYSIS' SESSION AT THE NATIONAL MEETING 
C                 OF THE AMERICAN STATISTICAL ASSOCIATION,
C                 NEW YORK CITY, DECEMBER 27-30, 1973.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--OCTOBER   1974. 
C     UPDATED         --NOVEMBER  1974. 
C     UPDATED         --JANUARY   1975. 
C     UPDATED         --JULY      1975. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --OCTOBER   1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C     UPDATED         --FEBRUARY  1977. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IGRAPH
      CHARACTER*4 IPLOTC
      CHARACTER*4 SBNAM1,SBNAM2
      CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 
      CHARACTER*4 ALPH41,ALPH42
      CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX
      CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL
C
      DIMENSION Y(1)
      DIMENSION X(1)
      DIMENSION CHAR(1)
      DIMENSION YLABLE(11)
      DIMENSION IPLOTC(37)
      COMMON /BLOCK1/ IGRAPH(55,130)
C
      DATA SBNAM1,SBNAM2/'PLOT','C   '/ 
      DATA ALPH11,ALPH12/'FIRS','T   '/ 
      DATA ALPH21,ALPH22/'SECO','ND  '/ 
      DATA ALPH31,ALPH32/'THIR','D   '/ 
      DATA ALPH41,ALPH42/'FOUR','TH  '/ 
      DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/
      DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/
      DATA IPLOTC(1),IPLOTC(2),IPLOTC(3),IPLOTC(4),IPLOTC(5),
     1IPLOTC(6),IPLOTC(7),IPLOTC(8),IPLOTC(9),IPLOTC(10),
     1IPLOTC(11),IPLOTC(12),IPLOTC(13),IPLOTC(14),IPLOTC(15),
     1IPLOTC(16),IPLOTC(17),IPLOTC(18),IPLOTC(19),IPLOTC(20),
     1IPLOTC(21),IPLOTC(22),IPLOTC(23),IPLOTC(24),IPLOTC(25),
     1IPLOTC(26),IPLOTC(27),IPLOTC(28),IPLOTC(29),IPLOTC(30),
     1IPLOTC(31),IPLOTC(32),IPLOTC(33),IPLOTC(34),IPLOTC(35),
     1IPLOTC(36),IPLOTC(37)
     1/'1','2','3','4','5','6','7','8','9','0','A','B','C','D','E','F',
     1'G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V',
     1'W','X','Y','Z','X'/
C
      IPR=6
      CUTOFF=(10.0**10)-1000.0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      WRITE(IPR,998)
      IF(N.LT.1)GOTO52
      GOTO54
   52 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,20)N
      WRITE(IPR,5)
      RETURN
   54 CONTINUE
      IF(N.EQ.1)GOTO56
      GOTO58
   56 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,22)N
      WRITE(IPR,5)
      RETURN
   58 CONTINUE
C
      HOLD=Y(1)
      DO60I=2,N
      IF(Y(I).NE.HOLD)GOTO62
   60 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   62 CONTINUE
      HOLD=X(1)
      DO64I=2,N
      IF(X(I).NE.HOLD)GOTO66
   64 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   66 CONTINUE
      HOLD=CHAR(1)
      DO68I=2,N
      IF(CHAR(I).NE.HOLD)GOTO70
   68 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,11) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
   70 CONTINUE
C
      DO76I=1,N
      IF(Y(I).LT.CUTOFF)GOTO78
   76 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   78 CONTINUE
      DO80I=1,N
      IF(X(I).LT.CUTOFF)GOTO82
   80 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   82 CONTINUE
      DO84I=1,N
      IF(CHAR(I).LT.CUTOFF)GOTO86
   84 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   86 CONTINUE
C
      N2=0
      DO96I=1,N
      IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF.AND.CHAR(I).LT.CUTOFF)GOTO98
      GOTO96
   98 N2=N2+1
      IF(N2.GE.2)GOTO99
   96 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32
      WRITE(IPR,19)SBNAM1,SBNAM2
      WRITE(IPR,40) 
      WRITE(IPR,41)N2
      WRITE(IPR,5)
      RETURN
   99 CONTINUE
C
    5 FORMAT(1H ,'**************************************************',
     1'********************') 
   10 FORMAT(1H ,'                   FATAL ERROR                    ')
   11 FORMAT(1H ,'               NON-FATAL DIAGNOSTIC               ')
   15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4,
     1' SUBROUTINE')
   18 FORMAT(1H ,'THE ',A4,A4,2H, ,A4,A4,', AND ',A4,A4)
   19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE')
   20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,1H))
   22 FORMAT(1H ,'HAS THE VALUE 1')
   30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8)
   32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF')
   33 FORMAT(1H ,'VALUE OF ',E15.8)
   40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 
     1' EXCLUDED FROM THE PLOT.')
   41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.')
C
C-----START POINT-----------------------------------------------------
C
C     DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS
C
      DO200I=1,N
      IF(Y(I).GE.CUTOFF)GOTO200
      IF(X(I).GE.CUTOFF)GOTO200
      IF(CHAR(I).GE.CUTOFF)GOTO200
      YMIN=Y(I)
      YMAX=Y(I)
      GOTO250
  200 CONTINUE
  250 DO300I=1,N
      IF(Y(I).GE.CUTOFF)GOTO300
      IF(X(I).GE.CUTOFF)GOTO300
      IF(CHAR(I).GE.CUTOFF)GOTO300
      IF(Y(I).LT.YMIN)YMIN=Y(I)
      IF(Y(I).GT.YMAX)YMAX=Y(I)
  300 CONTINUE
      DO400I=1,9
      AIM1=I-1
      YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN)
  400 CONTINUE
C
C     DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS 
C     DETERMINE XMIN, XMAX, XMID, X25 (=THE 25% POINT), AND 
C     X75 (=THE 75% POINT)
C
      DO600I=1,N
      IF(Y(I).GE.CUTOFF)GOTO600
      IF(X(I).GE.CUTOFF)GOTO600
      IF(CHAR(I).GE.CUTOFF)GOTO600
      XMIN=X(I)
      XMAX=X(I)
      GOTO650
  600 CONTINUE
  650 DO700I=1,N
      IF(Y(I).GE.CUTOFF)GOTO700
      IF(X(I).GE.CUTOFF)GOTO700
      IF(CHAR(I).GE.CUTOFF)GOTO700
      IF(X(I).LT.XMIN)XMIN=X(I)
      IF(X(I).GT.XMAX)XMAX=X(I)
  700 CONTINUE
      XMID=(XMIN+XMAX)/2.0
      X25=0.75*XMIN+0.25*XMAX 
      X75=0.25*XMIN+0.75*XMAX 
C
C     BLANK OUT THE GRAPH
C
      DO1100I=1,45
      DO1200J=1,109 
      IGRAPH(I,J)=BLANK
 1200 CONTINUE
 1100 CONTINUE
C
C     PRODUCE THE VERTICAL AXES
C
      DO1300I=3,43
      IGRAPH(I,5)=ALPHAI
      IGRAPH(I,109)=ALPHAI
 1300 CONTINUE
      DO1400I=3,43,5
      IGRAPH(I,5)=HYPHEN
      IGRAPH(I,109)=HYPHEN
 1400 CONTINUE
      IGRAPH(3,1)=EQUAL
      IGRAPH(3,2)=ALPHAM
      IGRAPH(3,3)=ALPHAA
      IGRAPH(3,4)=ALPHAX
      IGRAPH(23,1)=EQUAL
      IGRAPH(23,2)=ALPHAM
      IGRAPH(23,3)=ALPHAI
      IGRAPH(23,4)=ALPHAD
      IGRAPH(43,1)=EQUAL
      IGRAPH(43,2)=ALPHAM
      IGRAPH(43,3)=ALPHAI
      IGRAPH(43,4)=ALPHAN
C
C     PRODUCE THE HORIZONTAL AXES
C
      DO1500J=7,107 
      IGRAPH(1,J)=HYPHEN
      IGRAPH(45,J)=HYPHEN
 1500 CONTINUE
      DO1600J=7,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1600 CONTINUE
      DO1700J=20,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1700 CONTINUE
C
C     DETERMINE THE (X,Y) PLOT POSITIONS
C
      RATIOY=40.0/(YMAX-YMIN) 
      RATIOX=100.0/(XMAX-XMIN)
      DO1800I=1,N
      IF(Y(I).GE.CUTOFF)GOTO1800
      IF(X(I).GE.CUTOFF)GOTO1800
      IF(CHAR(I).GE.CUTOFF)GOTO1800
      MX=RATIOX*(X(I)-XMIN)+0.5
      MX=MX+7
      MY=RATIOY*(Y(I)-YMIN)+0.5
      MY=43-MY
      IARG=37
      IF(0.5.LT.CHAR(I).AND.CHAR(I).LT.36.5)IARG=CHAR(I)+0.5
      IGRAPH(MY,MX)=IPLOTC(IARG)
 1800 CONTINUE
C
C     WRITE OUT THE GRAPH
C
      DO2100I=1,45
      IP2=I+2
      IFLAG=IP2-(IP2/5)*5
      K=IP2/5
      IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109)
      IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109)
 2100 CONTINUE
      WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX
C
 2105 FORMAT(1H ,20X,109A1)
 2106 FORMAT(1H ,F20.7,109A1) 
 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7)
  998 FORMAT(1H1)
C
      RETURN
      END 
      SUBROUTINE PLOTCO(Y,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PLOTCO
C
C     THIS ROUTINE YIELDS A MULTI-PAGE (IF NECESSARY) PLOT OF THE AUTOCORRELATIO
C     COEFFICIENT R(K) VERSUS THE LAG K 
C     THERE IS NO RESTRICTION ON THE MAXIMUM VALUE OF N FOR THIS ROUTINE.
C     PRINTING--YES 
C     SUBROUTINES NEEDED--NONE
C     WRITTEN BY JAMES J. FILLIBEN, STATISTICAL ENGINEERING LABORATORY (205.03) 
C     NATIONAL BUREAU OF STANDARDS, WASHINGTON, D.C. 20234     JUN 1972
C                                                      UPDATED FEB 1975
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IGRAPH
      CHARACTER*4 BLANK,STAR,HYPHEN,ALPHAI
      DIMENSION Y(1)
      COMMON /BLOCK1/ IGRAPH(55,130)
      DIMENSION YLABLE(11)
      DIMENSION IX(25)
C
      DATA BLANK,STAR,HYPHEN,ALPHAI/' ','*','-','I'/
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=Y(1)
      DO60I=2,N
      IF(Y(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,   '***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE PLOTCO SUBROUTINE HAS ALL ELEMENTS = ' ,
     1E15.8,' *****')
   15 FORMAT(1H ,   '***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 PLOTCO SUBROUTINE IS NON-POSITIVE *****')
   18 FORMAT(1H ,   '***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE PLOTCO SUBROUTINE HAS THE VALUE 1 *****')
   47 FORMAT(1H , '***** THE VALUE OF THE ARGUMENT IS ',I8   ,' *****')
C
C-----START POINT-----------------------------------------------------
C
C     DETERMINE THE Y VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS
C
      YMIN=-1.0
      YMAX=1.0
      DO110I=1,11
      YLABLE(I)=FLOAT(6-I)/5.0
  110 CONTINUE
C
C     DETERMINE DISTANCES BETWEEN HORIZONTAL PLOT POINTS AND DISTANCES BETWEEN
C     HASH MARKS ON THE X AXIS
C
      IF(N.LE.24)IDEL=5
      IF(25.LE.N.AND.N.LE.40)IDEL=3
      IF(41.LE.N.AND.N.LE.60)IDEL=2
      IF(61.LE.N)IDEL=1
      IAXDEL=10
      IF(N.LE.24)IAXDEL=5
      IF(25.LE.N.AND.N.LE.40)IAXDEL=15
C
C     DETERMINE THE NUMBER OF PAGES THE PLOT WILL TAKE UP
C
      NUMPAG=((N-1)/120)+1
C
C     OPERATE  ON EACH PAGE
C
      DO120IZ=1,NUMPAG
C
C     DETERMINE THE X-AXIS VALUES
C
      IXMIN=0
      IXMAX=N
      IF(N.LE.24)GOTO130
      IF(25.LE.N.AND.N.LE.40)GOTO135
      IF(41.LE.N.AND.N.LE.60)GOTO140
      IXMAX=120*IZ
      IXMIN=IXMAX-120
      I=0 
  150 I=I+1
      IX(I)=IXMIN+10*(I-1)
      IF(I.LT.13)GOTO150
      GOTO145
  130 DO131I=1,25
      IX(I)=I-1
  131 CONTINUE
      GOTO145
  135 DO136I=1,9
      IX(I)=5*(I-1) 
  136 CONTINUE
      GOTO145
  140 DO141I=1,13
      IX(I)=5*(I-1) 
  141 CONTINUE
C
C     BLANK OUT THE GRAPH
C
  145 DO100I=1,55
      DO200J=1,130
      IGRAPH(I,J)=BLANK
  200 CONTINUE
  100 CONTINUE
C
C     PRODUCE THE Y AXIS
C
      DO300I=5,55
      IGRAPH(I,10)=ALPHAI
      IGRAPH(I,130)=ALPHAI
  300 CONTINUE
      DO350I=5,55,5 
      IGRAPH(I,10)=HYPHEN
      IGRAPH(I,130)=HYPHEN
  350 CONTINUE
C
C     PRODUCE THE X AXIS
C
      DO400J=10,130 
      IGRAPH(55,J)=HYPHEN
      IGRAPH(30,J)=HYPHEN
      IGRAPH(5,J)=HYPHEN
  400 CONTINUE
      DO450J=10,130,IAXDEL
      IGRAPH(55,J)=ALPHAI
      IGRAPH(5,J)=ALPHAI
  450 CONTINUE
C
C     DETERMINE THE (X,Y) PLOT POSITIONS
C
      IMIN=IXMIN+1
      IMAX=IXMAX
      IF(IMAX.GT.N)IMAX=N
      RATIOY=50.0/(YMAX-YMIN) 
      DO600I=IMIN,IMAX
      MX=MOD(I,120) 
      MX=MX*IDEL
      IF(MX.EQ.0)MX=120
      MX=MX+10
      MY=RATIOY*(Y(I)-YMIN)+0.5
      MY=55-MY
      IGRAPH(MY,MX)=STAR
      JMAX=MAX0(MY,30)
      JMIN=MIN0(MY,30)
      DO650J=JMIN,JMAX
      IGRAPH(J,MX)=STAR
  650 CONTINUE
  600 CONTINUE
C
C     WRITE OUT THE GRAPH
C
      WRITE(IPR,998)
      IF(IZ.EQ.1)WRITE(IPR,702)N
      IF(IZ.GE.2)WRITE(IPR,704)
      WRITE(IPR,999)
      IF(N.LE.24)WRITE(IPR,707)(IX(I),I=1,25)
      IF(25.LE.N.AND.N.LE.40)WRITE(IPR,708)(IX(I),I=1,9)
      IF(41.LE.N)WRITE(IPR,709)(IX(I),I=1,13)
      DO700I=5,55
      IFLAG=I-(I/5)*5
      K=I/5
      IF(IFLAG.NE.0)WRITE(IPR,705)(IGRAPH(I,J),J=1,130)
      IF(IFLAG.EQ.0)WRITE(IPR,706)YLABLE(K),(IGRAPH(I,J),J=10,130)
  700 CONTINUE
      IF(N.LE.24)WRITE(IPR,707)(IX(I),I=1,25)
      IF(25.LE.N.AND.N.LE.40)WRITE(IPR,708)(IX(I),I=1,9)
      IF(41.LE.N)WRITE(IPR,709)(IX(I),I=1,13)
  120 CONTINUE
  702 FORMAT(' THE TOTAL NUMBER OF POINTS PLOTTED (ON ALL PAGES) IS ',
     1I5) 
  704 FORMAT(1H ,  'THE PLOT ON THIS PAGE IS A CONTINUATION OF THE PLOT
     1ON THE PREVIOUS PAGE')
  705 FORMAT(1H ,130A1)
  706 FORMAT(1H ,F9.2,130A1)
  707 FORMAT(1H ,6X,24(I4,1X),I4)
  708 FORMAT(1H ,6X,8(I4,11X),I4)
  709 FORMAT(1H ,6X,12(I4,6X),I4)
  998 FORMAT(1H1)
  999 FORMAT(1H )
      RETURN
      END 
      SUBROUTINE PLOTCT(Y,X,CHAR,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PLOTCT
C
C     PURPOSE--THIS SUBROUTINE YIELDS A NARROW-WIDTH (71-CHARACTER)
C              PLOT OF Y(I) VERSUS X(I) WITH SPECIAL PLOTTING
C              CHARACTERS.
C              ITS NARROW WIDTH MAKES IT APPROPRIATE FOR USE ON A
C              TERMINAL.
C              THIS 'SPECIAL PLOTTING CHARACTER' CAPABILITY 
C              ALLOWS THE DATA ANALYST TO INCORPORATE INFORMATION
C              FROM A THIRD VARIABLE (ASIDE FROM Y AND X) INTO
C              THE PLOT.
C              THE PLOT CHARACTER USED AT THE I-TH PLOTTING 
C              POSITION (THAT IS, AT THE COORDINATE (X(I),Y(I)))
C              WILL BE
C              1 IF CHAR(I) IS BETWEEN  0.5 AND  1.5
C              2 IF CHAR(I) IS BETWEEN  1.5 AND  2.5
C                .
C                .
C                .
C              9 IF CHAR(I) IS BETWEEN  8.5 AND  9.5
C              0 IF CHAR(I) IS BETWEEN  9.5 AND 10.5
C              A IF CHAR(I) IS BETWEEN 10.5 AND 11.5
C              B IF CHAR(I) IS BETWEEN 11.5 AND 12.5
C              C IF CHAR(I) IS BETWEEN 12.5 AND 13.5
C                .
C                .
C                .
C              W IF CHAR(I) IS BETWEEN 32.5 AND 33.5
C              X IF CHAR(I) IS BETWEEN 33.5 AND 34.5
C              Y IF CHAR(I) IS BETWEEN 34.5 AND 35.5
C              Z IF CHAR(I) IS BETWEEN 35.5 AND 36.5
C              X IF CHAR(I) IS ANY VALUE OUTSIDE THE RANGE
C                                       0.5 TO  36.5.
C     INPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED VERTICALLY.
C                    --X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED HORIZONTALLY. 
C                    --CHAR   = THE SINGLE PRECISION VECTOR OF
C                               OBSERVATIONS WHICH CONTROL THE
C                               VALUE OF EACH INDIVIDUAL PLOT
C                               CHARACTER.
C                    --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR Y.
C     OUTPUT--A NARROW-WIDTH (71-CHARACTER) TERMINAL PLOT
C             OF Y(I) VERSUS X(I) WITH SPECIAL PLOT CHARACTERS.
C             THE BODY OF THE PLOT (NOT COUNTING AXIS VALUES
C             AND MARGINS) IS 25 ROWS (LINES) AND 49 COLUMNS.
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (Y),
C              THE HORIZONTAL AXIS VECTOR (X),
C              OR THE PLOT CHARACTER VECTOR (CHAR) WHICH ARE
C              EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE
C              PLOTTED.
C              THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM
C              OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y
C              (OR X, OR CHAR) ARE 'MISSING DATA', OR WHEN WE PURPOSELY
C              WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y
C              (OR X, OR CHAR) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT
C              WANT CERTAIN ELEMENTS IN Y (OR X, OR CHAR) TO BE
C              PLOTTED).
C              TO CAUSE SPECIFIC ELEMENTS IN Y (OR X, OR CHAR) TO BE
C              IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND
C              (BY, FOR EXAMPLE, USE OF THE   REPLAC   SUBROUTINE)
C              BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND
C              THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTC
C              SUBROUTINE.
C            --NOTE THAT THE STORAGE REQUIREMENTS FOR THIS
C              (AND THE OTHER) TERMINAL PLOT SUBROUTINESS ARE .
C              VERY SMALL.
C              THIS IS DUE TO THE 'ONE LINE AT A TIME' ALGORITHM
C              EMPLOYED FOR THE PLOT.
C     REFERENCES--FILLIBEN, 'STATISTICAL ANALYSIS OF INTERLAB
C                 FATIGUE TIME DATA', UNPUBLISHED MANUSCRIPT
C                 (AVAILABLE FROM AUTHOR)
C                 PRESENTED AT THE 'COMPUTER-ASSISTED DATA
C                 ANALYSIS' SESSION AT THE NATIONAL MEETING 
C                 OF THE AMERICAN STATISTICAL ASSOCIATION,
C                 NEW YORK CITY, DECEMBER 27-30, 1973.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--FEBRUARY  1974. 
C     UPDATED         --APRIL     1974. 
C     UPDATED         --OCTOBER   1974. 
C     UPDATED         --OCTOBER   1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1977. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 ILINE
      CHARACTER*4 IPLOTC
      CHARACTER*4 JPLOTC
      CHARACTER*4 IAXISC
      CHARACTER*4 SBNAM1,SBNAM2
      CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 
      CHARACTER*4 ALPH41,ALPH42
      CHARACTER*4 BLANK,HYPHEN,ALPHAI
C
      DIMENSION Y(1)
      DIMENSION X(1)
      DIMENSION CHAR(1)
      DIMENSION ILINE(72),XLABLE(10)
      DIMENSION IPLOTC(37)
C
      DATA SBNAM1,SBNAM2/'PLOT','CT  '/ 
      DATA ALPH11,ALPH12/'FIRS','T   '/ 
      DATA ALPH21,ALPH22/'SECO','ND  '/ 
      DATA ALPH31,ALPH32/'THIR','D   '/ 
      DATA ALPH41,ALPH42/'FOUR','TH  '/ 
      DATA BLANK,HYPHEN,ALPHAI/' ','-','I'/
      DATA IPLOTC(1),IPLOTC(2),IPLOTC(3),IPLOTC(4),IPLOTC(5),
     1IPLOTC(6),IPLOTC(7),IPLOTC(8),IPLOTC(9),IPLOTC(10),
     1IPLOTC(11),IPLOTC(12),IPLOTC(13),IPLOTC(14),IPLOTC(15),
     1IPLOTC(16),IPLOTC(17),IPLOTC(18),IPLOTC(19),IPLOTC(20),
     1IPLOTC(21),IPLOTC(22),IPLOTC(23),IPLOTC(24),IPLOTC(25),
     1IPLOTC(26),IPLOTC(27),IPLOTC(28),IPLOTC(29),IPLOTC(30),
     1IPLOTC(31),IPLOTC(32),IPLOTC(33),IPLOTC(34),IPLOTC(35),
     1IPLOTC(36),IPLOTC(37)
     1/'1','2','3','4','5','6','7','8','9','0','A','B','C','D','E','F',
     1'G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V',
     1'W','X','Y','Z','X'/
C
      IPR=6
      CUTOFF=(10.0**10)-1000.0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO52
      GOTO54
   52 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,20)N
      WRITE(IPR,5)
      RETURN
   54 CONTINUE
      IF(N.EQ.1)GOTO56
      GOTO58
   56 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,22)N
      WRITE(IPR,5)
      RETURN
   58 CONTINUE
C
      HOLD=Y(1)
      DO60I=2,N
      IF(Y(I).NE.HOLD)GOTO62
   60 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   62 CONTINUE
      HOLD=X(1)
      DO64I=2,N
      IF(X(I).NE.HOLD)GOTO66
   64 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   66 CONTINUE
      HOLD=CHAR(1)
      DO68I=2,N
      IF(CHAR(I).NE.HOLD)GOTO70
   68 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,11) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
   70 CONTINUE
C
      DO76I=1,N
      IF(Y(I).LT.CUTOFF)GOTO78
   76 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   78 CONTINUE
      DO80I=1,N
      IF(X(I).LT.CUTOFF)GOTO82
   80 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   82 CONTINUE
      DO84I=1,N
      IF(CHAR(I).LT.CUTOFF)GOTO86
   84 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   86 CONTINUE
C
      N2=0
      DO96I=1,N
      IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF.AND.CHAR(I).LT.CUTOFF)GOTO98
      GOTO96
   98 N2=N2+1
      IF(N2.GE.2)GOTO99
   96 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32
      WRITE(IPR,19)SBNAM1,SBNAM2
      WRITE(IPR,40) 
      WRITE(IPR,41)N2
      WRITE(IPR,5)
      RETURN
   99 CONTINUE
C
    5 FORMAT(1H ,'**************************************************',
     1'********************') 
   10 FORMAT(1H ,'                   FATAL ERROR                    ')
   11 FORMAT(1H ,'               NON-FATAL DIAGNOSTIC               ')
   15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4,
     1' SUBROUTINE')
   18 FORMAT(1H ,'THE ',A4,A4,2H, ,A4,A4,', AND ',A4,A4)
   19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE')
   20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,')')
   22 FORMAT(1H ,'HAS THE VALUE 1')
   30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8)
   32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF')
   33 FORMAT(1H ,'VALUE OF ',E15.8)
   40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 
     1' EXCLUDED FROM THE PLOT.')
   41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.')
C
C-----START POINT-----------------------------------------------------
C
C     DEFINE THE NUMBER OF ROWS AND COLUMNS WITHIN THE PLOT--THIS HAS 
C     BEEN SET TO 25 ROWS AND 49 COLUMNS.
C
      NUMROW=25
      NUMCOL=49
      ANUMR=NUMROW
      ANUMRM=NUMROW-1
      ANUMCM=NUMCOL-1
      NUMR25=(NUMROW/4)+1
      NUMR50=(NUMROW/2)+1
      NUMR75=3*(NUMROW/4)+1
      IXDEL=(NUMCOL-1)/4
      NUMLAB=5
      ANUMLM=NUMLAB-1
C
C     SKIP A LINE, WRITE OUT AN IDENTIFYING LINE FOR THE TYPE OF PLOT,
C     WRITE OUT THE TOP HORIZONTAL AXIS OF THE PLOT, AND SKIP 1 LINE
C     FOR A MARGIN WITHIN THE PLOT.
C
      WRITE(IPR,999)
      WRITE(IPR,205)
      DO100ICOL=1,NUMCOL
      ILINE(ICOL)=HYPHEN
  100 CONTINUE
      DO200ICOL=1,NUMCOL,IXDEL
      ILINE(ICOL)=ALPHAI
  200 CONTINUE
      WRITE(IPR,305)(ILINE(I),I=1,NUMCOL)
      WRITE(IPR,310)BLANK
C
C     DETERMINE THE MIN AND MAX VALUES OF Y, AND OF X.
C
      DO250I=1,N
      IF(Y(I).GE.CUTOFF)GOTO250
      IF(X(I).GE.CUTOFF)GOTO250
      IF(CHAR(I).GE.CUTOFF)GOTO250
      YMIN=Y(I)
      YMAX=Y(I)
      XMIN=X(I)
      XMAX=X(I)
      GOTO270
  250 CONTINUE
  270 DO300I=1,N
      IF(Y(I).GE.CUTOFF)GOTO300
      IF(X(I).GE.CUTOFF)GOTO300
      IF(CHAR(I).GE.CUTOFF)GOTO300
      IF(Y(I).LT.YMIN)YMIN=Y(I)
      IF(Y(I).GT.YMAX)YMAX=Y(I)
      IF(X(I).LT.XMIN)XMIN=X(I)
      IF(X(I).GT.XMAX)XMAX=X(I)
  300 CONTINUE
      DELY=YMAX-YMIN
      DELX=XMAX-XMIN
      YWIDTH=DELY/ANUMRM
      XWIDTH=DELX/ANUMCM
C
C     DETERMINE AND WRITE OUT THE PLOT POSITIONS ONE LINE AT A TIME.
C     ALSO DETERMINE THE APPROPRIATE PLOT CHARACTERS.
C
      DO400IROW=1,NUMROW
      DO500ICOL=1,NUMCOL
      ILINE(ICOL)=BLANK
  500 CONTINUE
      AIROW=IROW
      YUPPER=YMAX+(1.5-AIROW)*YWIDTH
      YLABLE=YMAX+(1.0-AIROW)*YWIDTH
      YLOWER=YMAX+(0.5-AIROW)*YWIDTH
      IF(IROW.EQ.NUMROW)YLABLE=YMIN
      DO600I=1,N
      IF(Y(I).GE.CUTOFF)GOTO600
      IF(X(I).GE.CUTOFF)GOTO600
      IF(CHAR(I).GE.CUTOFF)GOTO600
      IF(YLOWER.LE.Y(I).AND.Y(I).LT.YUPPER)GOTO650
      GOTO600
  650 ICOL=((X(I)-XMIN)/XWIDTH)+1.5
      IA=CHAR(I)+0.5
      IF(1.LE.IA.AND.IA.LE.36)GOTO630
  620 JPLOTC=IPLOTC(37)
      GOTO640
  630 JPLOTC=IPLOTC(IA)
  640 ILINE(ICOL)=JPLOTC
  600 CONTINUE
      ICOLMX=1
      DO700ICOL=1,NUMCOL
      IF(ILINE(ICOL).NE.BLANK)ICOLMX=ICOL
  700 CONTINUE
      IAXISC=ALPHAI 
      IF(IROW.EQ.1.OR.IROW.EQ.NUMROW)IAXISC=HYPHEN
      IF(IROW.EQ.NUMR25.OR.IROW.EQ.NUMR50.OR.IROW.EQ.NUMR75)
     1IAXISC=HYPHEN 
      WRITE(IPR,710)YLABLE,IAXISC,(ILINE(ICOL),ICOL=1,ICOLMX)
  400 CONTINUE
C
C     SKIP 1 LINE FOR A BOTTOM MARGIN WITHIN THE PLOT, WRITE OUT THE
C     BOTTOM HORIZONTAL AXIS, AND WRITE OUT THE X AXIS LABLES.
C
      WRITE(IPR,310)BLANK
      DO800ICOL=1,NUMCOL
      ILINE(ICOL)=HYPHEN
  800 CONTINUE
      DO900ICOL=1,NUMCOL,IXDEL
      ILINE(ICOL)=ALPHAI
  900 CONTINUE
      WRITE(IPR,305)(ILINE(ICOL),ICOL=1,NUMCOL)
      DO1000I=1,NUMLAB
      AIM1=I-1
      XLABLE(I)=XMIN+(AIM1/ANUMLM)*DELX 
 1000 CONTINUE
      WRITE(IPR,910)(XLABLE(I),I=1,NUMLAB)
C
  205 FORMAT(1H ,'THE FOLLOWING IS A PLOT OF Y(I) VERSUS X(I)')
  305 FORMAT(1H ,18X,54A1)
  310 FORMAT(1H ,15X,A1)
  710 FORMAT(1H ,E14.7,1X,A1,2X,50A1)
  910 FORMAT(1H ,9X,5E12.4)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE PLOTS(Y,X,N,D,DMIN,DMAX)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PLOTS
C
C     PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT
C              OF Y(I) VERSUS X(I): 
C              1) WITH ONLY THOSE POINTS (X(I),Y(I)) PLOTTED
C                 FOR WHICH THE CORRESPONDING VALUE OF D(I) 
C                 IS BETWEEN THE SPECIFIED VALUES OF DMIN AND DMAX.
C
C              THE USE OF THE SUBSET DEFINITION VECTOR D
C              GIVES THE DATA ANALYST THE CAPABILITY OF
C              PLOTTING SUBSETS OF THE DATA,
C              WHERE THE SUBSET IS DEFINED
C              BY VALUES IN THE VECTOR D.
C
C     INPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED VERTICALLY.
C                    --X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED HORIZONTALLY. 
C                    --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR Y.
C                    --D      = THE SINGLE PRECISION VECTOR 
C                               WHICH 'DEFINES' THE VARIOUS 
C                               POSSIBLE SUBSETS. 
C                    --DMIN   = THE SINGLE PRECISION VALUE
C                               WHICH DEFINES THE LOWER BOUND
C                               (INCLUSIVELY) OF THE PARTICULAR
C                               SUBSET OF INTEREST TO BE PLOTTED.
C                    --DMAX   = THE SINGLE PRECISION VALUE
C                               WHICH DEFINES THE UPPER BOUND
C                               (INCLUSIVELY) OF THE PARTICULAR
C                               SUBSET OF INTEREST TO BE PLOTTED.
C     OUTPUT--A ONE-PAGE PRINTER PLOT OF Y(I) VERSUS X(I),
C             FOR ONLY OF A SPECIFIED SUBSET OF THE DATA.
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--FOR A GIVEN DUMMY INDEX I,
C              IF D(I) IS SMALLER THAN DMIN OR LARGER THAN DMAX,
C              THEN THE CORRESPONDING POINT (X(I),Y(I))
C              WILL NOT BE PLOTTED.
C            --VALUES IN THE VERTICAL AXIS VECTOR (Y)
C              OR THE HORIZONTAL AXIS VECTOR (X) WHICH ARE
C              EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE
C              PLOTTED.
C              THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM
C              OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y
C              (OR X) ARE 'MISSING DATA', OR WHEN WE PURPOSELY
C              WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y
C              (OR X) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT
C              WANT CERTAIN ELEMENTS IN Y (OR X) TO BE PLOTTED).
C              TO CAUSE SPECIFIC ELEMENTS IN Y (OR X) TO BE 
C              IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND
C              (BY, FOR EXAMPLE, USE OF THE   REPLAC   SUBROUTINE)
C              BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND
C              THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOT
C              SUBROUTINE.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--OCTOBER   1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1977. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IGRAPH
      CHARACTER*4 SBNAM1,SBNAM2
      CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 
      CHARACTER*4 ALPH41,ALPH42
      CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX
      CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL
C
      DIMENSION Y(1)
      DIMENSION X(1)
      DIMENSION D(1)
      DIMENSION YLABLE(11)
      COMMON /BLOCK1/ IGRAPH(55,130)
C
      DATA SBNAM1,SBNAM2/'PLOT','S   '/ 
      DATA ALPH11,ALPH12/'FIRS','T   '/ 
      DATA ALPH21,ALPH22/'SECO','ND  '/ 
      DATA ALPH31,ALPH32/'THIR','D   '/ 
      DATA ALPH41,ALPH42/'FOUR','TH  '/ 
      DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/
      DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/
C
      IPR=6
      CUTOFF=(10.0**10)-1000.0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      WRITE(IPR,998)
      IF(N.LT.1)GOTO52
      GOTO54
   52 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,20)N
      WRITE(IPR,5)
      RETURN
   54 CONTINUE
      IF(N.EQ.1)GOTO56
      GOTO58
   56 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,22)N
      WRITE(IPR,5)
      RETURN
   58 CONTINUE
C
      HOLD=Y(1)
      DO60I=2,N
      IF(Y(I).NE.HOLD)GOTO62
   60 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   62 CONTINUE
      HOLD=X(1)
      DO64I=2,N
      IF(X(I).NE.HOLD)GOTO66
   64 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   66 CONTINUE
      HOLD=D(1)
      DO72I=2,N
      IF(D(I).NE.HOLD)GOTO74
   72 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,11) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
   74 CONTINUE
C
      DO76I=1,N
      IF(Y(I).LT.CUTOFF)GOTO78
   76 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   78 CONTINUE
      DO80I=1,N
      IF(X(I).LT.CUTOFF)GOTO82
   80 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   82 CONTINUE
      DO88I=1,N
      IF(D(I).LT.CUTOFF)GOTO90
   88 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   90 CONTINUE
C
      DO92I=1,N
      IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)GOTO94
   92 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,34) 
      WRITE(IPR,35)DMIN,DMAX
      WRITE(IPR,36) 
      WRITE(IPR,5)
      RETURN
   94 CONTINUE
C
      N2=0
      DO96I=1,N
      IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF.AND.D(I).LT.CUTOFF)GOTO98
      GOTO96
   98 IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)N2=N2+1
      IF(N2.GE.2)GOTO99
   96 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22,ALPH41,ALPH42
      WRITE(IPR,19)SBNAM1,SBNAM2
      WRITE(IPR,40) 
      WRITE(IPR,41)N2
      WRITE(IPR,5)
      RETURN
   99 CONTINUE
C
    5 FORMAT(1H ,'**************************************************',
     1'********************') 
   10 FORMAT(1H ,'                   FATAL ERROR                    ')
   11 FORMAT(1H ,'               NON-FATAL DIAGNOSTIC               ')
   15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4,
     1' SUBROUTINE')
   18 FORMAT(1H ,'THE ',A4,A4,2H, ,A4,A4,', AND ',A4,A4)
   19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE')
   20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,')')
   22 FORMAT(1H ,'HAS THE VALUE 1')
   30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8)
   32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF')
   33 FORMAT(1H ,'VALUE OF ',E15.8)
   34 FORMAT(1H ,'HAS ALL ELEMENTS OUTSIDE THE INTERVAL')
   35 FORMAT(1H ,'(',E15.8,',',E15.8,')',' AS DEFINED BY')
   36 FORMAT(1H ,'THE FIFTH  AND SIXTH  INPUT ARGUMENTS.')
   40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 
     1' EXCLUDED FROM THE PLOT.')
   41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.')
C
C-----START POINT-----------------------------------------------------
C
C     DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS
C
      DO200I=1,N
      IF(Y(I).GE.CUTOFF)GOTO200
      IF(X(I).GE.CUTOFF)GOTO200
      IF(D(I).LT.DMIN)GOTO200 
      IF(D(I).GT.DMAX)GOTO200 
      YMIN=Y(I)
      YMAX=Y(I)
      GOTO250
  200 CONTINUE
  250 DO300I=1,N
      IF(Y(I).GE.CUTOFF)GOTO300
      IF(X(I).GE.CUTOFF)GOTO300
      IF(D(I).LT.DMIN)GOTO300 
      IF(D(I).GT.DMAX)GOTO300 
      IF(Y(I).LT.YMIN)YMIN=Y(I)
      IF(Y(I).GT.YMAX)YMAX=Y(I)
  300 CONTINUE
      DO400I=1,9
      AIM1=I-1
      YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN)
  400 CONTINUE
C
C     DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS 
C     DETERMINE XMIN, XMAX, XMID, X25 (=THE 25% POINT), AND 
C     X75 (=THE 75% POINT)
C
      DO600I=1,N
      IF(Y(I).GE.CUTOFF)GOTO600
      IF(X(I).GE.CUTOFF)GOTO600
      IF(D(I).LT.DMIN)GOTO600 
      IF(D(I).GT.DMAX)GOTO600 
      XMIN=X(I)
      XMAX=X(I)
      GOTO650
  600 CONTINUE
  650 DO700I=1,N
      IF(Y(I).GE.CUTOFF)GOTO700
      IF(X(I).GE.CUTOFF)GOTO700
      IF(D(I).LT.DMIN)GOTO700 
      IF(D(I).GT.DMAX)GOTO700 
      IF(X(I).LT.XMIN)XMIN=X(I)
      IF(X(I).GT.XMAX)XMAX=X(I)
  700 CONTINUE
      XMID=(XMIN+XMAX)/2.0
      X25=0.75*XMIN+0.25*XMAX 
      X75=0.25*XMIN+0.75*XMAX 
C
C     BLANK OUT THE GRAPH
C
      DO1100I=1,45
      DO1200J=1,109 
      IGRAPH(I,J)=BLANK
 1200 CONTINUE
 1100 CONTINUE
C
C     PRODUCE THE VERTICAL AXES
C
      DO1300I=3,43
      IGRAPH(I,5)=ALPHAI
      IGRAPH(I,109)=ALPHAI
 1300 CONTINUE
      DO1400I=3,43,5
      IGRAPH(I,5)=HYPHEN
      IGRAPH(I,109)=HYPHEN
 1400 CONTINUE
      IGRAPH(3,1)=EQUAL
      IGRAPH(3,2)=ALPHAM
      IGRAPH(3,3)=ALPHAA
      IGRAPH(3,4)=ALPHAX
      IGRAPH(23,1)=EQUAL
      IGRAPH(23,2)=ALPHAM
      IGRAPH(23,3)=ALPHAI
      IGRAPH(23,4)=ALPHAD
      IGRAPH(43,1)=EQUAL
      IGRAPH(43,2)=ALPHAM
      IGRAPH(43,3)=ALPHAI
      IGRAPH(43,4)=ALPHAN
C
C     PRODUCE THE HORIZONTAL AXES
C
      DO1500J=7,107 
      IGRAPH(1,J)=HYPHEN
      IGRAPH(45,J)=HYPHEN
 1500 CONTINUE
      DO1600J=7,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1600 CONTINUE
      DO1700J=20,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1700 CONTINUE
C
C     DETERMINE THE (X,Y) PLOT POSITIONS
C
      RATIOY=40.0/(YMAX-YMIN) 
      RATIOX=100.0/(XMAX-XMIN)
      DO1800I=1,N
      IF(Y(I).GE.CUTOFF)GOTO1800
      IF(X(I).GE.CUTOFF)GOTO1800
      IF(D(I).LT.DMIN)GOTO1800
      IF(D(I).GT.DMAX)GOTO1800
      MX=RATIOX*(X(I)-XMIN)+0.5
      MX=MX+7
      MY=RATIOY*(Y(I)-YMIN)+0.5
      MY=43-MY
      IGRAPH(MY,MX)=ALPHAX
 1800 CONTINUE
C
C     WRITE OUT THE GRAPH
C
      DO2100I=1,45
      IP2=I+2
      IFLAG=IP2-(IP2/5)*5
      K=IP2/5
      IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109)
      IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109)
 2100 CONTINUE
      WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX
C
 2105 FORMAT(1H ,20X,109A1)
 2106 FORMAT(1H ,F20.7,109A1) 
 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7)
  998 FORMAT(1H1)
C
      RETURN
      END 
      SUBROUTINE PLOTSC(Y,X,CHAR,N,D,DMIN,DMAX)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PLOTSC
C
C     PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT
C              OF Y(I) VERSUS X(I): 
C              1) WITH SPECIAL PLOT CHARACTERS; AND
C              2) WITH ONLY THOSE POINTS (X(I),Y(I)) PLOTTED
C                 FOR WHICH THE CORRESPONDING VALUE OF D(I) 
C                 IS BETWEEN THE SPECIFIED VALUES OF DMIN AND DMAX.
C
C              THE 'SPECIAL PLOTTING CHARACTER' CAPABILITY
C              ALLOWS THE DATA ANALYST TO INCORPORATE INFORMATION
C              FROM A THIRD VARIABLE (ASIDE FROM Y AND X) INTO
C              THE PLOT.
C              THE PLOT CHARACTER USED AT THE I-TH PLOTTING 
C              POSITION (THAT IS, AT THE COORDINATE (X(I),Y(I)))
C              WILL BE
C              1 IF CHAR(I) IS BETWEEN  0.5 AND  1.5
C              2 IF CHAR(I) IS BETWEEN  1.5 AND  2.5
C                .
C                .
C                .
C              9 IF CHAR(I) IS BETWEEN  8.5 AND  9.5
C              0 IF CHAR(I) IS BETWEEN  9.5 AND 10.5
C              A IF CHAR(I) IS BETWEEN 10.5 AND 11.5
C              B IF CHAR(I) IS BETWEEN 11.5 AND 12.5
C              C IF CHAR(I) IS BETWEEN 12.5 AND 13.5
C                .
C                .
C                .
C              W IF CHAR(I) IS BETWEEN 32.5 AND 33.5
C              X IF CHAR(I) IS BETWEEN 33.5 AND 34.5
C              Y IF CHAR(I) IS BETWEEN 34.5 AND 35.5
C              Z IF CHAR(I) IS BETWEEN 35.5 AND 36.5
C              X IF CHAR(I) IS ANY VALUE OUTSIDE THE RANGE
C                                       0.5 TO  36.5.
C              THE USE OF THE SUBSET DEFINTION VECTOR D
C              GIVES THE DATA ANALYST THE CAPABILITY OF
C              PLOTTING SUBSETS OF THE DATA,
C              WHERE THE SUBSET IS DEFINED
C              BY VALUES IN THE VECTOR D.
C
C     INPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED VERTICALLY.
C                    --X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED HORIZONTALLY. 
C                    --CHAR   = THE SINGLE PRECISION VECTOR OF
C                               OBSERVATIONS WHICH CONTROL THE
C                               VALUE OF EACH INDIVIDUAL PLOT
C                               CHARACTER.
C                    --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR Y.
C                    --D      = THE SINGLE PRECISION VECTOR 
C                               WHICH 'DEFINES' THE VARIOUS 
C                               POSSIBLE SUBSETS. 
C                    --DMIN   = THE SINGLE PRECISION VALUE
C                               WHICH DEFINES THE LOWER BOUND
C                               (INCLUSIVELY) OF THE PARTICULAR
C                               SUBSET OF INTEREST TO BE PLOTTED.
C                    --DMAX   = THE SINGLE PRECISION VALUE
C                               WHICH DEFINES THE UPPER BOUND
C                               (INCLUSIVELY) OF THE PARTICULAR
C                               SUBSET OF INTEREST TO BE PLOTTED.
C     OUTPUT--A ONE-PAGE PRINTER PLOT OF Y(I) VERSUS X(I),
C             WITH SPECIAL PLOT CHARACTERS,
C             AND FOR ONLY OF A SPECIFIED SUBSET OF THE DATA.
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--FOR A GIVEN DUMMY INDEX I,
C              IF D(I) IS SMALLER THAN DMIN OR LARGER THAN DMAX,
C              THEN THE CORRESPONDING POINT (X(I),Y(I))
C              WILL NOT BE PLOTTED.
C            --VALUES IN THE VERTICAL AXIS VECTOR (Y),
C              THE HORIZONTAL AXIS VECTOR (X),
C              OR THE PLOT CHARACTER VECTOR (CHAR) WHICH ARE
C              EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE
C              PLOTTED.
C              THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM
C              OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y
C              (OR X, OR CHAR) ARE 'MISSING DATA', OR WHEN WE PURPOSELY
C              WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y
C              (OR X, OR CHAR) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT
C              WANT CERTAIN ELEMENTS IN Y (OR X, OR CHAR) TO BE
C              PLOTTED).
C              TO CAUSE SPECIFIC ELEMENTS IN Y (OR X, OR CHAR) TO BE
C              IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND
C              (BY, FOR EXAMPLE, USE OF THE   REPLAC   SUBROUTINE)
C              BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND
C              THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTC
C              SUBROUTINE.
C     REFERENCES--FILLIBEN, 'STATISTICAL ANALYSIS OF INTERLAB
C                 FATIGUE TIME DATA', UNPUBLISHED MANUSCRIPT
C                 (AVAILABLE FROM AUTHOR)
C                 PRESENTED AT THE 'COMPUTER-ASSISTED DATA
C                 ANALYSIS' SESSION AT THE NATIONAL MEETING 
C                 OF THE AMERICAN STATISTICAL ASSOCIATION,
C                 NEW YORK CITY, DECEMBER 27-30, 1973.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--OCTOBER   1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C     UPDATED         --FEBRUARY  1977. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IGRAPH
      CHARACTER*4 IPLOTC
      CHARACTER*4 SBNAM1,SBNAM2
      CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 
      CHARACTER*4 ALPH41,ALPH42,ALPH51,ALPH52
      CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX
      CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL
C
      DIMENSION Y(1)
      DIMENSION X(1)
      DIMENSION D(1)
      DIMENSION CHAR(1)
      DIMENSION YLABLE(11)
      DIMENSION IPLOTC(37)
      COMMON /BLOCK1/ IGRAPH(55,130)
C
      DATA SBNAM1,SBNAM2/'PLOT','SC  '/ 
      DATA ALPH11,ALPH12/'FIRS','T   '/ 
      DATA ALPH21,ALPH22/'SECO','ND  '/ 
      DATA ALPH31,ALPH32/'THIR','D   '/ 
      DATA ALPH41,ALPH42/'FOUR','TH  '/ 
      DATA ALPH51,ALPH52/'FIFT','H   '/ 
      DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/
      DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/
      DATA IPLOTC(1),IPLOTC(2),IPLOTC(3),IPLOTC(4),IPLOTC(5),
     1IPLOTC(6),IPLOTC(7),IPLOTC(8),IPLOTC(9),IPLOTC(10),
     1IPLOTC(11),IPLOTC(12),IPLOTC(13),IPLOTC(14),IPLOTC(15),
     1IPLOTC(16),IPLOTC(17),IPLOTC(18),IPLOTC(19),IPLOTC(20),
     1IPLOTC(21),IPLOTC(22),IPLOTC(23),IPLOTC(24),IPLOTC(25),
     1IPLOTC(26),IPLOTC(27),IPLOTC(28),IPLOTC(29),IPLOTC(30),
     1IPLOTC(31),IPLOTC(32),IPLOTC(33),IPLOTC(34),IPLOTC(35),
     1IPLOTC(36),IPLOTC(37)
     1/'1','2','3','4','5','6','7','8','9','0','A','B','C','D','E','F',
     1'G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V',
     1'W','X','Y','Z','X'/
C
      IPR=6
      CUTOFF=(10.0**10)-1000.0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      WRITE(IPR,998)
      IF(N.LT.1)GOTO52
      GOTO54
   52 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,20)N
      WRITE(IPR,5)
      RETURN
   54 CONTINUE
      IF(N.EQ.1)GOTO56
      GOTO58
   56 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,22)N
      WRITE(IPR,5)
      RETURN
   58 CONTINUE
C
      HOLD=Y(1)
      DO60I=2,N
      IF(Y(I).NE.HOLD)GOTO62
   60 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   62 CONTINUE
      HOLD=X(1)
      DO64I=2,N
      IF(X(I).NE.HOLD)GOTO66
   64 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   66 CONTINUE
      HOLD=CHAR(1)
      DO68I=2,N
      IF(CHAR(I).NE.HOLD)GOTO70
   68 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,11) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
   70 CONTINUE
      HOLD=D(1)
      DO72I=2,N
      IF(D(I).NE.HOLD)GOTO74
   72 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,11) 
      WRITE(IPR,15)ALPH51,ALPH52,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
   74 CONTINUE
C
      DO76I=1,N
      IF(Y(I).LT.CUTOFF)GOTO78
   76 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   78 CONTINUE
      DO80I=1,N
      IF(X(I).LT.CUTOFF)GOTO82
   80 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   82 CONTINUE
      DO84I=1,N
      IF(CHAR(I).LT.CUTOFF)GOTO86
   84 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   86 CONTINUE
      DO88I=1,N
      IF(D(I).LT.CUTOFF)GOTO90
   88 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH51,ALPH52,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   90 CONTINUE
C
      DO92I=1,N
      IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)GOTO94
   92 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH51,ALPH52,SBNAM1,SBNAM2
      WRITE(IPR,34) 
      WRITE(IPR,35)DMIN,DMAX
      WRITE(IPR,36) 
      WRITE(IPR,5)
      RETURN
   94 CONTINUE
C
      N2=0
      DO96I=1,N
      IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF.AND.CHAR(I).LT.CUTOFF.AND. 
     1D(I).LT.CUTOFF)GOTO98
      GOTO96
   98 IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)N2=N2+1
      IF(N2.GE.2)GOTO99
   96 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32,
     1ALPH51,ALPH52 
      WRITE(IPR,19)SBNAM1,SBNAM2
      WRITE(IPR,40) 
      WRITE(IPR,41)N2
      WRITE(IPR,5)
      RETURN
   99 CONTINUE
C
    5 FORMAT(1H ,'**************************************************',
     1'********************') 
   10 FORMAT(1H ,'                   FATAL ERROR                    ')
   11 FORMAT(1H ,'               NON-FATAL DIAGNOSTIC               ')
   15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4,
     1' SUBROUTINE')
   18 FORMAT(1H ,'THE ',A4,A4,', ',A4,A4,', ',A4,A4,', AND ',A4,A4)
   19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE')
   20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,')')
   22 FORMAT(1H ,'HAS THE VALUE 1')
   30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8)
   32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF')
   33 FORMAT(1H ,'VALUE OF ',E15.8)
   34 FORMAT(1H ,'HAS ALL ELEMENTS OUTSIDE THE INTERVAL')
   35 FORMAT(1H ,'(',E15.8,',',E15.8,')',' AS DEFINED BY')
   36 FORMAT(1H ,'THE SIXTH  AND SEVENTH INPUT ARGUMENTS.') 
   40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 
     1' EXCLUDED FROM THE PLOT.')
   41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.')
C
C-----START POINT-----------------------------------------------------
C
C     DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS
C
      DO200I=1,N
      IF(Y(I).GE.CUTOFF)GOTO200
      IF(X(I).GE.CUTOFF)GOTO200
      IF(CHAR(I).GE.CUTOFF)GOTO200
      IF(D(I).LT.DMIN)GOTO200 
      IF(D(I).GT.DMAX)GOTO200 
      YMIN=Y(I)
      YMAX=Y(I)
      GOTO250
  200 CONTINUE
  250 DO300I=1,N
      IF(Y(I).GE.CUTOFF)GOTO300
      IF(X(I).GE.CUTOFF)GOTO300
      IF(CHAR(I).GE.CUTOFF)GOTO300
      IF(D(I).LT.DMIN)GOTO300 
      IF(D(I).GT.DMAX)GOTO300 
      IF(Y(I).LT.YMIN)YMIN=Y(I)
      IF(Y(I).GT.YMAX)YMAX=Y(I)
  300 CONTINUE
      DO400I=1,9
      AIM1=I-1
      YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN)
  400 CONTINUE
C
C     DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS 
C     DETERMINE XMIN, XMAX, XMID, X25 (=THE 25% POINT), AND 
C     X75 (=THE 75% POINT)
C
      DO600I=1,N
      IF(Y(I).GE.CUTOFF)GOTO600
      IF(X(I).GE.CUTOFF)GOTO600
      IF(CHAR(I).GE.CUTOFF)GOTO600
      IF(D(I).LT.DMIN)GOTO600 
      IF(D(I).GT.DMAX)GOTO600 
      XMIN=X(I)
      XMAX=X(I)
      GOTO650
  600 CONTINUE
  650 DO700I=1,N
      IF(Y(I).GE.CUTOFF)GOTO700
      IF(X(I).GE.CUTOFF)GOTO700
      IF(CHAR(I).GE.CUTOFF)GOTO700
      IF(D(I).LT.DMIN)GOTO700 
      IF(D(I).GT.DMAX)GOTO700 
      IF(X(I).LT.XMIN)XMIN=X(I)
      IF(X(I).GT.XMAX)XMAX=X(I)
  700 CONTINUE
      XMID=(XMIN+XMAX)/2.0
      X25=0.75*XMIN+0.25*XMAX 
      X75=0.25*XMIN+0.75*XMAX 
C
C     BLANK OUT THE GRAPH
C
      DO1100I=1,45
      DO1200J=1,109 
      IGRAPH(I,J)=BLANK
 1200 CONTINUE
 1100 CONTINUE
C
C     PRODUCE THE VERTICAL AXES
C
      DO1300I=3,43
      IGRAPH(I,5)=ALPHAI
      IGRAPH(I,109)=ALPHAI
 1300 CONTINUE
      DO1400I=3,43,5
      IGRAPH(I,5)=HYPHEN
      IGRAPH(I,109)=HYPHEN
 1400 CONTINUE
      IGRAPH(3,1)=EQUAL
      IGRAPH(3,2)=ALPHAM
      IGRAPH(3,3)=ALPHAA
      IGRAPH(3,4)=ALPHAX
      IGRAPH(23,1)=EQUAL
      IGRAPH(23,2)=ALPHAM
      IGRAPH(23,3)=ALPHAI
      IGRAPH(23,4)=ALPHAD
      IGRAPH(43,1)=EQUAL
      IGRAPH(43,2)=ALPHAM
      IGRAPH(43,3)=ALPHAI
      IGRAPH(43,4)=ALPHAN
C
C     PRODUCE THE HORIZONTAL AXES
C
      DO1500J=7,107 
      IGRAPH(1,J)=HYPHEN
      IGRAPH(45,J)=HYPHEN
 1500 CONTINUE
      DO1600J=7,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1600 CONTINUE
      DO1700J=20,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1700 CONTINUE
C
C     DETERMINE THE (X,Y) PLOT POSITIONS
C
      RATIOY=40.0/(YMAX-YMIN) 
      RATIOX=100.0/(XMAX-XMIN)
      DO1800I=1,N
      IF(Y(I).GE.CUTOFF)GOTO1800
      IF(X(I).GE.CUTOFF)GOTO1800
      IF(CHAR(I).GE.CUTOFF)GOTO1800
      IF(D(I).LT.DMIN)GOTO1800
      IF(D(I).GT.DMAX)GOTO1800
      MX=RATIOX*(X(I)-XMIN)+0.5
      MX=MX+7
      MY=RATIOY*(Y(I)-YMIN)+0.5
      MY=43-MY
      IARG=37
      IF(0.5.LT.CHAR(I).AND.CHAR(I).LT.36.5)IARG=CHAR(I)+0.5
      IGRAPH(MY,MX)=IPLOTC(IARG)
 1800 CONTINUE
C
C     WRITE OUT THE GRAPH
C
      DO2100I=1,45
      IP2=I+2
      IFLAG=IP2-(IP2/5)*5
      K=IP2/5
      IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109)
      IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109)
 2100 CONTINUE
      WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX
C
 2105 FORMAT(1H ,20X,109A1)
 2106 FORMAT(1H ,F20.7,109A1) 
 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7)
  998 FORMAT(1H1)
C
      RETURN
      END 
      SUBROUTINE PLOTSP(Y,N,IDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PLOTSP
C
C     THIS ROUTINE YIELDS A ONE-PAGE PLOT OF THE SPECTRUM, ALONG WITH UPPER
C     AND LOWER LIMITS OF THE SPECTRUM. 
C     THE CONVENTION HAS BEEN FOLLOWED THAT IF THE INTEGER INPUT PARAMETER IDF
C     HAS THE VALUE 0, THEN NO CONFIDENCE LIMITS WILL BE COMPUTED AND ONLY THE
C     SPECTRUM ITSELF WILL BE PLOTTED OUT.
C     MULTIPLE PLOT POINTS ARE NOT INDICATED.
C     THE FIRST POINT WILL BE PLOTTED ON THE LEFT VERTICAL AXIS
C     THE LAST POINT WILL BE PLOTTED ON THE RIGHT VERTICAL AXIS
C     THERE IS NO RESTRICTION ON THE MAXIMUM VALUE OF N FOR THIS ROUTINE.
C     PRINTING--YES 
C     SUBROUTINES NEEDED--CHSPPF.
C     WRITTEN BY JAMES J. FILLIBEN, STATISTICAL ENGINEERING LABORATORY (205.03) 
C     NATIONAL BUREAU OF STANDARDS, WASHINGTON, D.C. 20234     JUN 1972
C                                                      UPDATED FEB 1975
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IGRAPH
      CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX,DOT
C
      DIMENSION Y(1)
      DIMENSION YLABLE(11)
      COMMON /BLOCK1/ IGRAPH(55,130)
C
      DATA BLANK,HYPHEN,ALPHAI/' ','-','I'/
      DATA ALPHAX/'X'/
      DATA DOT/'.'/ 
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=Y(1)
      DO60I=2,N
      IF(Y(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,   '***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE PLOTSP SUBROUTINE HAS ALL ELEMENTS = ',
     1E15.8,' *****')
   15 FORMAT(1H ,   '***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 PLOTSP SUBROUTINE IS NON-POSITIVE *****')
   18 FORMAT(1H ,   '***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE PLOTSP SUBROUTINE HAS THE VALUE 1 *****')
   47 FORMAT(1H , '***** THE VALUE OF THE ARGUMENT IS ',I8   ,' *****')
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     DETERMINE THE MINIMUM AND MAXIMUM OF THE SPECTRUM
C
      SPMIN=Y(1)
      SPMAX=Y(1)
      DO100I=2,N
      IF(Y(I).LT.SPMIN)SPMIN=Y(I)
      IF(Y(I).GT.SPMAX)SPMAX=Y(I)
  100 CONTINUE
C
C     COMPUTE THE MAXIMUM VALUE OF THE UPPER CONFIDENCE LIMIT
C     AND THE MINIMUM VALUE OF THE LOWER CONFIDENCE LIMIT--THESE TWO VALUES
C     WILL DEFINE THE RANGE OF VALUES TO BE LISTED ON THE VERTICAL AXIS
C
      IF(IDF.EQ.0)GOTO150
      DF=IDF
      CALL CHSPPF(.975,IDF,PP975)
      CALL CHSPPF(.025,IDF,PP025)
      YMAX=DF*SPMAX/PP025
      YMIN=DF*SPMIN/PP975
      GOTO160
  150 YMIN=SPMIN
      YMAX=SPMAX
C
C     DETERMINE THE 11 VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS
C
  160 DO200I=1,11
      YLABLE(I)=YMAX-((FLOAT(I-1))/10.0)*(YMAX-YMIN)
  200 CONTINUE
C
C     BLANK OUT THE GRAPH
      DO250I=1,55
      DO260J=1,130
      IGRAPH(I,J)=BLANK
  260 CONTINUE
  250 CONTINUE
C
C     PRODUCE THE Y AXIS
      DO300I=5,55
      IGRAPH(I,10)=ALPHAI
      IGRAPH(I,130)=ALPHAI
  300 CONTINUE
      DO350I=5,55,5 
      IGRAPH(I,10)=HYPHEN
      IGRAPH(I,130)=HYPHEN
  350 CONTINUE
C
C     PRODUCE THE X AXIS
      DO400J=10,130 
      IGRAPH(55,J)=HYPHEN
      IGRAPH(5,J)=HYPHEN
  400 CONTINUE
      DO450J=10,130,10
      IGRAPH(55,J)=ALPHAI
      IGRAPH(5,J)=ALPHAI
  450 CONTINUE
C
C     DETERMINE THE (X,Y) PLOT POSITIONS
      RATIOY=50.0/(YMAX-YMIN) 
      RATIOX=240.0
      DO600I=1,N
      AI=I
      XI  =(AI-1.0)/(2.0*(AN-1.0))
      MX=RATIOX*XI+0.5
      MX=MX+10
      IF(IDF.EQ.0)GOTO650
      SUPPER=DF*Y(I)/PP025
      SLOWER=DF*Y(I)/PP975
      MY=RATIOY*(SUPPER-YMIN)+0.5
      MY=55-MY
      IGRAPH(MY,MX)=DOT
      MY=RATIOY*(SLOWER-YMIN)+0.5
      MY=55-MY
      IGRAPH(MY,MX)=DOT
  650 MY=RATIOY*(Y(I)-YMIN)+0.5
      MY=55-MY
      IGRAPH(MY,MX)=ALPHAX
  600 CONTINUE
C
C     WRITE OUT THE GRAPH
      WRITE(IPR,998)
      DO700I=5,55
      IFLAG=I-(I/5)*5
      K=I/5
      IF(IFLAG.NE.0)WRITE(IPR,705)(IGRAPH(I,J),J=1,130)
      IF(IFLAG.EQ.0)WRITE(IPR,706)YLABLE(K),(IGRAPH(I,J),J=10,130)
  700 CONTINUE
      WRITE(IPR,740)
      WRITE(IPR,745)
  705 FORMAT(1H ,130A1)
  706 FORMAT(1H ,F9.2,130A1)
  740 FORMAT(1H ,    'FREQ   .000      .042      .083      .125      .16
     17      .208      .250      .292      .333      .375      .417
     1 .458      .500')
  745 FORMAT(1H ,    'PERIOD INF       24.0      12.0      8.00      6.0
     10      4.80      4.00      3.43      3.00      2.67      2.40
     1 2.18      2.00')
  998 FORMAT(1H1)
      RETURN
      END 
      SUBROUTINE PLOTST(Y,X,N,D,DMIN,DMAX)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PLOTST
C
C     PURPOSE--THIS SUBROUTINE YIELDS A NARROW-WIDTH (71-CHARACTER)
C              OF Y(I) VERSUS X(I): 
C              1) WITH ONLY THOSE POINTS (X(I),Y(I)) PLOTTED
C                 FOR WHICH THE CORRESPONDING VALUE OF D(I) 
C                 IS BETWEEN THE SPECIFIED VALUES OF DMIN AND DMAX.
C
C              ITS NARROW WIDTH MAKES IT
C              APPROPRIATE FOR USE ON A TERMINAL. 
C
C              THE USE OF THE SUBSET DEFINTION VECTOR D
C              GIVES THE DATA ANALYST THE CAPABILITY OF
C              PLOTTING SUBSETS OF THE DATA,
C              WHERE THE SUBSET IS DEFINED
C              BY VALUES IN THE VECTOR D.
C
C     INPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED VERTICALLY.
C                    --X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED HORIZONTALLY. 
C                    --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR Y.
C                    --D      = THE SINGLE PRECISION VECTOR 
C                               WHICH 'DEFINES' THE VARIOUS 
C                               POSSIBLE SUBSETS. 
C                    --DMIN   = THE SINGLE PRECISION VALUE
C                               WHICH DEFINES THE LOWER BOUND
C                               (INCLUSIVELY) OF THE PARTICULAR
C                               SUBSET OF INTEREST TO BE PLOTTED.
C                    --DMAX   = THE SINGLE PRECISION VALUE
C                               WHICH DEFINES THE UPPER BOUND
C                               (INCLUSIVELY) OF THE PARTICULAR
C                               SUBSET OF INTEREST TO BE PLOTTED.
C     OUTPUT--A NARROW-WIDTH (71-CHARACTER) TERMINAL PLOT
C             OF Y(I) VERSUS X(I),
C             FOR ONLY OF A SPECIFIED SUBSET OF THE DATA.
C             THE BODY OF THE PLOT (NOT COUNTING AXIS VALUES
C             AND MARGINS) IS 25 ROWS (LINES) AND 49 COLUMNS.
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--FOR A GIVEN DUMMY INDEX I,
C              IF D(I) IS SMALLER THAN DMIN OR LARGER THAN DMAX,
C              THEN THE CORRESPONDING POINT (X(I),Y(I))
C              WILL NOT BE PLOTTED.
C            --VALUES IN THE VERTICAL AXIS VECTOR (Y)
C              OR THE HORIZONTAL AXIS VECTOR (X) WHICH ARE
C              EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE
C              PLOTTED.
C              THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM
C              OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y
C              (OR X) ARE 'MISSING DATA', OR WHEN WE PURPOSELY
C              WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y
C              (OR X) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT
C              WANT CERTAIN ELEMENTS IN Y (OR X) TO BE PLOTTED).
C              TO CAUSE SPECIFIC ELEMENTS IN Y (OR X) TO BE 
C              IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND
C              (BY, FOR EXAMPLE, USE OF THE   REPLAC   SUBROUTINE)
C              BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND
C              THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOT
C              SUBROUTINE.
C            --NOTE THAT THE STORAGE REQUIREMENTS FOR THIS
C              (AND THE OTHER) TERMINAL PLOT SUBROUTINESS ARE .
C              VERY SMALL.
C              THIS IS DUE TO THE 'ONE LINE AT A TIME' ALGORITHM
C              EMPLOYED FOR THE PLOT.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--OCTOBER   1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1977. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 ILINE
      CHARACTER*4 IAXISC
      CHARACTER*4 SBNAM1,SBNAM2
      CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 
      CHARACTER*4 ALPH41,ALPH42
      CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX
C
      DIMENSION Y(1)
      DIMENSION X(1)
      DIMENSION D(1)
      DIMENSION ILINE(72),XLABLE(10)
C
      DATA SBNAM1,SBNAM2/'PLOT','ST  '/ 
      DATA ALPH11,ALPH12/'FIRS','T   '/ 
      DATA ALPH21,ALPH22/'SECO','ND  '/ 
      DATA ALPH31,ALPH32/'THIR','D   '/ 
      DATA ALPH41,ALPH42/'FOUR','TH  '/ 
      DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/
C
      IPR=6
      CUTOFF=(10.0**10)-1000.0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO52
      GOTO54
   52 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,20)N
      WRITE(IPR,5)
      RETURN
   54 CONTINUE
      IF(N.EQ.1)GOTO56
      GOTO58
   56 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,22)N
      WRITE(IPR,5)
      RETURN
   58 CONTINUE
C
      HOLD=Y(1)
      DO60I=2,N
      IF(Y(I).NE.HOLD)GOTO62
   60 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   62 CONTINUE
      HOLD=X(1)
      DO64I=2,N
      IF(X(I).NE.HOLD)GOTO66
   64 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   66 CONTINUE
      HOLD=D(1)
      DO72I=2,N
      IF(D(I).NE.HOLD)GOTO74
   72 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,11) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
   74 CONTINUE
C
      DO76I=1,N
      IF(Y(I).LT.CUTOFF)GOTO78
   76 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   78 CONTINUE
      DO80I=1,N
      IF(X(I).LT.CUTOFF)GOTO82
   80 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   82 CONTINUE
      DO88I=1,N
      IF(D(I).LT.CUTOFF)GOTO90
   88 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   90 CONTINUE
C
      DO92I=1,N
      IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)GOTO94
   92 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,34) 
      WRITE(IPR,35)DMIN,DMAX
      WRITE(IPR,36) 
      WRITE(IPR,5)
      RETURN
   94 CONTINUE
C
      N2=0
      DO96I=1,N
      IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF.AND.D(I).LT.CUTOFF)GOTO98
      GOTO96
   98 IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)N2=N2+1
      IF(N2.GE.2)GOTO99
   96 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22,ALPH41,ALPH42
      WRITE(IPR,19)SBNAM1,SBNAM2
      WRITE(IPR,40) 
      WRITE(IPR,41)N2
      WRITE(IPR,5)
      RETURN
   99 CONTINUE
C
    5 FORMAT(1H ,'**************************************************',
     1'********************') 
   10 FORMAT(1H ,'                   FATAL ERROR                    ')
   11 FORMAT(1H ,'               NON-FATAL DIAGNOSTIC               ')
   15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4,
     1' SUBROUTINE')
   18 FORMAT(1H ,'THE ',A4,A4,', ',A4,A4,', AND ',A4,A4)
   19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE')
   20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,')')
   22 FORMAT(1H ,'HAS THE VALUE 1')
   30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8)
   32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF')
   33 FORMAT(1H ,'VALUE OF ',E15.8)
   34 FORMAT(1H ,'HAS ALL ELEMENTS OUTSIDE THE INTERVAL')
   35 FORMAT(1H ,'(',E15.8,',',E15.8,')',' AS DEFINED BY')
   36 FORMAT(1H ,'THE FIFTH  AND SIXTH  INPUT ARGUMENTS.')
   40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 
     1' EXCLUDED FROM THE PLOT.')
   41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.')
C
C-----START POINT-----------------------------------------------------
C
C     DEFINE THE NUMBER OF ROWS AND COLUMNS WITHIN THE PLOT--
C     THIS HAS BEEN SET TO 25 ROWS AND 49 COLUMNS.
C
      NUMROW=25
      NUMCOL=49
      ANUMR=NUMROW
      ANUMRM=NUMROW-1
      ANUMCM=NUMCOL-1
      NUMR25=(NUMROW/4)+1
      NUMR50=(NUMROW/2)+1
      NUMR75=3*(NUMROW/4)+1
      IXDEL=(NUMCOL-1)/4
      NUMLAB=5
      ANUMLM=NUMLAB-1
C
C     SKIP A LINE, WRITE OUT AN IDENTIFYING LINE FOR THE TYPE OF PLOT,
C     WRITE OUT THE TOP HORIZONTAL AXIS OF THE PLOT, AND SKIP 1 LINE
C     FOR A MARGIN WITHIN THE PLOT.
C
      WRITE(IPR,999)
      WRITE(IPR,205)
      DO100ICOL=1,NUMCOL
      ILINE(ICOL)=HYPHEN
  100 CONTINUE
      DO200ICOL=1,NUMCOL,IXDEL
      ILINE(ICOL)=ALPHAI
  200 CONTINUE
      WRITE(IPR,305)(ILINE(I),I=1,NUMCOL)
      WRITE(IPR,310)BLANK
C
C     DETERMINE THE MIN AND MAX VALUES OF Y, AND OF X.
C
      DO250I=1,N
      IF(Y(I).GE.CUTOFF)GOTO250
      IF(X(I).GE.CUTOFF)GOTO250
      IF(D(I).LT.DMIN)GOTO250 
      IF(D(I).GT.DMAX)GOTO250 
      YMIN=Y(I)
      YMAX=Y(I)
      XMIN=X(I)
      XMAX=X(I)
      GOTO270
  250 CONTINUE
  270 DO300I=1,N
      IF(Y(I).GE.CUTOFF)GOTO300
      IF(X(I).GE.CUTOFF)GOTO300
      IF(D(I).LT.DMIN)GOTO300 
      IF(D(I).GT.DMAX)GOTO300 
      IF(Y(I).LT.YMIN)YMIN=Y(I)
      IF(Y(I).GT.YMAX)YMAX=Y(I)
      IF(X(I).LT.XMIN)XMIN=X(I)
      IF(X(I).GT.XMAX)XMAX=X(I)
  300 CONTINUE
      DELY=YMAX-YMIN
      DELX=XMAX-XMIN
      YWIDTH=DELY/ANUMRM
      XWIDTH=DELX/ANUMCM
C
C     DETERMINE AND WRITE OUT THE PLOT POSITIONS ONE LINE AT A TIME.
C
      DO400IROW=1,NUMROW
      DO500ICOL=1,NUMCOL
      ILINE(ICOL)=BLANK
  500 CONTINUE
      AIROW=IROW
      YUPPER=YMAX+(1.5-AIROW)*YWIDTH
      YLABLE=YMAX+(1.0-AIROW)*YWIDTH
      YLOWER=YMAX+(0.5-AIROW)*YWIDTH
      IF(IROW.EQ.NUMROW)YLABLE=YMIN
      DO600I=1,N
      IF(Y(I).GE.CUTOFF)GOTO600
      IF(X(I).GE.CUTOFF)GOTO600
      IF(D(I).LT.DMIN)GOTO600 
      IF(D(I).GT.DMAX)GOTO600 
      IF(YLOWER.LE.Y(I).AND.Y(I).LT.YUPPER)GOTO650
      GOTO600
  650 ICOL=((X(I)-XMIN)/XWIDTH)+1.5
      ILINE(ICOL)=ALPHAX
  600 CONTINUE
      ICOLMX=1
      DO700ICOL=1,NUMCOL
      IF(ILINE(ICOL).EQ.ALPHAX)ICOLMX=ICOL
  700 CONTINUE
      IAXISC=ALPHAI 
      IF(IROW.EQ.1.OR.IROW.EQ.NUMROW)IAXISC=HYPHEN
      IF(IROW.EQ.NUMR25.OR.IROW.EQ.NUMR50.OR.IROW.EQ.NUMR75)
     1IAXISC=HYPHEN 
      WRITE(IPR,710)YLABLE,IAXISC,(ILINE(ICOL),ICOL=1,ICOLMX)
  400 CONTINUE
C
C     SKIP 1 LINE FOR A BOTTOM MARGIN WITHIN THE PLOT, WRITE OUT THE
C     BOTTOM HORIZONTAL AXIS, AND WRITE OUT THE X AXIS LABLES.
C
      WRITE(IPR,310)BLANK
      DO800ICOL=1,NUMCOL
      ILINE(ICOL)=HYPHEN
  800 CONTINUE
      DO900ICOL=1,NUMCOL,IXDEL
      ILINE(ICOL)=ALPHAI
  900 CONTINUE
      WRITE(IPR,305)(ILINE(ICOL),ICOL=1,NUMCOL)
      DO1000I=1,NUMLAB
      AIM1=I-1
      XLABLE(I)=XMIN+(AIM1/ANUMLM)*DELX 
 1000 CONTINUE
      WRITE(IPR,910)(XLABLE(I),I=1,NUMLAB)
C
  205 FORMAT(1H ,   'THE FOLLOWING IS A PLOT OF Y(I) (VERTICALLY) VERSUS
     1 X(I) (HORIZONTALLY)')
  305 FORMAT(1H ,18X,54A1)
  310 FORMAT(1H ,15X,A1)
  710 FORMAT(1H ,E14.7,1X,A1,2X,50A1)
  910 FORMAT(1H ,9X,5E12.4)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE PLOTT(Y,X,N) 
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PLOTT
C
C     PURPOSE--THIS SUBROUTINE YIELDS A NARROW-WIDTH (71-CHARACTER)
C              PLOT OF Y(I) VERSUS X(I).  ITS NARROW WIDTH MAKES IT
C              APPROPRIATE FOR USE ON A TERMINAL. 
C     INPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED VERTICALLY.
C                    --X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED HORIZONTALLY. 
C                    --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR Y.
C     OUTPUT--A NARROW-WIDTH (71-CHARACTER) TERMINAL PLOT
C             OF Y(I) VERSUS X(I).
C             THE BODY OF THE PLOT (NOT COUNTING AXIS VALUES
C             AND MARGINS) IS 25 ROWS (LINES) AND 49 COLUMNS.
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (Y)
C              OR THE HORIZONTAL AXIS VECTOR (X) WHICH ARE
C              EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE
C              PLOTTED.
C              THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM
C              OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y
C              (OR X) ARE 'MISSING DATA', OR WHEN WE PURPOSELY
C              WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y
C              (OR X) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT
C              WANT CERTAIN ELEMENTS IN Y (OR X) TO BE PLOTTED).
C              TO CAUSE SPECIFIC ELEMENTS IN Y (OR X) TO BE 
C              IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND
C              (BY, FOR EXAMPLE, USE OF THE   REPLAC   SUBROUTINE)
C              BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND
C              THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOT
C              SUBROUTINE.
C            --NOTE THAT THE STORAGE REQUIREMENTS FOR THIS
C              (AND THE OTHER) TERMINAL PLOT SUBROUTINESS ARE .
C              VERY SMALL.
C              THIS IS DUE TO THE 'ONE LINE AT A TIME' ALGORITHM
C              EMPLOYED FOR THE PLOT.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--FEBRUARY  1974. 
C     UPDATED         --APRIL     1974. 
C     UPDATED         --OCTOBER   1974. 
C     UPDATED         --OCTOBER   1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1977. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 ILINE
      CHARACTER*4 IAXISC
      CHARACTER*4 SBNAM1,SBNAM2
      CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 
      CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX
C
      DIMENSION Y(1)
      DIMENSION X(1)
      DIMENSION ILINE(72),XLABLE(10)
C
      DATA SBNAM1,SBNAM2/'PLOT','T   '/ 
      DATA ALPH11,ALPH12/'FIRS','T   '/ 
      DATA ALPH21,ALPH22/'SECO','ND  '/ 
      DATA ALPH31,ALPH32/'THIR','D   '/ 
      DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/
C
      IPR=6
      CUTOFF=(10.0**10)-1000.0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO52
      GOTO54
   52 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,20)N
      WRITE(IPR,5)
      RETURN
   54 CONTINUE
      IF(N.EQ.1)GOTO56
      GOTO58
   56 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,22)N
      WRITE(IPR,5)
      RETURN
   58 CONTINUE
C
      HOLD=Y(1)
      DO60I=2,N
      IF(Y(I).NE.HOLD)GOTO62
   60 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   62 CONTINUE
      HOLD=X(1)
      DO64I=2,N
      IF(X(I).NE.HOLD)GOTO66
   64 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   66 CONTINUE
C
      DO76I=1,N
      IF(Y(I).LT.CUTOFF)GOTO78
   76 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   78 CONTINUE
      DO80I=1,N
      IF(X(I).LT.CUTOFF)GOTO82
   80 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   82 CONTINUE
C
      N2=0
      DO96I=1,N
      IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF)GOTO98 
      GOTO96
   98 N2=N2+1
      IF(N2.GE.2)GOTO99
   96 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22
      WRITE(IPR,19)SBNAM1,SBNAM2
      WRITE(IPR,40) 
      WRITE(IPR,41)N2
      WRITE(IPR,5)
      RETURN
   99 CONTINUE
C
    5 FORMAT(1H ,'**************************************************',
     1'********************') 
   10 FORMAT(1H ,'                   FATAL ERROR                    ')
   15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4,
     1' SUBROUTINE')
   18 FORMAT(1H ,'THE ',A4,A4,', AND ',A4,A4)
   19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE')
   20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,1H))
   22 FORMAT(1H ,'HAS THE VALUE 1')
   30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8)
   32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF')
   33 FORMAT(1H ,'VALUE OF ',E15.8)
   40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 
     1' EXCLUDED FROM THE PLOT.')
   41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.')
C
C-----START POINT-----------------------------------------------------
C
C     DEFINE THE NUMBER OF ROWS AND COLUMNS WITHIN THE PLOT--
C     THIS HAS BEEN SET TO 25 ROWS AND 49 COLUMNS.
C
      NUMROW=25
      NUMCOL=49
      ANUMR=NUMROW
      ANUMRM=NUMROW-1
      ANUMCM=NUMCOL-1
      NUMR25=(NUMROW/4)+1
      NUMR50=(NUMROW/2)+1
      NUMR75=3*(NUMROW/4)+1
      IXDEL=(NUMCOL-1)/4
      NUMLAB=5
      ANUMLM=NUMLAB-1
C
C     SKIP A LINE, WRITE OUT AN IDENTIFYING LINE FOR THE TYPE OF PLOT,
C     WRITE OUT THE TOP HORIZONTAL AXIS OF THE PLOT, AND SKIP 1 LINE
C     FOR A MARGIN WITHIN THE PLOT.
C
      WRITE(IPR,999)
      WRITE(IPR,205)
      DO100ICOL=1,NUMCOL
      ILINE(ICOL)=HYPHEN
  100 CONTINUE
      DO200ICOL=1,NUMCOL,IXDEL
      ILINE(ICOL)=ALPHAI
  200 CONTINUE
      WRITE(IPR,305)(ILINE(I),I=1,NUMCOL)
      WRITE(IPR,310)BLANK
C
C     DETERMINE THE MIN AND MAX VALUES OF Y, AND OF X.
C
      DO250I=1,N
      IF(Y(I).GE.CUTOFF)GOTO250
      IF(X(I).GE.CUTOFF)GOTO250
      YMIN=Y(I)
      YMAX=Y(I)
      XMIN=X(I)
      XMAX=X(I)
      GOTO270
  250 CONTINUE
  270 DO300I=1,N
      IF(Y(I).GE.CUTOFF)GOTO300
      IF(X(I).GE.CUTOFF)GOTO300
      IF(Y(I).LT.YMIN)YMIN=Y(I)
      IF(Y(I).GT.YMAX)YMAX=Y(I)
      IF(X(I).LT.XMIN)XMIN=X(I)
      IF(X(I).GT.XMAX)XMAX=X(I)
  300 CONTINUE
      DELY=YMAX-YMIN
      DELX=XMAX-XMIN
      YWIDTH=DELY/ANUMRM
      XWIDTH=DELX/ANUMCM
C
C     DETERMINE AND WRITE OUT THE PLOT POSITIONS ONE LINE AT A TIME.
C
      DO400IROW=1,NUMROW
      DO500ICOL=1,NUMCOL
      ILINE(ICOL)=BLANK
  500 CONTINUE
      AIROW=IROW
      YUPPER=YMAX+(1.5-AIROW)*YWIDTH
      YLABLE=YMAX+(1.0-AIROW)*YWIDTH
      YLOWER=YMAX+(0.5-AIROW)*YWIDTH
      IF(IROW.EQ.NUMROW)YLABLE=YMIN
      DO600I=1,N
      IF(Y(I).GE.CUTOFF)GOTO600
      IF(X(I).GE.CUTOFF)GOTO600
      IF(YLOWER.LE.Y(I).AND.Y(I).LT.YUPPER)GOTO650
      GOTO600
  650 ICOL=((X(I)-XMIN)/XWIDTH)+1.5
      ILINE(ICOL)=ALPHAX
  600 CONTINUE
      ICOLMX=1
      DO700ICOL=1,NUMCOL
      IF(ILINE(ICOL).EQ.ALPHAX)ICOLMX=ICOL
  700 CONTINUE
      IAXISC=ALPHAI 
      IF(IROW.EQ.1.OR.IROW.EQ.NUMROW)IAXISC=HYPHEN
      IF(IROW.EQ.NUMR25.OR.IROW.EQ.NUMR50.OR.IROW.EQ.NUMR75)
     1IAXISC=HYPHEN 
      WRITE(IPR,710)YLABLE,IAXISC,(ILINE(ICOL),ICOL=1,ICOLMX)
  400 CONTINUE
C
C     SKIP 1 LINE FOR A BOTTOM MARGIN WITHIN THE PLOT, WRITE OUT THE
C     BOTTOM HORIZONTAL AXIS, AND WRITE OUT THE X AXIS LABLES.
C
      WRITE(IPR,310)BLANK
      DO800ICOL=1,NUMCOL
      ILINE(ICOL)=HYPHEN
  800 CONTINUE
      DO900ICOL=1,NUMCOL,IXDEL
      ILINE(ICOL)=ALPHAI
  900 CONTINUE
      WRITE(IPR,305)(ILINE(ICOL),ICOL=1,NUMCOL)
      DO1000I=1,NUMLAB
      AIM1=I-1
      XLABLE(I)=XMIN+(AIM1/ANUMLM)*DELX 
 1000 CONTINUE
      WRITE(IPR,910)(XLABLE(I),I=1,NUMLAB)
C
  205 FORMAT(1H , 71HTHE FOLLOWING IS A PLOT OF Y(I) (VERTICALLY) VERSUS
     1 X(I) (HORIZONTALLY))
  305 FORMAT(1H ,18X,54A1)
  310 FORMAT(1H ,15X,A1)
  710 FORMAT(1H ,E14.7,1X,A1,2X,50A1)
  910 FORMAT(1H ,9X,5E12.4)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE PLOTU(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PLOTU
C
C     PURPOSE--THIS SUBROUTINE PRODUCES THE FOLLOWING 4 PLOTS--
C              ALL ON THE SAME PRINTER PAGE--
C              1) DATA PLOT--X(I) VERSUS I
C              2) AUTOREGRESSION PLOT--X(I) VERSUS X(I-1)
C              3) HISTOGRAM
C              4) NORMAL PROBABILITY PLOT
C              IN ADDITION, LOCATION, SCALE, AND AUTOCORRELATION
C              SUMMARY STATISTICS ARE PRINTED OUT AUTOMATICALLY
C              ON THE SAME PAGE.
C              THESE PLOTS GIVE THE DATA ANALYST A QUICK
C              FIRST-PASS CHECK AT SOME OF
C              THE UNDERLYING ASSUMPTIONS TYPICALLY MADE--
C              CONSTANT LOCATION, CONSTANT SCALE, NO OUTLIERS,
C              UNAUTOCORRELATED DATA, SYMMETRY, NORMALITY.
C     INPUT ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED) OBSERVATIONS.
C                      N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR X.
C     OUTPUT--4 PLOTS (ALL ON THE SAME PRINTER PAGE)--
C             1) DATA PLOT--X(I) VERSUS I
C             2) AUTOREGRESSION PLOT--X(I) VERSUS X(I-1)
C             3) HISTOGRAM
C             4) NORMAL PROBABILITY PLOT
C             PLUS LOCATION, SCALE, AND 
C             AUTOCORRELATION SUMMARY STATISTICS. 
C     PRINTING--YES 
C     RESTRICTIONS--THE MINIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 2.
C                 --THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, NORPPF.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--FILLIBEN, 'SOME USEFUL COMPUTERIZED TECHNIQUES
C                 FOR DATA ANALYSIS', (UNPUBLISHED MANUSCRIPT
C                 AVAILABLE FROM AUTHOR), 1975.
C               --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING,
C                 1967, PAGES 260-308.
C               --FILLIBEN, 'THE PROBABILITY PLOT CORRELATION COEFFICIENT
C                 TEST FOR NORMALITY', TECHNOMETRICS, 1975, PAGES 111-117.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1974. 
C     UPDATED         --JANUARY   1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C     UPDATED         --MAY       1976. 
C     UPDATED         --FEBRUARY  1977. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IGRAPH
      CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX
      CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL
C
      DIMENSION X(1)
      DIMENSION X2(7500),Y2(7500)
      DIMENSION YLABLE(45,4)
      DIMENSION XMIN(4),XMAX(4),XMID(4),X25(4),X75(4)
      DIMENSION ITAXIS(4),IBAXIS(4),ILAXIS(4),IRAXIS(4)
      COMMON /BLOCK1/ IGRAPH(55,130)
      COMMON /BLOCK2/ WS(15000)
CCCCC COMMON IGRAPH(45,110)
      EQUIVALENCE (X2(1),WS(1)),(Y2(1),WS(7501))
C
      DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/
      DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/
      DATA ITAXIS(1),IBAXIS(1),ILAXIS(1),IRAXIS(1)/ 1,19,5,49/
      DATA ITAXIS(2),IBAXIS(2),ILAXIS(2),IRAXIS(2)/ 1,19,54,98/
      DATA ITAXIS(3),IBAXIS(3),ILAXIS(3),IRAXIS(3)/27,45,5,49/
      DATA ITAXIS(4),IBAXIS(4),ILAXIS(4),IRAXIS(4)/ 27,45,54,98/
C
      IPR=6
      ILOWER=2
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      WRITE(IPR,998)
      IF(N.LT.ILOWER.OR.N.GT.IUPPER)GOTO50
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      RETURN
   50 WRITE(IPR,17)ILOWER,IUPPER
      WRITE(IPR,47)N
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,   '***** FATAL ERROR--THE FIRST  INPUT ARGUMENT (A VEC
     1TOR) TO THE PLOTU  SUBROUTINE HAS ALL ELEMENTS = ',E15.8,
     1' *****')
   17 FORMAT(1H ,   '***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 PLOTU  SUBROUTINE IS OUTSIDE THE ALLOWABLE (',I1,',',I6, ') INTER
     1VAL *****')
   47 FORMAT(1H , '***** THE VALUE OF THE ARGUMENT IS ',I8   ,' *****')
C
C-----START POINT-----------------------------------------------------
C
C     PRODUCE THE FIRST PLOT (UPPER LEFT)--X(I) VERSUS I
C
C     DETERMINE THE VERTICAL AXIS VECTOR Y2, THE HORIZONTAL 
C     AXIS VECTOR X2, AND THE PLOT SAMPLE SIZE N2 FOR THIS
C     PARTICUAR PLOT.
C
      N2=N
      DO100I=1,N2
      Y2(I)=X(I)
      X2(I)=I
  100 CONTINUE
C
      IPLOT=1
      GOTO5000
C
C*********************************************************************
C
C     PRODUCE THE SECOND PLOT (UPPER RIGHT)--X(I) VERSUS X(I-1)
C
C     DETERMINE THE VERTICAL AXIS VECTOR Y2, THE HORIZONTAL 
C     AXIS VECTOR X2, AND THE PLOT SAMPLE SIZE N2 FOR THIS
C     PARTICULAR PLOT.
C
 2000 N2=N-1
      DO1100I=1,N2
      IP1=I+1
      Y2(I)=X(IP1)
      X2(I)=X(I)
 1100 CONTINUE
C
      IPLOT=2
      GOTO5000
C
C*********************************************************************
C
C     PRODUCE THE THIRD PLOT (LOWER LEFT)-A HISTOGRAM
C
 3000 N2=41
      INC=3
C
C     COMPUTE THE SAMPLE MEAN AND SAMPLE STANDARD DEVIATION 
C
      AN=N
      SUM=0.0
      DO3100I=1,N
      SUM=SUM+X(I)
 3100 CONTINUE
      XMEAN=SUM/AN
      SUM=0.0
      DO 3200I=1,N
      SUM=SUM+(X(I)-XMEAN)**2 
 3200 CONTINUE
      S=SQRT(SUM/(AN-1.0))
C
C     FORM THE FREQUENCY TABLE (Y2) WHICH CORRESPONDS TO A HISTOGRAM
C     WITH 41 CLASSES AND A CLASS WIDTH OF THREE TENTHS OF A SAMPLE STANDARD
C     DEVIATION.
C
      DO3300I=1,41
      Y2(I)=0.0
 3300 CONTINUE
C
      NUMOUT=0
      DO3400I=1,N
      Z=(X(I)-XMEAN)/S
      IF(-6.0.LE.Z.AND.Z.LE.6.0)GOTO3450
      NUMOUT=NUMOUT+1
      GOTO3400
 3450 CONTINUE
      MT=((Z+6.0)/0.3)+1.5
      Y2(MT)=Y2(MT)+1.0
 3400 CONTINUE
C
      DO3800I=1,41
      AI=I
      X2(I)=XMEAN+((AI-21.0)*0.3)*S
 3800 CONTINUE
C
      NUMCLA=41
      CWIDSD=0.3
      CWIDTH=CWIDSD*S
C
      IPLOT=3
      GOTO5000
C
C*********************************************************************
C
C     PRODUCE THE FOURTH PLOT (LOWER RIGHT)--A NORMAL PROBABILITY PLOT
C
C     DETERMINE THE VERTICAL AXIS VECTOR Y2, THE HORIZONTAL 
C     AXIS VECTOR X2, AND THE PLOT SAMPLE SIZE N2 FOR THIS
C     PARTICUAR PLOT.
C
 4000 N2=N
      CALL SORT(X,N,Y2)
      CALL UNIMED(N,X2)
      DO4100I=1,N
      CALL NORPPF(X2(I),X2(I))
 4100 CONTINUE
C
      IPLOT=4
      GOTO5000
C
C
C*********************************************************************
C
C     OPERATE ON A PARTICULAR PLOT
C
 5000 ITAX=ITAXIS(IPLOT)
      IBAX=IBAXIS(IPLOT)
      ILAX=ILAXIS(IPLOT)
      IRAX=IRAXIS(IPLOT)
C
      ITAXP2=ITAX+2 
      IBAXM2=IBAX-2 
      ILAXP2=ILAX+2 
      IRAXM2=IRAX-2 
      ILAXM4=ILAX-4 
      ILAXM3=ILAX-3 
      ILAXM2=ILAX-2 
      ILAXM1=ILAX-1 
      IYMID=(ITAXP2+IBAXM2)/2 
      IXMID=(ILAXP2+IRAXM2)/2 
      HEIGHT=IBAXM2-ITAXP2
      WIDTH=IRAXM2-ILAXP2
C
C     BLANK OUT THE GRAPH
C
      DO300I=ITAX,IBAX
      DO350J=ILAXM4,IRAX
      IGRAPH(I,J)=BLANK
  350 CONTINUE
  300 CONTINUE
C
C     PRODUCE THE Y AXIS
C
      DO400I=ITAXP2,IBAXM2
      IGRAPH(I,ILAX)=ALPHAI
      IGRAPH(I,IRAX)=ALPHAI
  400 CONTINUE
      IYDEL=(IBAXM2-ITAXP2)/2 
      DO450I=ITAXP2,IBAXM2,IYDEL
      IGRAPH(I,ILAX)=HYPHEN
      IGRAPH(I,IRAX)=HYPHEN
  450 CONTINUE
      IGRAPH(ITAXP2,ILAXM4)=EQUAL
      IGRAPH(ITAXP2,ILAXM3)=ALPHAM
      IGRAPH(ITAXP2,ILAXM2)=ALPHAA
      IGRAPH(ITAXP2,ILAXM1)=ALPHAX
      IGRAPH(IYMID,ILAXM4)=EQUAL
      IGRAPH(IYMID,ILAXM3)=ALPHAM
      IGRAPH(IYMID,ILAXM2)=ALPHAI
      IGRAPH(IYMID,ILAXM1)=ALPHAD
      IGRAPH(IBAXM2,ILAXM4)=EQUAL
      IGRAPH(IBAXM2,ILAXM3)=ALPHAM
      IGRAPH(IBAXM2,ILAXM2)=ALPHAI
      IGRAPH(IBAXM2,ILAXM1)=ALPHAN
C
C     PRODUCE THE X AXIS
C
      DO500J=ILAXP2,IRAXM2
      IGRAPH(ITAX,J)=HYPHEN
      IGRAPH(IBAX,J)=HYPHEN
  500 CONTINUE
      IXDEL=(IRAXM2-ILAXP2)/4 
      DO550J=ILAXP2,IRAXM2,IXDEL
      IGRAPH(ITAX,J)=ALPHAI
      IGRAPH(IBAX,J)=ALPHAI
  550 CONTINUE
C
C     DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS
C
      YMIN=Y2(1)
      YMAX=Y2(1)
      DO600I=1,N2
      IF(Y2(I).LT.YMIN)YMIN=Y2(I)
      IF(Y2(I).GT.YMAX)YMAX=Y2(I)
  600 CONTINUE
      IF(IPLOT.EQ.3)YMIN=1.0
      DO650I=ITAXP2,IBAXM2
      ANUM=I-ITAXP2 
      YLABLE(I,IPLOT)=YMAX-(ANUM/HEIGHT)*(YMAX-YMIN)
  650 CONTINUE
C
C     DETERMINE XMIN, XMAX, XMID, X25 (=THE 25% POINT), AND 
C     X75 (=THE 75% POINT)
C
      XMIN2=X2(1)
      XMAX2=X2(1)
      DO700I=1,N2
      IF(X2(I).LT.XMIN2)XMIN2=X2(I)
      IF(X2(I).GT.XMAX2)XMAX2=X2(I)
  700 CONTINUE
      XMIN(IPLOT)=XMIN2
      XMAX(IPLOT)=XMAX2
      XMID(IPLOT)=(XMIN2+XMAX2)/2.0
      X25(IPLOT)=0.75*XMIN2+0.25*XMAX2
      X75(IPLOT)=0.25*XMIN2+0.75*XMAX2
C
C     DETERMINE THE (X,Y) PLOT POSITIONS
C
      RATIOY=0.0
      RATIOX=0.0
      IF(YMAX.GT.YMIN)RATIOY=HEIGHT/(YMAX-YMIN)
      IF(XMAX(IPLOT).GT.XMIN(IPLOT))RATIOX=
     1WIDTH/(XMAX(IPLOT)-XMIN(IPLOT))
      IF(IPLOT.EQ.3)GOTO750
      DO800I=1,N2
      MX=RATIOX*(X2(I)-XMIN(IPLOT))+0.5 
      MX=MX+ILAXP2
      MY=RATIOY*(Y2(I)-YMIN)+0.5
      MY=IBAXM2-MY
      IGRAPH(MY,MX)=ALPHAX
  800 CONTINUE
      GOTO850
C
  750 DO900I=1,N2
      IF(Y2(I).LE.0.5)GOTO900 
      MX=RATIOX*(X2(I)-XMIN(IPLOT))+0.5 
      MX=MX+ILAXP2
      MY=RATIOY*(Y2(I)-YMIN)+0.5
      MY=IBAXM2-MY
      IGRAPH(MY,MX)=ALPHAX
      DO950IY=MY,IBAXM2
      IGRAPH(IY,MX)=ALPHAX
  950 CONTINUE
  900 CONTINUE
C
  850 IF(IPLOT.EQ.1)GOTO2000
      IF(IPLOT.EQ.2)GOTO3000
      IF(IPLOT.EQ.3)GOTO4000
C
C******************************************************************** 
C
C     COMPUTE SUMMARY STATISTICS
C
      ZMIN=Y2(1)
      ZMAX=Y2(N)
      ZRANGE=ZMAX-ZMIN
      ZMEAN=XMEAN
      ZSD=S
      ZDEVB=ZMEAN-ZMIN
      ZRDEVB=0.0
      IF(ZMEAN.NE.0.0)ZRDEVB=100.0*ZDEVB/ZMEAN
      IF(ZRDEVB.LT.0.0)ZRDEVB=-ZRDEVB
      ZDEVA=ZMAX-ZMEAN
      ZRDEVA=0.0
      IF(ZMEAN.NE.0.0)ZRDEVA=100.0*ZDEVA/ZMEAN
      IF(ZRDEVA.LT.0.0)ZRDEVA=-ZRDEVA
C
C     DETERMINE THE NUMBER OF DISTINCT POINTS
C
      NUMDIS=1
      NM1=N-1
      DO7200I=1,NM1 
      IP1=I+1
      IF(Y2(I).EQ.Y2(IP1))GOTO7200
      NUMDIS=NUMDIS+1
 7200 CONTINUE
C
C     COMPUTE THE SAMPLE MEDIAN
C
      NHALF=N/2
      IEVODD=N-2*(N/2)
      IF(IEVODD.EQ.0)GOTO7250 
      ZMED=Y2(NHALF)
      GOTO7260
 7250 NHALFP=NHALF+1
      ZMED=(Y2(NHALF)+Y2(NHALFP))/2.0
 7260 CONTINUE
C
C     DETERMINE THE FREQUENCY OF THE SAMPLE MIN AND MAX
C
      NUMMIN=1
      NM1=N-1
      DO7400I=1,NM1 
      IP1=I+1
      IF(Y2(I).EQ.Y2(IP1))NUMMIN=NUMMIN+1
      IF(Y2(I).EQ.Y2(IP1))GOTO7400
      GOTO7450
 7400 CONTINUE
 7450 NUMMAX=1
      DO7500I=1,NM1 
      IREV=N-I+1
      NMI=N-I
      IF(Y2(IREV).EQ.Y2(NMI))NUMMAX=NUMMAX+1
      IF(Y2(IREV).EQ.Y2(NMI))GOTO7500
      GOTO7550
 7500 CONTINUE
 7550 CONTINUE
      PROMIN=NUMMIN 
      PROMIN=100.0*PROMIN/AN
      PROMAX=NUMMAX 
      PROMAX=100.0*PROMAX/AN
C
C     COMPUTE THE AUTOCORRELATION
C
      ZMEAN1=(AN*ZMEAN-X(N))/(AN-1.0)
      ZMEAN2=(AN*ZMEAN-X(1))/(AN-1.0)
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      NM1=N-1
      DO7600I=1,NM1 
      IP1=I+1
      SUM1=SUM1+(X(I)-ZMEAN1)*(X(IP1)-ZMEAN2)
      SUM2=SUM2+(X(I)-ZMEAN1)**2
      SUM3=SUM3+(X(IP1)-ZMEAN2)**2
 7600 CONTINUE
      SUM23=SUM2*SUM3
      ZAUTOC=9999.99
      IF(SUM23.GT.0.0)ZAUTOC=SUM1/(SQRT(SUM23))
      ZAUTOC=100.0*ZAUTOC
C
C     WRITE EVERYTHING OUT
C
      ITAX=ITAXIS(1)
      IBAX=IBAXIS(1)
      ITAXP1=ITAX+1 
      ITAXP2=ITAX+2 
      IBAXM1=IBAX-1 
      IBAXM2=IBAX-2 
      J1=ILAXIS(1)-4
      J2=IRAXIS(1)
      J3=ILAXIS(2)-4
      J4=IRAXIS(2)
      WRITE(IPR,5104)
      WRITE(IPR,5105)(IGRAPH(ITAX,J),J=J1,J2),(IGRAPH(ITAX,J),J=J3,J4)
      WRITE(IPR,5105)(IGRAPH(ITAXP1,J),J=J1,J2),(IGRAPH(ITAXP1,J),J=J3,J
     14)
      DO5100I=ITAXP2,IBAXM2
      WRITE(IPR,5110)YLABLE(I,1),(IGRAPH(I,J),J=J1,J2),
     1               YLABLE(I,2),(IGRAPH(I,J),J=J3,J4)
 5100 CONTINUE
      WRITE(IPR,5105)(IGRAPH(IBAXM1,J),J=J1,J2),(IGRAPH(IBAXM1,J),J=J3,J
     14)
      WRITE(IPR,5105)(IGRAPH(IBAX,J),J=J1,J2),(IGRAPH(IBAX,J),J=J3,J4)
      WRITE(IPR,5115)XMIN(1),X25(1),XMID(1),X75(1),XMAX(1), 
     1               XMIN(2),X25(2),XMID(2),X75(2),XMAX(2)
C
      ISKIPM=2
      DO5200I=1,ISKIPM
      WRITE(IPR,999)
 5200 CONTINUE
C
      ITAX=ITAXIS(3)
      IBAX=IBAXIS(3)
      ITAXP1=ITAX+1 
      ITAXP2=ITAX+2 
      IBAXM1=IBAX-1 
      IBAXM2=IBAX-2 
      J1=ILAXIS(3)-4
      J2=IRAXIS(3)
      J3=ILAXIS(4)-4
      J4=IRAXIS(4)
      WRITE(IPR,5304)
      WRITE(IPR,5105)(IGRAPH(ITAX,J),J=J1,J2),(IGRAPH(ITAX,J),J=J3,J4)
      WRITE(IPR,5105)(IGRAPH(ITAXP1,J),J=J1,J2),(IGRAPH(ITAXP1,J),J=J3,J
     14)
      DO5300I=ITAXP2,IBAXM2
      WRITE(IPR,5110)YLABLE(I,3),(IGRAPH(I,J),J=J1,J2),
     1               YLABLE(I,4),(IGRAPH(I,J),J=J3,J4)
 5300 CONTINUE
      WRITE(IPR,5105)(IGRAPH(IBAXM1,J),J=J1,J2),(IGRAPH(IBAXM1,J),J=J3,J
     14)
      WRITE(IPR,5105)(IGRAPH(IBAX,J),J=J1,J2),(IGRAPH(IBAX,J),J=J3,J4)
      WRITE(IPR,5115)XMIN(3),X25(3),XMID(3),X75(3),XMAX(3), 
     1               XMIN(4),X25(4),XMID(4),X75(4),XMAX(4)
      WRITE(IPR,5320)
      WRITE(IPR,5325)NUMCLA,N,NUMDIS
      WRITE(IPR,5326)CWIDTH,CWIDSD,ZMIN,NUMMIN,PROMIN
      WRITE(IPR,5330)NUMOUT,ZMED
      WRITE(IPR,5331)ZMEAN
      WRITE(IPR,5332)ZMAX,NUMMAX,PROMAX 
      WRITE(IPR,5334)ZSD,ZRANGE
      WRITE(IPR,5336)ZDEVB,ZRDEVB
      WRITE(IPR,5338)ZDEVA,ZRDEVA
      WRITE(IPR,5340)ZAUTOC
C
 5104 FORMAT(1H ,20X,12X,'PLOT OF X(I) VERSUS I',41X,'PLOT OF ',
     1 'X(I) VERSUS X(I-1)')
 5105 FORMAT(1H ,16X,4A1,45A1,16X,4A1,45A1)
 5110 FORMAT(1H ,F16.7,4A1,45A1,F16.7,4A1,45A1)
 5115 FORMAT(1H ,17X,5F10.4,15X,4F10.4,F9.3)
 5304 FORMAT(1H ,38X,'HISTOGRAM',49X,'NORMAL PROBABILITY PLOT')
 5320 FORMAT(1H ,20X,' -6        -3         0         3         6')
 5325 FORMAT(1H ,20X,'NUMBER OF CLASSES = ',I3,42X,
     1'SAMPLE SIZE =',I9,' DISTINCT POINTS =',I6) 
 5326 FORMAT(1H ,20X,'CLASS WIDTH = ',E14.7,' = ',F3.1,
     1 ' STANDARD DEVIATIONS',11X,
     1'MINIMUM =',F13.6,' COUNT =',I5,' (',F7.2,'%)')
 5330 FORMAT(1H ,16X,I5,' OBSERVATIONS WERE IN EXCESS OF 6 STANDARD', 
     1 ' DEVIATIONS',11X,
     1'MEDIAN =',F14.6)
 5331 FORMAT(1H ,20X,  'ABOUT THE SAMPLE MEAN AND SO WERE NOT PRINTED IN
     1 HISTOGRAM',7X,
     1'MEAN =',F16.6)
 5332 FORMAT(1H ,85X,
     1'MAXIMUM =',F13.6,' COUNT =',I5,' (',F7.2,'%)')
 5334 FORMAT(1H ,85X,
     1'ST. DEV. =',F12.6,' RANGE =',F16.6)
 5336 FORMAT(1H ,20X,65X,'MAX DEV. BELOW MEAN =',F14.6,' (',F7.2,'%)')
 5338 FORMAT(1H ,85X,'MAX DEV. ABOVE MEAN =',F14.6,' (',F7.2,'%)')
 5340 FORMAT(1H ,85X,'AUTOCORR. =',F10.2,'%')
  998 FORMAT(1H1)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE PLOTX(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PLOTX
C
C     PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT
C              OF X(I) VERSUS I.
C     INPUT ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED VERTICALLY.
C                    --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR X.
C     OUTPUT--A ONE-PAGE PRINTER PLOT OF X(I) VERSUS I.
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (X) WHICH ARE
C              EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE
C              PLOTTED.
C              THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM
C              OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR X
C              ARE 'MISSING DATA', OR WHEN WE PURPOSELY
C              WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR X
C              FOR PLOTTING PURPOSES (THAT IS, WE DO NOT
C              WANT CERTAIN ELEMENTS IN X TO BE PLOTTED).
C              TO CAUSE SPECIFIC ELEMENTS IN X TO BE
C              IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND
C              (BY, FOR EXAMPLE, USE OF THE   REPLAC   SUBROUTINE)
C              BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND
C              THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTX
C              SUBROUTINE.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --JANUARY   1975. 
C     UPDATED         --JULY      1975. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --OCTOBER   1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C     UPDATED         --FEBRUARY  1977. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IGRAPH
      CHARACTER*4 SBNAM1,SBNAM2
      CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22
      CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX
      CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL
C
      DIMENSION X(1)
      DIMENSION YLABLE(11)
      COMMON /BLOCK1/ IGRAPH(55,130)
C
      DATA SBNAM1,SBNAM2/'PLOT','X   '/ 
      DATA ALPH11,ALPH12/'FIRS','T   '/ 
      DATA ALPH21,ALPH22/'SECO','ND  '/ 
      DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/
      DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/
C
      IPR=6
      CUTOFF=(10.0**10)-1000.0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      WRITE(IPR,998)
      IF(N.LT.1)GOTO52
      GOTO54
   52 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,20)N
      WRITE(IPR,5)
      RETURN
   54 CONTINUE
      IF(N.EQ.1)GOTO56
      GOTO58
   56 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,22)N
      WRITE(IPR,5)
      RETURN
   58 CONTINUE
C
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO62
   60 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   62 CONTINUE
C
      DO76I=1,N
      IF(X(I).LT.CUTOFF)GOTO78
   76 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   78 CONTINUE
C
    5 FORMAT(1H ,'**************************************************',
     1'********************') 
   10 FORMAT(1H ,'                   FATAL ERROR                    ')
   15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4,
     1' SUBROUTINE')
   20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,1H))
   22 FORMAT(1H ,'HAS THE VALUE 1')
   30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8)
   32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF')
   33 FORMAT(1H ,'VALUE OF ',E15.8)
C
C-----START POINT-----------------------------------------------------
C
C     DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS
C
      DO200I=1,N
      IF(X(I).GE.CUTOFF)GOTO200
      YMIN=X(I)
      YMAX=X(I)
      GOTO250
  200 CONTINUE
  250 DO300I=1,N
      IF(X(I).GE.CUTOFF)GOTO300
      IF(X(I).LT.YMIN)YMIN=X(I)
      IF(X(I).GT.YMAX)YMAX=X(I)
  300 CONTINUE
      DO400I=1,9
      AIM1=I-1
      YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN)
  400 CONTINUE
C
C     DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS.
C     DETERMINE XMIN, XMAX, XMID, X25 (=THE 25% POINT), AND 
C     X75 (=THE 75% POINT).
C
      XMIN=1.0
      XMAX=N
      XMID=(XMIN+XMAX)/2.0
      X25=0.75*XMIN+0.25*XMAX 
      X75=0.25*XMIN+0.75*XMAX 
C
C     BLANK OUT THE GRAPH
C
      DO1100I=1,45
      DO1200J=1,109 
      IGRAPH(I,J)=BLANK
 1200 CONTINUE
 1100 CONTINUE
C
C     PRODUCE THE VERTICAL AXES
C
      DO1300I=3,43
      IGRAPH(I,5)=ALPHAI
      IGRAPH(I,109)=ALPHAI
 1300 CONTINUE
      DO1400I=3,43,5
      IGRAPH(I,5)=HYPHEN
      IGRAPH(I,109)=HYPHEN
 1400 CONTINUE
      IGRAPH(3,1)=EQUAL
      IGRAPH(3,2)=ALPHAM
      IGRAPH(3,3)=ALPHAA
      IGRAPH(3,4)=ALPHAX
      IGRAPH(23,1)=EQUAL
      IGRAPH(23,2)=ALPHAM
      IGRAPH(23,3)=ALPHAI
      IGRAPH(23,4)=ALPHAD
      IGRAPH(43,1)=EQUAL
      IGRAPH(43,2)=ALPHAM
      IGRAPH(43,3)=ALPHAI
      IGRAPH(43,4)=ALPHAN
C
C     PRODUCE THE HORIZONTAL AXES
C
      DO1500J=7,107 
      IGRAPH(1,J)=HYPHEN
      IGRAPH(45,J)=HYPHEN
 1500 CONTINUE
      DO1600J=7,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1600 CONTINUE
      DO1700J=20,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1700 CONTINUE
C
C     DETERMINE THE (X,Y) PLOT POSITIONS
C
      RATIOY=40.0/(YMAX-YMIN) 
      RATIOX=100.0/(XMAX-XMIN)
      DO1800I=1,N
      IF(X(I).GE.CUTOFF)GOTO1800
      XI=I
      MX=RATIOX*(XI-XMIN)+0.5 
      MX=MX+7
      MY=RATIOY*(X(I)-YMIN)+0.5
      MY=43-MY
      IGRAPH(MY,MX)=ALPHAX
 1800 CONTINUE
C
C     WRITE OUT THE GRAPH
C
      WRITE(IPR,2102)
      DO2100I=1,45
      IP2=I+2
      IFLAG=IP2-(IP2/5)*5
      K=IP2/5
      IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109)
      IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109)
 2100 CONTINUE
      WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX
C
 2102 FORMAT(1H ,   'THE FOLLOWING IS A PLOT OF X(I) (VERTICALLY) VERSUS
     1 I (HORIZONTALLY)')
 2105 FORMAT(1H ,20X,109A1)
 2106 FORMAT(1H ,F20.7,109A1) 
 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7)
  998 FORMAT(1H1)
C
      RETURN
      END 
      SUBROUTINE PLOTXT(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PLOTXT
C
C     PURPOSE--THIS SUBROUTINE YIELDS A NARROW-WIDTH (71-CHARACTER)
C              PLOT OF X(I) VERSUS I.  ITS NARROW WIDTH MAKES IT
C              APPROPRIATE FOR USE ON A TERMINAL. 
C     INPUT ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED VERTICALLY.
C                    --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR X.
C     OUTPUT--A NARROW-WIDTH (71-CHARACTER) TERMINAL PLOT
C             OF X(I) VERSUS I.
C             THE BODY OF THE PLOT (NOT COUNTING AXIS VALUES
C             AND MARGINS) IS 25 ROWS (LINES) AND 49 COLUMNS.
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (X) WHICH ARE
C              EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE
C              PLOTTED.
C              THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM
C              OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR X
C              ARE 'MISSING DATA', OR WHEN WE PURPOSELY
C              WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR X
C              FOR PLOTTING PURPOSES (THAT IS, WE DO NOT
C              WANT CERTAIN ELEMENTS IN X TO BE PLOTTED).
C              TO CAUSE SPECIFIC ELEMENTS IN X TO BE
C              IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND
C              (BY, FOR EXAMPLE, USE OF THE   REPLAC   SUBROUTINE)
C              BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND
C              THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTX
C              SUBROUTINE.
C            --NOTE THAT THE STORAGE REQUIREMENTS FOR THIS
C              (AND THE OTHER) TERMINAL PLOT SUBROUTINESS ARE .
C              VERY SMALL.
C              THIS IS DUE TO THE 'ONE LINE AT A TIME' ALGORITHM
C              EMPLOYED FOR THE PLOT.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--FEBRUARY  1974. 
C     UPDATED         --APRIL     1974. 
C     UPDATED         --OCTOBER   1974. 
C     UPDATED         --OCTOBER   1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1977. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 ILINE
      CHARACTER*4 IAXISC
      CHARACTER*4 SBNAM1,SBNAM2
      CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22
      CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX
C
      DIMENSION X(1)
      DIMENSION ILINE(72),AILABL(10)
C
      DATA SBNAM1,SBNAM2/'PLOT','XT  '/ 
      DATA ALPH11,ALPH12/'FIRS','T   '/ 
      DATA ALPH21,ALPH22/'SECO','ND  '/ 
      DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/
C
      IPR=6
      CUTOFF=(10.0**10)-1000.0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO52
      GOTO54
   52 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,20)N
      WRITE(IPR,5)
      RETURN
   54 CONTINUE
      IF(N.EQ.1)GOTO56
      GOTO58
   56 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,22)N
      WRITE(IPR,5)
      RETURN
   58 CONTINUE
C
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO62
   60 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   62 CONTINUE
C
      DO76I=1,N
      IF(X(I).LT.CUTOFF)GOTO78
   76 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   78 CONTINUE
C
    5 FORMAT(1H ,'**************************************************',
     1'********************') 
   10 FORMAT(1H ,'                   FATAL ERROR                    ')
   15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4,
     1' SUBROUTINE')
   20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,1H))
   22 FORMAT(1H ,'HAS THE VALUE 1')
   30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8)
   32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF')
   33 FORMAT(1H ,'VALUE OF ',E15.8)
C
C-----START POINT-----------------------------------------------------
C
C     DEFINE THE NUMBER OF ROWS AND COLUMNS WITHIN THE PLOT--
C     THIS HAS BEEN SET TO 25 ROWS AND 49 COLUMNS.
C
      NUMROW=25
      NUMCOL=49
      ANUMR=NUMROW
      ANUMRM=NUMROW-1
      ANUMCM=NUMCOL-1
      NUMR25=(NUMROW/4)+1
      NUMR50=(NUMROW/2)+1
      NUMR75=3*(NUMROW/4)+1
      IXDEL=(NUMCOL-1)/4
      NUMLAB=5
      ANUMLM=NUMLAB-1
C
C     WRITE OUT THE TOP HORIZONTAL AXIS OF THE PLOT, AND SKIP 1 LINE
C     FOR A MARGIN WITHIN THE PLOT.
C
      WRITE(IPR,999)
      WRITE(IPR,205)
      DO100ICOL=1,NUMCOL
      ILINE(ICOL)=HYPHEN
  100 CONTINUE
      DO200ICOL=1,NUMCOL,IXDEL
      ILINE(ICOL)=ALPHAI
  200 CONTINUE
      WRITE(IPR,305)(ILINE(I),I=1,NUMCOL)
      WRITE(IPR,310)BLANK
C
C     DETERMINE THE MIN AND MAX VALUES OF X, AND OF I.
C
      XMIN=X(1)
      XMAX=X(1)
      AIMIN=1
      AIMAX=N
      DO300I=1,N
      IF(X(I).GE.CUTOFF)GOTO300
      IF(X(I).LT.XMIN)XMIN=X(I)
      IF(X(I).GT.XMAX)XMAX=X(I)
  300 CONTINUE
      DELX=XMAX-XMIN
      DELAI=AIMAX-AIMIN
      XWIDTH=DELX/ANUMRM
      AIWIDT=DELAI/ANUMCM
C
C     DETERMINE AND WRITE OUT THE PLOT POSITIONS ONE LINE AT A TIME.
C
      DO400IROW=1,NUMROW
      DO500ICOL=1,NUMCOL
      ILINE(ICOL)=BLANK
  500 CONTINUE
      AIROW=IROW
      XUPPER=XMAX+(1.5-AIROW)*XWIDTH
      XLABLE=XMAX+(1.0-AIROW)*XWIDTH
      XLOWER=XMAX+(0.5-AIROW)*XWIDTH
      IF(IROW.EQ.NUMROW)XLABLE=XMIN
      DO600I=1,N
      AI=I
      IF(X(I).GE.CUTOFF)GOTO600
      IF(XLOWER.LE.X(I).AND.X(I).LT.XUPPER)GOTO650
      GOTO600
  650 ICOL=((AI-AIMIN)/AIWIDT)+1.5
      ILINE(ICOL)=ALPHAX
  600 CONTINUE
      ICOLMX=1
      DO700ICOL=1,NUMCOL
      IF(ILINE(ICOL).EQ.ALPHAX)ICOLMX=ICOL
  700 CONTINUE
      IAXISC=ALPHAI 
      IF(IROW.EQ.1.OR.IROW.EQ.NUMROW)IAXISC=HYPHEN
      IF(IROW.EQ.NUMR25.OR.IROW.EQ.NUMR50.OR.IROW.EQ.NUMR75)
     1IAXISC=HYPHEN 
      WRITE(IPR,710)XLABLE,IAXISC,(ILINE(ICOL),ICOL=1,ICOLMX)
  400 CONTINUE
C
C     SKIP 1 LINE FOR A BOTTOM MARGIN WITHIN THE PLOT, WRITE OUT THE
C     BOTTOM HORIZONTAL AXIS, AND WRITE OUT THE X AXIS LABLES.
C
      WRITE(IPR,310)BLANK
      DO800ICOL=1,NUMCOL
      ILINE(ICOL)=HYPHEN
  800 CONTINUE
      DO900ICOL=1,NUMCOL,IXDEL
      ILINE(ICOL)=ALPHAI
  900 CONTINUE
      WRITE(IPR,305)(ILINE(ICOL),ICOL=1,NUMCOL)
      DO1000I=1,NUMLAB
      AIM1=I-1
      AILABL(I)=AIMIN+(AIM1/ANUMLM)*DELAI
 1000 CONTINUE
      WRITE(IPR,910)(AILABL(I),I=1,NUMLAB)
C
  205 FORMAT(1H , 'THE FOLLOWING IS A PLOT OF X(I) (VERTICALLY) ',
     1'VERSUS I (HORIZONTALLY')
  305 FORMAT(1H ,18X,54A1)
  310 FORMAT(1H ,15X,A1)
  710 FORMAT(1H ,E14.7,1X,A1,2X,50A1)
  910 FORMAT(1H ,9X,5E12.4)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE PLOTXX(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PLOTXX
C
C     PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT
C              OF X(I) VERSUS X(I-1).
C              THIS TYPE OF PLOT (WHICH IS CALLED AN
C              AUTOCORRELATION PLOT OR A LAG 1 PLOT)
C              IS USEFUL IN EXAMINING FOR
C              AUTOCORRELATION IN A SEQUENCE OF OBSERVATIONS.
C              UNCORRELATED DATA WILL PRODUCE AN AUTOCORRELATION
C              PLOT WITH NO APPARENT STRUCTURE; AUTOCORRELATED
C              DATA WILL PRODUCE AN AUTOCORRELATION PLOT WITH
C              LINEAR, ELLIPTICAL, OR OTHER KINDS OF STRUCTURE.
C     INPUT ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED) OBSERVATIONS
C                               TO BE GRAPHICALLY TESTED FOR
C                               AUTOCORRELATION.
C                    --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR X.
C     OUTPUT--A ONE-PAGE PRINTER PLOT OF X(I) VERSUS X(I-1).
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--VALUES IN THE INPUT VECTOR X WHICH ARE
C              EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE
C              PLOTTED.
C              THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM
C              OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR X
C              ARE 'MISSING DATA', OR WHEN WE PURPOSELY
C              WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR X
C              FOR PLOTTING PURPOSES (THAT IS, WE DO NOT
C              WANT CERTAIN ELEMENTS IN X TO BE PLOTTED).
C              TO CAUSE SPECIFIC ELEMENTS IN X TO BE
C              IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND
C              (BY, FOR EXAMPLE, USE OF THE   REPLAC   SUBROUTINE)
C              BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND
C              THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTXX
C              SUBROUTINE.
C     REFERENCES--FILLIBEN, 'SOME USEFUL PROCEDURES FOR THE 
C                 STATISTICAL ANALYSIS OF DATA', UNPUBLISHED
C                 MANUSCRIPT (AVAILABLE FROM AUTHOR)
C                 PRESENTED AT THE FALL CONFERENCE
C                 OF THE CHEMICAL DIVISION OF THE AMERICAN
C                 SOCIETY FOR QUALITY CONTROL, KNOXVILLE,
C                 TENNESSEE, OCTOBER 19-20, 1972. 
C               --FILLIBEN, 'DATA EXPLORATION USING STAND-ALONE
C                 SUBROUTINES', UNPUBLISHED MANUSCRIPT
C                 (AVAILABLE FROM AUTHOR)
C                 PRESENTED AT THE 'STRATEGY FOR DATA ANALYSIS
C                 BY COMPUTERS' SESSION AT THE NATIONAL
C                 MEETING OF THE AMERICAN STATISTICAL ASSOCIATION,
C                 ST. LOUIS, MISSOURI, AUGUST 26-29, 1974.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --OCTOBER   1974. 
C     UPDATED         --NOVEMBER  1974. 
C     UPDATED         --JANUARY   1975. 
C     UPDATED         --JULY      1975. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --OCTOBER   1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C     UPDATED         --FEBRUARY  1977. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IGRAPH
      CHARACTER*4 SBNAM1,SBNAM2
      CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22
      CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX
      CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL
C
      DIMENSION X(1)
      DIMENSION YLABLE(11)
      COMMON /BLOCK1/ IGRAPH(55,130)
C
      DATA SBNAM1,SBNAM2/'PLOT','XX  '/ 
      DATA ALPH11,ALPH12/'FIRS','T   '/ 
      DATA ALPH21,ALPH22/'SECO','ND  '/ 
      DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/
      DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/
C
      IPR=6
      CUTOFF=(10.0**10)-1000.0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      WRITE(IPR,998)
      IF(N.LT.1)GOTO52
      GOTO54
   52 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,20)N
      WRITE(IPR,5)
      RETURN
   54 CONTINUE
      IF(N.EQ.1)GOTO56
      GOTO58
   56 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,22)N
      WRITE(IPR,5)
      RETURN
   58 CONTINUE
C
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO62
   60 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   62 CONTINUE
C
      DO76I=1,N
      IF(X(I).LT.CUTOFF)GOTO78
   76 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   78 CONTINUE
C
    5 FORMAT(1H ,'**************************************************',
     1'********************') 
   10 FORMAT(1H ,'                   FATAL ERROR                    ')
   15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4,
     1' SUBROUTINE')
   20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,1H))
   22 FORMAT(1H ,'HAS THE VALUE 1')
   30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8)
   32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF')
   33 FORMAT(1H ,'VALUE OF ',E15.8)
C
C-----START POINT-----------------------------------------------------
C
C     DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS
C
      DO200I=1,N
      IF(X(I).GE.CUTOFF)GOTO200
      YMIN=X(I)
      YMAX=X(I)
      GOTO250
  200 CONTINUE
  250 DO300I=1,N
      IF(X(I).GE.CUTOFF)GOTO300
      IF(X(I).LT.YMIN)YMIN=X(I)
      IF(X(I).GT.YMAX)YMAX=X(I)
  300 CONTINUE
      DO400I=1,9
      AIM1=I-1
      YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN)
  400 CONTINUE
C
C     DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS.
C     DETERMINE XMIN, XMAX, XMID, X25 (=THE 25% POINT), AND 
C     X75 (=THE 75% POINT).
C
      XMIN=YMIN
      XMAX=YMAX
      XMID=(XMIN+XMAX)/2.0
      X25=0.75*XMIN+0.25*XMAX 
      X75=0.25*XMIN+0.75*XMAX 
C
C     BLANK OUT THE GRAPH
C
      DO1100I=1,45
      DO1200J=1,109 
      IGRAPH(I,J)=BLANK
 1200 CONTINUE
 1100 CONTINUE
C
C     PRODUCE THE VERTICAL AXES
C
      DO1300I=3,43
      IGRAPH(I,5)=ALPHAI
      IGRAPH(I,109)=ALPHAI
 1300 CONTINUE
      DO1400I=3,43,5
      IGRAPH(I,5)=HYPHEN
      IGRAPH(I,109)=HYPHEN
 1400 CONTINUE
      IGRAPH(3,1)=EQUAL
      IGRAPH(3,2)=ALPHAM
      IGRAPH(3,3)=ALPHAA
      IGRAPH(3,4)=ALPHAX
      IGRAPH(23,1)=EQUAL
      IGRAPH(23,2)=ALPHAM
      IGRAPH(23,3)=ALPHAI
      IGRAPH(23,4)=ALPHAD
      IGRAPH(43,1)=EQUAL
      IGRAPH(43,2)=ALPHAM
      IGRAPH(43,3)=ALPHAI
      IGRAPH(43,4)=ALPHAN
C
C     PRODUCE THE HORIZONTAL AXES
C
      DO1500J=7,107 
      IGRAPH(1,J)=HYPHEN
      IGRAPH(45,J)=HYPHEN
 1500 CONTINUE
      DO1600J=7,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1600 CONTINUE
      DO1700J=20,107,25
      IGRAPH(1,J)=ALPHAI
      IGRAPH(45,J)=ALPHAI
 1700 CONTINUE
C
C     DETERMINE THE (X,Y) PLOT POSITIONS
C
      RATIOY=40.0/(YMAX-YMIN) 
      RATIOX=100.0/(XMAX-XMIN)
      DO1800I=2,N
      IM1=I-1
      IF(X(I).GE.CUTOFF)GOTO1800
      IF(X(IM1).GE.CUTOFF)GOTO1800
      MX=RATIOX*(X(IM1)-XMIN)+0.5
      MX=MX+7
      MY=RATIOY*(X(I)-YMIN)+0.5
      MY=43-MY
      IGRAPH(MY,MX)=ALPHAX
 1800 CONTINUE
C
C     WRITE OUT THE GRAPH
C
      WRITE(IPR,2102)
      DO2100I=1,45
      IP2=I+2
      IFLAG=IP2-(IP2/5)*5
      K=IP2/5
      IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109)
      IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109)
 2100 CONTINUE
      WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX
C
 2102 FORMAT(1H ,   'THE FOLLOWING IS A PLOT OF X(I) (VERTICALLY) VERSUS
     1 X(I-1) (HORIZONTALLY)')
 2105 FORMAT(1H ,20X,109A1)
 2106 FORMAT(1H ,F20.7,109A1) 
 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7)
  998 FORMAT(1H1)
C
      RETURN
      END 
      SUBROUTINE PLTSCT(Y,X,CHAR,N,D,DMIN,DMAX)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PLTSCT
C
C     PURPOSE--THIS SUBROUTINE YIELDS A NARROW-WIDTH (71-CHARACTER)
C              PLOT OF Y(I) VERSUS X(I): 
C              1) WITH SPECIAL PLOT CHARACTERS; AND
C              2) WITH ONLY THOSE POINTS (X(I),Y(I)) PLOTTED
C                 FOR WHICH THE CORRESPONDING VALUE OF D(I) 
C                 IS BETWEEN THE SPECIFIED VALUES OF DMIN AND DMAX.
C
C              ITS NARROW WIDTH MAKES IT APPROPRIATE FOR USE ON A
C              TERMINAL.
C              THE 'SPECIAL PLOTTING CHARACTER' CAPABILITY
C              ALLOWS THE DATA ANALYST TO INCORPORATE INFORMATION
C              FROM A THIRD VARIABLE (ASIDE FROM Y AND X) INTO
C              THE PLOT.
C              THE PLOT CHARACTER USED AT THE I-TH PLOTTING 
C              POSITION (THAT IS, AT THE COORDINATE (X(I),Y(I)))
C              WILL BE
C              1 IF CHAR(I) IS BETWEEN  0.5 AND  1.5
C              2 IF CHAR(I) IS BETWEEN  1.5 AND  2.5
C                .
C                .
C                .
C              9 IF CHAR(I) IS BETWEEN  8.5 AND  9.5
C              0 IF CHAR(I) IS BETWEEN  9.5 AND 10.5
C              A IF CHAR(I) IS BETWEEN 10.5 AND 11.5
C              B IF CHAR(I) IS BETWEEN 11.5 AND 12.5
C              C IF CHAR(I) IS BETWEEN 12.5 AND 13.5
C                .
C                .
C                .
C              W IF CHAR(I) IS BETWEEN 32.5 AND 33.5
C              X IF CHAR(I) IS BETWEEN 33.5 AND 34.5
C              Y IF CHAR(I) IS BETWEEN 34.5 AND 35.5
C              Z IF CHAR(I) IS BETWEEN 35.5 AND 36.5
C              X IF CHAR(I) IS ANY VALUE OUTSIDE THE RANGE
C                                       0.5 TO  36.5.
C              THE USE OF THE SUBSET DEFINTION VECTOR D
C              GIVES THE DATA ANALYST THE CAPABILITY OF
C              PLOTTING SUBSETS OF THE DATA,
C              WHERE THE SUBSET IS DEFINED
C              BY VALUES IN THE VECTOR D.
C
C     INPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED VERTICALLY.
C                    --X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED OR SORTED) OBSERVATIONS
C                               TO BE PLOTTED HORIZONTALLY. 
C                    --CHAR   = THE SINGLE PRECISION VECTOR OF
C                               OBSERVATIONS WHICH CONTROL THE
C                               VALUE OF EACH INDIVIDUAL PLOT
C                               CHARACTER.
C                    --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR Y.
C                    --D      = THE SINGLE PRECISION VECTOR 
C                               WHICH 'DEFINES' THE VARIOUS 
C                               POSSIBLE SUBSETS. 
C                    --DMIN   = THE SINGLE PRECISION VALUE
C                               WHICH DEFINES THE LOWER BOUND
C                               (INCLUSIVELY) OF THE PARTICULAR
C                               SUBSET OF INTEREST TO BE PLOTTED.
C                    --DMAX   = THE SINGLE PRECISION VALUE
C                               WHICH DEFINES THE UPPER BOUND
C                               (INCLUSIVELY) OF THE PARTICULAR
C                               SUBSET OF INTEREST TO BE PLOTTED.
C     OUTPUT--A NARROW-WIDTH (71-CHARACTER) TERMINAL PLOT
C             OF Y(I) VERSUS X(I) WITH SPECIAL PLOT CHARACTERS
C             AND FOR ONLY A SPECIFIED SUBSET OF THE DATA.
C             THE BODY OF THE PLOT (NOT COUNTING AXIS VALUES
C             AND MARGINS) IS 25 ROWS (LINES) AND 49 COLUMNS.
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--FOR A GIVEN DUMMY INDEX I,
C              IF D(I) IS SMALLER THAN DMIN OR LARGER THAN DMAX,
C              THEN THE CORRESPONDING POINT (X(I),Y(I))
C              WILL NOT BE PLOTTED.
C            --VALUES IN THE VERTICAL AXIS VECTOR (Y),
C              THE HORIZONTAL AXIS VECTOR (X),
C              OR THE PLOT CHARACTER VECTOR (CHAR) WHICH ARE
C              EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE
C              PLOTTED.
C              THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM
C              OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y
C              (OR X, OR CHAR) ARE 'MISSING DATA', OR WHEN WE PURPOSELY
C              WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y
C              (OR X, OR CHAR) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT
C              WANT CERTAIN ELEMENTS IN Y (OR X, OR CHAR) TO BE
C              PLOTTED).
C              TO CAUSE SPECIFIC ELEMENTS IN Y (OR X, OR CHAR) TO BE
C              IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND
C              (BY, FOR EXAMPLE, USE OF THE   REPLAC   SUBROUTINE)
C              BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND
C              THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTC
C              SUBROUTINE.
C     REFERENCES--FILLIBEN, 'STATISTICAL ANALYSIS OF INTERLAB
C                 FATIGUE TIME DATA', UNPUBLISHED MANUSCRIPT
C                 (AVAILABLE FROM AUTHOR)
C                 PRESENTED AT THE 'COMPUTER-ASSISTED DATA
C                 ANALYSIS' SESSION AT THE NATIONAL MEETING 
C                 OF THE AMERICAN STATISTICAL ASSOCIATION,
C                 NEW YORK CITY, DECEMBER 27-30, 1973.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1977. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 ILINE
      CHARACTER*4 IAXISC
      CHARACTER*4 IPLOTC
      CHARACTER*4 JPLOTC
      CHARACTER*4 SBNAM1,SBNAM2
      CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 
      CHARACTER*4 ALPH41,ALPH42,ALPH51,ALPH52
      CHARACTER*4 BLANK,HYPHEN,ALPHAI
C
      DIMENSION Y(1)
      DIMENSION X(1)
      DIMENSION CHAR(1)
      DIMENSION D(1)
      DIMENSION ILINE(72),XLABLE(10)
      DIMENSION IPLOTC(37)
C
      DATA SBNAM1,SBNAM2/'PLTS','CT  '/ 
      DATA ALPH11,ALPH12/'FIRS','T   '/ 
      DATA ALPH21,ALPH22/'SECO','ND  '/ 
      DATA ALPH31,ALPH32/'THIR','D   '/ 
      DATA ALPH41,ALPH42/'FOUR','TH  '/ 
      DATA ALPH51,ALPH52/'FIFT','H   '/ 
      DATA BLANK,HYPHEN,ALPHAI/' ','-','I'/
      DATA IPLOTC(1),IPLOTC(2),IPLOTC(3),IPLOTC(4),IPLOTC(5),
     1IPLOTC(6),IPLOTC(7),IPLOTC(8),IPLOTC(9),IPLOTC(10),
     1IPLOTC(11),IPLOTC(12),IPLOTC(13),IPLOTC(14),IPLOTC(15),
     1IPLOTC(16),IPLOTC(17),IPLOTC(18),IPLOTC(19),IPLOTC(20),
     1IPLOTC(21),IPLOTC(22),IPLOTC(23),IPLOTC(24),IPLOTC(25),
     1IPLOTC(26),IPLOTC(27),IPLOTC(28),IPLOTC(29),IPLOTC(30),
     1IPLOTC(31),IPLOTC(32),IPLOTC(33),IPLOTC(34),IPLOTC(35),
     1IPLOTC(36),IPLOTC(37)
     1/'1','2','3','4','5','6','7','8','9','0','A','B','C','D','E','F',
     1'G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V',
     1'W','X','Y','Z','X'/
C
      IPR=6
      CUTOFF=(10.0**10)-1000.0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO52
      GOTO54
   52 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,20)N
      WRITE(IPR,5)
      RETURN
   54 CONTINUE
      IF(N.EQ.1)GOTO56
      GOTO58
   56 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2
      WRITE(IPR,22)N
      WRITE(IPR,5)
      RETURN
   58 CONTINUE
C
      HOLD=Y(1)
      DO60I=2,N
      IF(Y(I).NE.HOLD)GOTO62
   60 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   62 CONTINUE
      HOLD=X(1)
      DO64I=2,N
      IF(X(I).NE.HOLD)GOTO66
   64 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   66 CONTINUE
      HOLD=CHAR(1)
      DO68I=2,N
      IF(CHAR(I).NE.HOLD)GOTO70
   68 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,11) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
   70 CONTINUE
      HOLD=D(1)
      DO72I=2,N
      IF(D(I).NE.HOLD)GOTO74
   72 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,11) 
      WRITE(IPR,15)ALPH51,ALPH52,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
   74 CONTINUE
C
      DO76I=1,N
      IF(Y(I).LT.CUTOFF)GOTO78
   76 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   78 CONTINUE
      DO80I=1,N
      IF(X(I).LT.CUTOFF)GOTO82
   80 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   82 CONTINUE
      DO84I=1,N
      IF(CHAR(I).LT.CUTOFF)GOTO86
   84 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   86 CONTINUE
      DO88I=1,N
      IF(D(I).LT.CUTOFF)GOTO90
   88 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH51,ALPH52,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   90 CONTINUE
C
      DO92I=1,N
      IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)GOTO94
   92 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH51,ALPH52,SBNAM1,SBNAM2
      WRITE(IPR,34) 
      WRITE(IPR,35)DMIN,DMAX
      WRITE(IPR,36) 
      WRITE(IPR,5)
      RETURN
   94 CONTINUE
C
      N2=0
      DO96I=1,N
      IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF.AND.CHAR(I).LT.CUTOFF.AND. 
     1D(I).LT.CUTOFF)GOTO98
      GOTO96
   98 IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)N2=N2+1
      IF(N2.GE.2)GOTO99
   96 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32,
     1ALPH51,ALPH52 
      WRITE(IPR,19)SBNAM1,SBNAM2
      WRITE(IPR,40) 
      WRITE(IPR,41)N2
      WRITE(IPR,5)
      RETURN
   99 CONTINUE
C
    5 FORMAT(1H ,'**************************************************',
     1'********************') 
   10 FORMAT(1H ,'                   FATAL ERROR                    ')
   11 FORMAT(1H ,'               NON-FATAL DIAGNOSTIC               ')
   15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4,
     1' SUBROUTINE')
   18 FORMAT(1H ,'THE ',A4,A4,', ',A4,A4,', ',A4,A4,', AND ',A4,A4)
   19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE')
   20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,')')
   22 FORMAT(1H ,'HAS THE VALUE 1')
   30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8)
   32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF')
   33 FORMAT(1H ,'VALUE OF ',E15.8)
   34 FORMAT(1H ,'HAS ALL ELEMENTS OUTSIDE THE INTERVAL')
   35 FORMAT(1H ,'(',E15.8,',',E15.8,')',' AS DEFINED BY')
   36 FORMAT(1H ,'THE SIXTH  AND SEVENTH INPUT ARGUMENTS.') 
   40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 
     1' EXCLUDED FROM THE PLOT.')
   41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.')
C
C-----START POINT-----------------------------------------------------
C
C     DEFINE THE NUMBER OF ROWS AND COLUMNS WITHIN THE PLOT--THIS HAS 
C     BEEN SET TO 25 ROWS AND 49 COLUMNS.
C
      NUMROW=25
      NUMCOL=49
      ANUMR=NUMROW
      ANUMRM=NUMROW-1
      ANUMCM=NUMCOL-1
      NUMR25=(NUMROW/4)+1
      NUMR50=(NUMROW/2)+1
      NUMR75=3*(NUMROW/4)+1
      IXDEL=(NUMCOL-1)/4
      NUMLAB=5
      ANUMLM=NUMLAB-1
C
C     SKIP A LINE, WRITE OUT AN IDENTIFYING LINE FOR THE TYPE OF PLOT,
C     WRITE OUT THE TOP HORIZONTAL AXIS OF THE PLOT, AND SKIP 1 LINE
C     FOR A MARGIN WITHIN THE PLOT.
C
      WRITE(IPR,999)
      WRITE(IPR,205)
      DO100ICOL=1,NUMCOL
      ILINE(ICOL)=HYPHEN
  100 CONTINUE
      DO200ICOL=1,NUMCOL,IXDEL
      ILINE(ICOL)=ALPHAI
  200 CONTINUE
      WRITE(IPR,305)(ILINE(I),I=1,NUMCOL)
      WRITE(IPR,310)BLANK
C
C     DETERMINE THE MIN AND MAX VALUES OF Y, AND OF X.
C
      DO250I=1,N
      IF(Y(I).GE.CUTOFF)GOTO250
      IF(X(I).GE.CUTOFF)GOTO250
      IF(CHAR(I).GE.CUTOFF)GOTO250
      IF(D(I).LT.DMIN)GOTO250 
      IF(D(I).GT.DMAX)GOTO250 
      YMIN=Y(I)
      YMAX=Y(I)
      XMIN=X(I)
      XMAX=X(I)
      GOTO270
  250 CONTINUE
  270 DO300I=1,N
      IF(Y(I).GE.CUTOFF)GOTO300
      IF(X(I).GE.CUTOFF)GOTO300
      IF(CHAR(I).GE.CUTOFF)GOTO300
      IF(D(I).LT.DMIN)GOTO300 
      IF(D(I).GT.DMAX)GOTO300 
      IF(Y(I).LT.YMIN)YMIN=Y(I)
      IF(Y(I).GT.YMAX)YMAX=Y(I)
      IF(X(I).LT.XMIN)XMIN=X(I)
      IF(X(I).GT.XMAX)XMAX=X(I)
  300 CONTINUE
      DELY=YMAX-YMIN
      DELX=XMAX-XMIN
      YWIDTH=DELY/ANUMRM
      XWIDTH=DELX/ANUMCM
C
C     DETERMINE AND WRITE OUT THE PLOT POSITIONS ONE LINE AT A TIME.
C     ALSO DETERMINE THE APPROPRIATE PLOT CHARACTERS.
C
      DO400IROW=1,NUMROW
      DO500ICOL=1,NUMCOL
      ILINE(ICOL)=BLANK
  500 CONTINUE
      AIROW=IROW
      YUPPER=YMAX+(1.5-AIROW)*YWIDTH
      YLABLE=YMAX+(1.0-AIROW)*YWIDTH
      YLOWER=YMAX+(0.5-AIROW)*YWIDTH
      IF(IROW.EQ.NUMROW)YLABLE=YMIN
      DO600I=1,N
      IF(Y(I).GE.CUTOFF)GOTO600
      IF(X(I).GE.CUTOFF)GOTO600
      IF(CHAR(I).GE.CUTOFF)GOTO600
      IF(D(I).LT.DMIN)GOTO600 
      IF(D(I).GT.DMAX)GOTO600 
      IF(YLOWER.LE.Y(I).AND.Y(I).LT.YUPPER)GOTO650
      GOTO600
  650 ICOL=((X(I)-XMIN)/XWIDTH)+1.5
      IA=CHAR(I)+0.5
      IF(1.LE.IA.AND.IA.LE.36)GOTO630
  620 JPLOTC=IPLOTC(37)
      GOTO640
  630 JPLOTC=IPLOTC(IA)
  640 ILINE(ICOL)=JPLOTC
  600 CONTINUE
      ICOLMX=1
      DO700ICOL=1,NUMCOL
      IF(ILINE(ICOL).NE.BLANK)ICOLMX=ICOL
  700 CONTINUE
      IAXISC=ALPHAI 
      IF(IROW.EQ.1.OR.IROW.EQ.NUMROW)IAXISC=HYPHEN
      IF(IROW.EQ.NUMR25.OR.IROW.EQ.NUMR50.OR.IROW.EQ.NUMR75)
     1IAXISC=HYPHEN 
      WRITE(IPR,710)YLABLE,IAXISC,(ILINE(ICOL),ICOL=1,ICOLMX)
  400 CONTINUE
C
C     SKIP 1 LINE FOR A BOTTOM MARGIN WITHIN THE PLOT, WRITE OUT THE
C     BOTTOM HORIZONTAL AXIS, AND WRITE OUT THE X AXIS LABLES.
C
      WRITE(IPR,310)BLANK
      DO800ICOL=1,NUMCOL
      ILINE(ICOL)=HYPHEN
  800 CONTINUE
      DO900ICOL=1,NUMCOL,IXDEL
      ILINE(ICOL)=ALPHAI
  900 CONTINUE
      WRITE(IPR,305)(ILINE(ICOL),ICOL=1,NUMCOL)
      DO1000I=1,NUMLAB
      AIM1=I-1
      XLABLE(I)=XMIN+(AIM1/ANUMLM)*DELX 
 1000 CONTINUE
      WRITE(IPR,910)(XLABLE(I),I=1,NUMLAB)
C
  205 FORMAT(1H ,  'THE FOLLOWING IS A PLOT OF Y(I) VERSUS X(I)')
  305 FORMAT(1H ,18X,54A1)
  310 FORMAT(1H ,15X,A1)
  710 FORMAT(1H ,E14.7,1X,A1,2X,50A1)
  910 FORMAT(1H ,9X,5E12.4)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE PLTXXT(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PLTXXT
C
C     PURPOSE--THIS SUBROUTINE YIELDS A NARROW-WIDTH (71-CHARACTER)
C              PLOT OF X(I) VERSUS X(I-1).  ITS NARROW WIDTH MAKES IT 
C              APPROPRIATE FOR USE ON A TERMINAL. 
C              THIS TYPE OF PLOT (WHICH IS CALLED AN
C              AUTOCORRELATION PLOT OR A LAG 1 PLOT)
C              IS USEFUL IN EXAMINING FOR
C              AUTOCORRELATION IN A SEQUENCE OF OBSERVATIONS.
C              UNCORRELATED DATA WILL PRODUCE AN AUTOCORRELATION
C              PLOT WITH NO APPARENT STRUCTURE; AUTOCORRELATED
C              DATA WILL PRODUCE AN AUTOCORRELATION PLOT WITH
C              LINEAR, ELLIPTICAL, OR OTHER KINDS OF STRUCTURE.
C     INPUT ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED) OBSERVATIONS
C                               TO BE GRAPHICALLY TESTED FOR
C                               AUTOCORRELATION.
C                    --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR X.
C     OUTPUT--A NARROW-WIDTH (71-CHARACTER) TERMINAL PLOT
C             OF X(I) VERSUS X(I-1).
C             THE BODY OF THE PLOT (NOT COUNTING AXIS VALUES
C             AND MARGINS) IS 25 ROWS (LINES) AND 49 COLUMNS.
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (X) WHICH ARE
C              EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE
C              PLOTTED.
C              THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM
C              OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR X
C              ARE 'MISSING DATA', OR WHEN WE PURPOSELY
C              WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR X
C              FOR PLOTTING PURPOSES (THAT IS, WE DO NOT
C              WANT CERTAIN ELEMENTS IN X TO BE PLOTTED).
C              TO CAUSE SPECIFIC ELEMENTS IN X TO BE
C              IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND
C              (BY, FOR EXAMPLE, USE OF THE   REPLAC   SUBROUTINE)
C              BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND
C              THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLTXXT
C              SUBROUTINE.
C            --NOTE THAT THE STORAGE REQUIREMENTS FOR THIS
C              (AND THE OTHER) TERMINAL PLOT SUBROUTINESS ARE .
C              VERY SMALL.
C              THIS IS DUE TO THE 'ONE LINE AT A TIME' ALGORITHM
C              EMPLOYED FOR THE PLOT.
C     REFERENCES--FILLIBEN, 'SOME USEFUL PROCEDURES FOR THE 
C                 STATISTICAL ANALYSIS OF DATA', UNPUBLISHED
C                 MANUSCRIPT (AVAILABLE FROM AUTHOR)
C                 PRESENTED AT THE FALL CONFERENCE
C                 OF THE CHEMICAL DIVISION OF THE AMERICAN
C                 SOCIETY FOR QUALITY CONTROL, KNOXVILLE,
C                 TENNESSEE, OCTOBER 19-20, 1972. 
C               --FILLIBEN, 'DATA EXPLORATION USING STAND-ALONE
C                 SUBROUTINES', UNPUBLISHED MANUSCRIPT
C                 (AVAILABLE FROM AUTHOR)
C                 PRESENTED AT THE 'STRATEGY FOR DATA ANALYSIS
C                 BY COMPUTERS' SESSION AT THE NATIONAL
C                 MEETING OF THE AMERICAN STATISTICAL ASSOCIATION,
C                 ST. LOUIS, MISSOURI, AUGUST 26-29, 1974.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--FEBRUARY  1974. 
C     UPDATED         --APRIL     1974. 
C     UPDATED         --OCTOBER   1974. 
C     UPDATED         --OCTOBER   1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1977. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 ILINE
      CHARACTER*4 IAXISC
      CHARACTER*4 SBNAM1,SBNAM2
      CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22
      CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX
C
      DIMENSION X(1)
      DIMENSION ILINE(72),X2LABL(10)
C
      DATA SBNAM1,SBNAM2/'PLTX','XT  '/ 
      DATA ALPH11,ALPH12/'FIRS','T   '/ 
      DATA ALPH21,ALPH22/'SECO','ND  '/ 
      DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/
C
      IPR=6
      CUTOFF=(10.0**10)-1000.0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO52
      GOTO54
   52 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,20)N
      WRITE(IPR,5)
      RETURN
   54 CONTINUE
      IF(N.EQ.1)GOTO56
      GOTO58
   56 WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2
      WRITE(IPR,22)N
      WRITE(IPR,5)
      RETURN
   58 CONTINUE
C
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO62
   60 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,30)HOLD
      WRITE(IPR,5)
      RETURN
   62 CONTINUE
C
      DO76I=1,N
      IF(X(I).LT.CUTOFF)GOTO78
   76 CONTINUE
      WRITE(IPR,5)
      WRITE(IPR,10) 
      WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2
      WRITE(IPR,32) 
      WRITE(IPR,33)CUTOFF
      WRITE(IPR,5)
      RETURN
   78 CONTINUE
C
    5 FORMAT(1H ,'**************************************************',
     1'********************') 
   10 FORMAT(1H ,'                   FATAL ERROR                    ')
   15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4,
     1' SUBROUTINE')
   20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,1H))
   22 FORMAT(1H ,'HAS THE VALUE 1')
   30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8)
   32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF')
   33 FORMAT(1H ,'VALUE OF ',E15.8)
C
C-----START POINT-----------------------------------------------------
C
C     DEFINE THE NUMBER OF ROWS AND COLUMNS WITHIN THE PLOT--
C     THIS HAS BEEN SET TO 25 ROWS AND 49 COLUMNS.
C
      NUMROW=25
      NUMCOL=49
      ANUMR=NUMROW
      ANUMRM=NUMROW-1
      ANUMCM=NUMCOL-1
      NUMR25=(NUMROW/4)+1
      NUMR50=(NUMROW/2)+1
      NUMR75=3*(NUMROW/4)+1
      IXDEL=(NUMCOL-1)/4
      NUMLAB=5
      ANUMLM=NUMLAB-1
C
C     WRITE OUT THE TOP HORIZONTAL AXIS OF THE PLOT, AND SKIP 1 LINE
C     FOR A MARGIN WITHIN THE PLOT.
C
      WRITE(IPR,999)
      WRITE(IPR,205)
      DO100ICOL=1,NUMCOL
      ILINE(ICOL)=HYPHEN
  100 CONTINUE
      DO200ICOL=1,NUMCOL,IXDEL
      ILINE(ICOL)=ALPHAI
  200 CONTINUE
      WRITE(IPR,305)(ILINE(I),I=1,NUMCOL)
      WRITE(IPR,310)BLANK
C
C     DETERMINE THE MIN AND MAX VALUES OF X.
C
      XMIN=X(1)
      XMAX=X(1)
      DO300I=1,N
      IF(X(I).GE.CUTOFF)GOTO300
      IF(X(I).LT.XMIN)XMIN=X(I)
      IF(X(I).GT.XMAX)XMAX=X(I)
  300 CONTINUE
      DELX=XMAX-XMIN
      XRWIDT=DELX/ANUMRM
      XCWIDT=DELX/ANUMCM
C
C     DETERMINE AND WRITE OUT THE PLOT POSITIONS ONE LINE AT A TIME.
C
      DO400IROW=1,NUMROW
      DO500ICOL=1,NUMCOL
      ILINE(ICOL)=BLANK
  500 CONTINUE
      AIROW=IROW
      XUPPER=XMAX+(1.5-AIROW)*XRWIDT
      XLABLE=XMAX+(1.0-AIROW)*XRWIDT
      XLOWER=XMAX+(0.5-AIROW)*XRWIDT
      IF(IROW.EQ.NUMROW)XLABLE=XMIN
      DO600I=2,N
      IM1=I-1
      IF(X(IM1).GE.CUTOFF)GOTO600
      IF(X(I).GE.CUTOFF)GOTO600
      IF(XLOWER.LE.X(I).AND.X(I).LT.XUPPER)GOTO650
      GOTO600
  650 ICOL=((X(IM1)-XMIN)/XCWIDT)+1.5
      ILINE(ICOL)=ALPHAX
  600 CONTINUE
      ICOLMX=1
      DO700ICOL=1,NUMCOL
      IF(ILINE(ICOL).EQ.ALPHAX)ICOLMX=ICOL
  700 CONTINUE
      IAXISC=ALPHAI 
      IF(IROW.EQ.1.OR.IROW.EQ.NUMROW)IAXISC=HYPHEN
      IF(IROW.EQ.NUMR25.OR.IROW.EQ.NUMR50.OR.IROW.EQ.NUMR75)
     1IAXISC=HYPHEN 
      WRITE(IPR,710)XLABLE,IAXISC,(ILINE(ICOL),ICOL=1,ICOLMX)
  400 CONTINUE
C
C     SKIP 1 LINE FOR A BOTTOM MARGIN WITHIN THE PLOT, WRITE OUT THE
C     BOTTOM HORIZONTAL AXIS, AND WRITE OUT THE X AXIS LABLES.
C
      WRITE(IPR,310)BLANK
      DO800ICOL=1,NUMCOL
      ILINE(ICOL)=HYPHEN
  800 CONTINUE
      DO900ICOL=1,NUMCOL,IXDEL
      ILINE(ICOL)=ALPHAI
  900 CONTINUE
      WRITE(IPR,305)(ILINE(ICOL),ICOL=1,NUMCOL)
      DO1000I=1,NUMLAB
      AIM1=I-1
      X2LABL(I)=XMIN+(AIM1/ANUMLM)*DELX 
 1000 CONTINUE
      WRITE(IPR,910)(X2LABL(I),I=1,NUMLAB)
C
  205 FORMAT(1H ,   'THE FOLLOWING IS A PLOT OF X(I) (VERTICALLY) VS. ,
     1 21HX(I-1) (HORIZONTALLY)')
  305 FORMAT(1H ,18X,54A1)
  310 FORMAT(1H ,15X,A1)
  710 FORMAT(1H ,E14.7,1X,A1,2X,50A1)
  910 FORMAT(1H ,9X,5E12.4)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE POICDF(X,ALAMBA,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT POICDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE AT THE SINGLE PRECISION VALUE X
C              FOR THE POISSON DISTRIBUTION
C              WITH SINGLE PRECISION
C              TAIL LENGTH PARAMETER = ALAMBA.
C              THE POISSON DISTRIBUTION USED
C              HEREIN HAS MEAN = ALAMBA 
C              AND STANDARD DEVIATION = SQRT(ALAMBA).
C              THIS DISTRIBUTION IS DEFINED FOR
C              ALL DISCRETE NON-NEGATIVE INTEGER  X--X = 0, 1, 2, ... .
C              THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION
C              F(X) = EXP(-ALAMBA) * ALAMBA**X / X!.
C              THE POISSON DISTRIBUTION IS THE
C              DISTRIBUTION OF THE NUMBER OF EVENTS
C              IN THE INTERVAL (0,ALAMBA) WHEN
C              THE WAITING TIME BETWEEN EVENTS
C              IS EXPONENTIALLY DISTRIBUTED
C              WITH MEAN = 1 AND STANDARD DEVIATION = 1.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE 
C                                AT WHICH THE CUMULATIVE DISTRIBUTION 
C                                FUNCTION IS TO BE EVALUATED.
C                                X SHOULD BE NON-NEGATIVE AND
C                                INTEGRAL-VALUED. 
C                     --ALAMBA = THE SINGLE PRECISION VALUE 
C                                OF THE TAIL LENGTH PARAMETER.
C                                ALAMBA 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
C             FOR THE POISSON DISTRIBUTION
C             WITH TAIL LENGTH PARAMETER = ALAMBA.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE AND INTEGRAL-VALUED.
C                 --ALAMBA SHOULD BE POSITIVE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NORCDF. 
C     FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DATAN.
C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--THE SINGLE PRECISION TAIL LENGTH
C              PARAMETER ALAMBA IS     NOT     RESTRICTED
C              TO ONLY INTEGER VALUES.
C              ALAMBA CAN BE SET TO ANY POSITIVE REAL
C              VALUE--INTEGER OR NON-INTEGER.
C            --NOTE THAT EVEN THOUGH THE INPUT
C              TO THIS CUMULATIVE
C              DISTRIBUTION FUNCTION SUBROUTINE
C              FOR THIS DISCRETE DISTRIBUTION
C              SHOULD (UNDER NORMAL CIRCUMSTANCES) BE A
C              DISCRETE INTEGER VALUE,
C              THE INPUT VARIABLE X IS SINGLE
C              PRECISION IN MODE.
C              X HAS BEEN SPECIFIED AS SINGLE
C              PRECISION SO AS TO CONFORM WITH THE DATAPAC
C              CONVENTION THAT ALL INPUT ****DATA****
C              (AS OPPOSED TO SAMPLE SIZE, FOR EXAMPLE)
C              VARIABLES TO ALL
C              DATAPAC SUBROUTINES ARE SINGLE PRECISION.
C              THIS CONVENTION IS BASED ON THE BELIEF THAT
C              1) A MIXTURE OF MODES (FLOATING POINT
C              VERSUS INTEGER) IS INCONSISTENT AND
C              AN UNNECESSARY COMPLICATION
C              IN A DATA ANALYSIS; AND
C              2) FLOATING POINT MACHINE ARITHMETIC
C              (AS OPPOSED TO INTEGER ARITHMETIC) 
C              IS THE MORE NATURAL MODE FOR DOING 
C              DATA ANALYSIS. 
C     REFERENCES--JOHNSON AND KOTZ, DISCRETE
C                 DISTRIBUTIONS, 1969, PAGES 87-121,
C                 ESPECIALLY PAGE 114, FORMULA 93.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGE 112.
C               --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 941, FORMULAE 26.4.4 AND 26.4.5,
C                 AND PAGE 929.
C               --FELLER, AN INTRODUCTION TO PROBABILITY
C                 THEORY AND ITS APPLICATIONS, VOLUME 1,
C                 EDITION 2, 1957, PAGES 146-154. 
C               --COX AND MILLER, THE THEORY OF STOCHASTIC
C                 PROCESSES, 1965, PAGE 7.
C               --GENERAL ELECTRIC COMPANY, TABLES OF THE
C                 INDIVIDUAL AND CUMULATIVE TERMS OF POISSON
C                 DISTRIBUTION, 1962.
C               --OWEN, HANDBOOK OF STATISTICAL
C                 TABLES, 1962, PAGES 259-261.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DX,PI,CHI,SUM,TERM,AI,DGCDF
      DOUBLE PRECISION DSQRT,DEXP
      DATA PI/3.14159265358979D0/
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(ALAMBA.LE.0.0)GOTO50 
      IF(X.LT.0.0)GOTO55
      INTX=X+0.0001 
      FINTX=INTX
      DEL=X-FINTX
      IF(DEL.LT.0.0)DEL=-DEL
      IF(DEL.GT.0.001)GOTO60
      GOTO90
   50 WRITE(IPR,15) 
      WRITE(IPR,46)ALAMBA
      CDF=0.0
      RETURN
   55 WRITE(IPR,4)
      WRITE(IPR,46)X
      CDF=0.0
      RETURN
   60 WRITE(IPR,5)
      WRITE(IPR,46)X
   90 CONTINUE
    4 FORMAT(1H , 96H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE POICDF SUBROUTINE IS NEGATIVE *****)
    5 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE POICDF SUBROUTINE IS NON-INTEGRAL *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 POICDF SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
C     EXPRESS THE POISSON CUMULATIVE DISTRIBUTION 
C     FUNCTION IN TERMS OF THE EQUIVALENT CHI-SQUARED
C     CUMULATIVE DISTRIBUTION FUNCTION, 
C     AND THEN EVALUATE THE LATTER.
C
      DX=ALAMBA
      DX=2.0D0*DX
      NU=X+0.0001
      NU=2*(1+NU)
C
  110 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
C
  160 SUM=SUM*DEXP(-DX/2.0D0) 
      IF(IEVODD.EQ.0)GOTO170
      SUM=(DSQRT(2.0D0/PI))*SUM
      SPCHI=CHI
      CALL NORCDF(SPCHI,GCDF) 
      DGCDF=GCDF
      SUM=SUM+2.0D0*(1.0D0-DGCDF)
  170 CDF=SUM
C
      RETURN
      END 
      SUBROUTINE POIPLT(X,N,ALAMBA)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT POIPLT
C
C     PURPOSE--THIS SUBROUTINE GENERATES A POISSON
C              PROBABILITY PLOT
C              (WITH SINGLE PRECISION
C              TAIL LENGTH PARAMETER = ALAMBA).
C              THE PROTOTYPE POISSON DISTRIBUTION USED
C              HEREIN HAS MEAN = ALAMBA 
C              AND STANDARD DEVIATION = SQRT(ALAMBA).
C              THIS DISTRIBUTION IS DEFINED FOR
C              ALL DISCRETE NON-NEGATIVE INTEGER  X--X = 0, 1, 2, ... .
C              THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION
C              F(X) = EXP(-ALAMBA) * ALAMBA**X / X!.
C              THE POISSON DISTRIBUTION IS THE
C              DISTRIBUTION OF THE NUMBER OF EVENTS
C              IN THE INTERVAL (0,ALAMBA) WHEN
C              THE WAITING TIME BETWEEN EVENTS
C              IS EXPONENTIALLY DISTRIBUTED
C              WITH MEAN = 1 AND STANDARD DEVIATION = 1.
C              THE PROTOTYPE DISTRIBUTION RESTRICTIONS OF
C              DISCRETENESS AND NON-NEGATIVENESS
C              MENTIONED ABOVE DO NOT CARRY OVER TO THE
C              INPUT VECTOR X OF OBSERVATIONS TO BE ANALYZED.
C              THE INPUT OBSERVATIONS IN X MAY BE DISCRETE, CONTINUOUS,
C              NON-NEGATIVE, OR NEGATIVE.
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 POISSON 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 POISSON DISTRIBUTION
C              WITH TAIL LENGTH PARAMETER VALUE = ALAMBA.
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                     --ALAMBA = THE SINGLE PRECISION VALUE OF THE
C                                TAIL LENGTH PARAMETER.
C                                ALAMBA SHOULD BE POSITIVE. 
C     OUTPUT--A ONE-PAGE POISSON PROBABILITY PLOT.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 5000.
C                 --ALAMBA SHOULD BE POSITIVE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, PLOT,
C                                         CHSCDF, NORPPF.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--FOR LARGE VALUES OF ALAMBA (IN EXCESS OF 500.)
C              THIS SUBROUTINE USES THE NORMAL APPROXIMATION TO
C              THE POISSON.  THIS IS DONE TO SAVE EXECUTION TIME
C              WHICH INCREASES AS A FUNCTION OF ALAMBA AND WOULD
C              BE EXCESSIVE FOR LARGE VALUES OF ALAMBA.
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, DISCRETE
C                 DISTRIBUTIONS, 1969, PAGES 87-121.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1974. 
C     UPDATED         --AUGUST    1975. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(5000),W(5000)
      DIMENSION Z(5000)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(W(1),WS(5001))
      EQUIVALENCE (Z(1),WS(10001))
C
      IPR=6
      IUPPER=5000
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      IF(ALAMBA.LE.0.0)GOTO60 
      HOLD=X(1)
      DO65I=2,N
      IF(X(I).NE.HOLD)GOTO90
   65 CONTINUE
      WRITE(IPR, 9)HOLD
      RETURN
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   60 WRITE(IPR,25) 
      WRITE(IPR,46)ALAMBA
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE POIPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 POIPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE POIPLT SUBROUTINE HAS THE VALUE 1 *****)
   25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 POIPLT SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
      CUTOFF=500.0
C
C     SORT THE DATA 
C
      CALL SORT(X,N,Y)
C
C     GENERATE UNIFORM ORDER STATISTIC MEDIANS
C
      CALL UNIMED(N,W)
C
C     COMPUTE POISSON ORDER STATISTIC MEDIANS.
C     IF THE INPUT ALAMBA VALUE IS LARGE (IN EXCESS OF
C     CUTOFF VALUE OF 500.0), THEN USE THE NORMAL APPROXIMATION
C     TO THE POISSON.
C
      IF(ALAMBA.LE.CUTOFF)GOTO150
      SQALAM=SQRT(ALAMBA)
      DO170I=1,N
      CALL NORPPF(W(I),W(I))
      W(I)=ALAMBA+W(I)*SQALAM 
  170 CONTINUE
      GOTO1550
  150 CONTINUE
C
C     DETERMINE WHICH UNIFORM ORDER STATISTIC MEDIAN IS ASSOCIATED WITH
C     THE CLOSEST INTEGER TO ALAMBA.
C
      DO100I=1,N
      Z(I)=-1.0
  100 CONTINUE
C
      ILAMBA=ALAMBA+0.5
      ARG1=2.0*ALAMBA
      IARG2=2*(ILAMBA+1)
      CALL CHSCDF(ARG1,IARG2,CDF)
      CDF=1.0-CDF
      DO200J=1,N
      IF(W(J).GT.CDF)GOTO250
  200 CONTINUE
  250 JM1=J-1
      Z(JM1)=ILAMBA 
C
C     FILL IN THE POISSON ORDER STATISTIC MEDIANS BELOW ALAMBA
C
      IMAX=6.0*SQRT(ALAMBA)
      DO500I=1,IMAX 
      K=ILAMBA-I
      IF(K.LT.0)GOTO750
      IARG2=2*(K+1) 
      CALL CHSCDF(ARG1,IARG2,CDF)
      CDF=1.0-CDF
      DO600J=1,N
      IF(W(J).GT.CDF)GOTO650
  600 CONTINUE
  650 JM1=J-1
      IF(JM1.LE.0)GOTO750
      IF(Z(JM1).LT.-0.5)Z(JM1)=K
  500 CONTINUE
C
C     FILL IN THE POISSON ORDER STATISTIC MEDIANS ABOVE ALAMBA
C
  750 DO800I=1,IMAX 
      K=ILAMBA+I
      IARG2=2*(K+1) 
      CALL CHSCDF(ARG1,IARG2,CDF)
      CDF=1.0-CDF
      DO900J=1,N
      IF(W(J).GT.CDF)GOTO950
  900 CONTINUE
      Z(N)=K
      GOTO1050
  950 JM1=J-1
      IF(Z(JM1).LT.-0.5)Z(JM1)=K
  800 CONTINUE
C
C     FILL IN THE EMPTY HOLES IN THE POISSON ORDER STATISTIC MEDIAN
C     Z MATRIX WITH THE PROPER VALUES.
C     THEN FOR SAKE OF CONSISTENCY WITH OTHER DATAPAC
C     PROBABILITY PLOT SUBROUTINES, COPY THE Z VECTOR
C     INTO THE W VECTOR.
C
 1050 HOLD=Z(N)
      DO1200IREV=1,N
      I=N-IREV+1
      IF(Z(I).GE.-0.5)HOLD=Z(I)
      IF(Z(I).LT.-0.5)Z(I)=HOLD
 1200 CONTINUE
      DO1300I=1,N
      W(I)=Z(I)
 1300 CONTINUE
C
C     PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS.
C     WRITE OUT THE SAMPLE SIZE.
C
 1550 CALL PLOT(Y,W,N)
      WRITE(IPR,2105)ALAMBA,N 
C
C     COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. 
C     COMPUTE LOCATION AND SCALE ESTIMATES
C     FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. 
C     THEN WRITE THEM OUT.
C
      SUM1=0.0
      SUM2=0.0
      DO2200I=1,N
      SUM1=SUM1+Y(I)
      SUM2=SUM2+W(I)
 2200 CONTINUE
      YBAR=SUM1/AN
      WBAR=SUM2/AN
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO2300I=1,N
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) 
      SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) 
      SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 
 2300 CONTINUE
      CC=SUM2/SQRT(SUM3*SUM1) 
      YSLOPE=SUM2/SUM3
      YINT=YBAR-YSLOPE*WBAR
      WRITE(IPR,2305)CC,YINT,YSLOPE
C
 2105 FORMAT(1H ,42HPOISSON PROBABILITY PLOT WITH PARAMETER = ,9X,
     1E17.10,1X,8X,11X,20HTHE SAMPLE SIZE N = ,I7)
 2305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X,
     122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) 
C
      RETURN
      END 
      SUBROUTINE POIPPF(P,ALAMBA,PPF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT POIPPF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE AT THE SINGLE PRECISION VALUE P
C              FOR THE POISSON DISTRIBUTION
C              WITH SINGLE PRECISION
C              TAIL LENGTH PARAMETER = ALAMBA.
C              THE POISSON DISTRIBUTION USED
C              HEREIN HAS MEAN = ALAMBA 
C              AND STANDARD DEVIATION = SQRT(ALAMBA).
C              THIS DISTRIBUTION IS DEFINED FOR
C              ALL DISCRETE NON-NEGATIVE INTEGER  X--X = 0, 1, 2, ... .
C              THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION
C              F(X) = EXP(-ALAMBA) * ALAMBA**X / X!.
C              THE POISSON DISTRIBUTION IS THE
C              DISTRIBUTION OF THE NUMBER OF EVENTS
C              IN THE INTERVAL (0,ALAMBA) WHEN
C              THE WAITING TIME BETWEEN EVENTS
C              IS EXPONENTIALLY DISTRIBUTED
C              WITH MEAN = 1 AND STANDARD DEVIATION = 1.
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                     --ALAMBA = THE SINGLE PRECISION VALUE 
C                                OF THE TAIL LENGTH PARAMETER.
C                                ALAMBA SHOULD BE POSITIVE. 
C     OUTPUT ARGUMENTS--PPF    = THE SINGLE PRECISION PERCENT
C                                POINT FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION PERCENT POINT  .
C             FUNCTION VALUE PPF
C             FOR THE POISSON DISTRIBUTION
C             WITH TAIL LENGTH PARAMETER = ALAMBA.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--ALAMBA SHOULD BE POSITIVE.
C                 --P SHOULD BE BETWEEN 0.0 (INCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C     OTHER DATAPAC   SUBROUTINES NEEDED--NORPPF, POICDF.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, DEXP.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION AND DOUBLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--THE SINGLE PRECISION TAIL LENGTH
C              PARAMETER ALAMBA IS     NOT     RESTRICTED
C              TO ONLY INTEGER VALUES.
C              ALAMBA CAN BE SET TO ANY POSITIVE REAL
C              VALUE--INTEGER OR NON-INTEGER.
C            --NOTE THAT EVEN THOUGH THE OUTPUT
C              FROM THIS DISCRETE DISTRIBUTION
C              PERCENT POINT FUNCTION
C              SUBROUTINE MUST NECESSARILY BE A
C              DISCRETE INTEGER VALUE,
C              THE OUTPUT VARIABLE PPF IS SINGLE
C              PRECISION IN MODE.
C              PPF HAS BEEN SPECIFIED AS SINGLE
C              PRECISION SO AS TO CONFORM WITH THE DATAPAC
C              CONVENTION THAT ALL OUTPUT VARIABLES FROM ALL
C              DATAPAC SUBROUTINES ARE SINGLE PRECISION.
C              THIS CONVENTION IS BASED ON THE BELIEF THAT
C              1) A MIXTURE OF MODES (FLOATING POINT
C              VERSUS INTEGER) IS INCONSISTENT AND
C              AN UNNECESSARY COMPLICATION
C              IN A DATA ANALYSIS; AND
C              2) FLOATING POINT MACHINE ARITHMETIC
C              (AS OPPOSED TO INTEGER ARITHMETIC) 
C              IS THE MORE NATURAL MODE FOR DOING 
C              DATA ANALYSIS. 
C     REFERENCES--JOHNSON AND KOTZ, DISCRETE
C                 DISTRIBUTIONS, 1969, PAGES 87-121,
C                 ESPECIALLY PAGE 102, FORMULA 36.1.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGES 108-113.
C               --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 929.
C               --FELLER, AN INTRODUCTION TO PROBABILITY
C                 THEORY AND ITS APPLICATIONS, VOLUME 1,
C                 EDITION 2, 1957, PAGES 146-154. 
C               --COX AND MILLER, THE THEORY OF STOCHASTIC
C                 PROCESSES, 1965, PAGE 7.
C               --GENERAL ELECTRIC COMPANY, TABLES OF THE
C                 INDIVIDUAL AND CUMULATIVE TERMS OF POISSON
C                 DISTRIBUTION, 1962.
C               --OWEN, HANDBOOK OF STATISTICAL
C                 TABLES, 1962, PAGES 259-261.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DLAMBA 
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LT.0.0.OR.P.GE.1.0)GOTO50
      IF(ALAMBA.LE.0.0)GOTO55 
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      PPF=0.0
      RETURN
   55 WRITE(IPR,15) 
      WRITE(IPR,46)ALAMBA
      PPF=0.0
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 POIPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 POIPPF SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      DLAMBA=ALAMBA 
      PPF=0.0
      IX0=0
      IX1=0
      IX2=0
      P0=0.0
      P1=0.0
      P2=0.0
C
C     TREAT CERTAIN SPECIAL CASES IMMEDIATELY--
C     1) P = 0.0
C     2) PPF = 0
C
      IF(P.EQ.0.0)GOTO110
      PF0=DEXP(-DLAMBA)
      IF(P.LE.PF0)GOTO110
      GOTO190
  110 PPF=0.0
      RETURN
  190 CONTINUE
C
C     DETERMINE AN INITIAL APPROXIMATION TO THE POISSON
C     PERCENT POINT BY USE OF THE NORMAL APPROXIMATION
C     TO THE POISSON.
C     (SEE JOHNSON AND KOTZ, DISCRETE DISTRIBUTIONS,
C     PAGE 102, FORMULA 36.1).
C
      AMEAN=ALAMBA
      SD=SQRT(ALAMBA)
      CALL NORPPF(P,ZPPF)
      X2=AMEAN-1.0+ZPPF*SD
      IX2=X2
C
C     CHECK AND MODIFY (IF NECESSARY) THIS INITIAL
C     ESTIMATE OF THE PERCENT POINT
C     TO ASSURE THAT IT BE NON-NEGATIVE.
C
      IF(IX2.LT.0)IX2=0
C
C     DETERMINE UPPER AND LOWER BOUNDS ON THE DESIRED
C     PERCENT POINT BY ITERATING OUT (BOTH BELOW AND ABOVE) 
C     FROM THE ORIGINAL APPROXIMATION AT STEPS
C     OF 1 STANDARD DEVIATION.
C     THE RESULTING BOUNDS WILL BE AT MOST
C     1 STANDARD DEVIATION APART.
C
      IX0=0
      IX1=10**10
      ISD=SD+1.0
      X2=IX2
      CALL POICDF(X2,ALAMBA,P2)
C
      IF(P2.LT.P)GOTO210
      GOTO250
C
  210 IX0=IX2
      DO220I=1,100000
      IX2=IX0+ISD
      IF(IX2.GE.IX1)GOTO275
      X2=IX2
      CALL POICDF(X2,ALAMBA,P2)
      IF(P2.GE.P)GOTO230
      IX0=IX2
  220 CONTINUE
      WRITE(IPR,249)
      WRITE(IPR,222)
      GOTO950
  230 IX1=IX2
      GOTO275
C
  250 IX1=IX2
      DO260I=1,100000
      IX2=IX1-ISD
      IF(IX2.LE.IX0)GOTO275
      X2=IX2
      CALL POICDF(X2,ALAMBA,P2)
      IF(P2.LT.P)GOTO270
      IX1=IX2
  260 CONTINUE
      WRITE(IPR,249)
      WRITE(IPR,262)
      GOTO950
  270 IX0=IX2
C
  275 IF(IX0.EQ.IX1)GOTO280
      GOTO295
  280 IF(IX0.EQ.0)GOTO285
CCCCC IF(IX0.EQ.N)GOTO290
      WRITE(IPR,249)
      WRITE(IPR,282)
      GOTO950
  285 IX1=IX1+1
      GOTO295
  290 IX0=IX0-1
  295 CONTINUE
C
C     COMPUTE POISSON PROBABILITIES FOR THE
C     DERIVED LOWER AND UPPER BOUNDS.
C
      X0=IX0
      X1=IX1
      CALL POICDF(X0,ALAMBA,P0)
      CALL POICDF(X1,ALAMBA,P1)
C
C     CHECK THE PROBABILITIES FOR PROPER ORDERING 
C
      IF(P0.LT.P.AND.P.LE.P1)GOTO490
      IF(P0.EQ.P)GOTO410
      IF(P1.EQ.P)GOTO420
      IF(P0.GT.P1)GOTO430
      IF(P0.GT.P)GOTO440
      IF(P1.LT.P)GOTO450
      WRITE(IPR,249)
      WRITE(IPR,401)
      GOTO950
  410 PPF=IX0
      RETURN
  420 PPF=IX1
      RETURN
  430 WRITE(IPR,249)
      WRITE(IPR,431)
      GOTO950
  440 WRITE(IPR,249)
      WRITE(IPR,441)
      GOTO950
  450 WRITE(IPR,249)
      WRITE(IPR,451)
      GOTO950
  490 CONTINUE
C
C     THE STOPPING CRITERION IS THAT THE LOWER BOUND
C     AND UPPER BOUND ARE EXACTLY 1 UNIT APART.
C     CHECK TO SEE IF IX1 = IX0 + 1;
C     IF SO, THE ITERATIONS ARE COMPLETE;
C     IF NOT, THEN BISECT, COMPUTE PROBABILIIES,
C     CHECK PROBABILITIES, AND CONTINUE ITERATING 
C     UNTIL IX1 = IX0 + 1.
C
  300 IX0P1=IX0+1
      IF(IX1.EQ.IX0P1)GOTO690 
      IX2=(IX0+IX1)/2
      IF(IX2.EQ.IX0)GOTO610
      IF(IX2.EQ.IX1)GOTO620
      X2=IX2
      CALL POICDF(X2,ALAMBA,P2)
      IF(P0.LT.P2.AND.P2.LT.P1)GOTO630
      IF(P2.LE.P0)GOTO640
      IF(P2.GE.P1)GOTO650
  610 WRITE(IPR,249)
      WRITE(IPR,611)
      GOTO950
  620 WRITE(IPR,249)
      WRITE(IPR,611)
      GOTO950
  630 IF(P2.LE.P)GOTO635
      IX1=IX2
      P1=P2
      GOTO300
  635 IX0=IX2
      P0=P2
      GOTO300
  640 WRITE(IPR,249)
      WRITE(IPR,641)
      GOTO950
  650 WRITE(IPR,249)
      WRITE(IPR,651)
      GOTO950
  690 PPF=IX1
      IF(P0.EQ.P)PPF=IX0
      RETURN
C
  950 WRITE(IPR,240)IX0,P0
      WRITE(IPR,241)IX1,P1
      WRITE(IPR,242)IX2,P2
      WRITE(IPR,244)P
      WRITE(IPR,245)ALAMBA
      RETURN
C
  222 FORMAT(1H ,43HNO UPPER BOUND FOUND AFTER 10**7 ITERATIONS)
  240 FORMAT(1H ,9HIX0    = ,I8,10X,5HP0 = ,F14.7)
  241 FORMAT(1H ,9HIX1    = ,I8,10X,5HP1 = ,F14.7)
  242 FORMAT(1H ,9HIX2    = ,I8,10X,5HP2 = ,F14.7)
  244 FORMAT(1H ,9HP      = ,F14.7)
  245 FORMAT(1H ,9HALAMBA = ,F14.7)
  249 FORMAT(1H ,47H***** INTERNAL ERROR IN POIPPF SUBROUTINE *****)
  262 FORMAT(1H ,43HNO LOWER BOUND FOUND AFTER 10**7 ITERATIONS)
  282 FORMAT(1H ,31HLOWER AND UPPER BOUND IDENTICAL)
  401 FORMAT(1H ,39HIMPOSSIBLE BRANCH CONDITION ENCOUNTERED)
  431 FORMAT(1H ,42HLOWER BOUND PROBABILITY (P0) GREATER THAN ,
     1 28HUPPER BOUND PROBABILITY (P1)) 
  441 FORMAT(1H ,42HLOWER BOUND PROBABILITY (P0) GREATER THAN ,
     1 21HINPUT PROBABILITY (P))
  451 FORMAT(1H ,42HUPPER BOUND PROBABILITY (P1) LESS    THAN ,
     1 21HINPUT PROBABILITY (P))
  611 FORMAT(1H ,39HBISECTION VALUE (X2) = LOWER BOUND (X0))
  621 FORMAT(1H ,39HBISECTION VALUE (X2) = UPPER BOUND (X1))
  641 FORMAT(1H ,33HBISECTION VALUE PROBABILITY (P2) ,
     1 38HLESS THAN LOWER BOUND PROBABILITY (P0)) 
  651 FORMAT(1H ,33HBISECTION VALUE PROBABILITY (P2) ,
     1 41HGREATER THAN UPPER BOUND PROBABILITY (P1))
C
      END 
      SUBROUTINE POIRAN(N,ALAMBA,ISEED,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT POIRAN
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE POISSON DISTRIBUTION
C              WITH SINGLE PRECISION
C              TAIL LENGTH PARAMETER = ALAMBA.
C              THE POISSON DISTRIBUTION USED
C              HEREIN HAS MEAN = ALAMBA
C              AND STANDARD DEVIATION = SQRT(ALAMBA).
C              THIS DISTRIBUTION IS DEFINED FOR
C              ALL DISCRETE NON-NEGATIVE INTEGER  X--X = 0, 1, 2, ... .
C              THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION
C              F(X) = EXP(-ALAMBA) * ALAMBA**X / X!.
C              THE POISSON DISTRIBUTION IS THE
C              DISTRIBUTION OF THE NUMBER OF EVENTS
C              IN THE INTERVAL (0,ALAMBA) WHEN
C              THE WAITING TIME BETWEEN EVENTS
C              IS EXPONENTIALLY DISTRIBUTED
C              WITH MEAN = 1 AND STANDARD DEVIATION = 1.
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
C                                OF RANDOM NUMBERS TO BE
C                                GENERATED.
C                     --ALAMBA = THE SINGLE PRECISION VALUE
C                                OF THE TAIL LENGTH PARAMETER.
C                                ALAMBA SHOULD BE POSITIVE.
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 POISSON DISTRIBUTION
C             WITH TAIL LENGTH PARAMETER = ALAMBA.
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                 --ALAMBA SHOULD BE POSITIVE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     COMMENT--THE SINGLE PRECISION TAIL LENGTH
C              PARAMETER ALAMBA IS     NOT     RESTRICTED
C              TO ONLY INTEGER VALUES.
C              ALAMBA CAN BE SET TO ANY POSITIVE REAL
C              VALUE--INTEGER OR NON-INTEGER.
C     COMMENT--NOTE THAT EVEN THOUGH THE OUTPUT
C              FROM THIS DISCRETE RANDOM NUMBER
C              GENERATOR MUST NECESSARILY BE A
C              SEQUENCE OF ***INTEGER*** VALUES,
C              THE OUTPUT VECTOR X IS SINGLE
C              PRECISION IN MODE.
C              X HAS BEEN SPECIFIED AS SINGLE
C              PRECISION SO AS TO CONFORM WITH THE DATAPAC
C              CONVENTION THAT ALL OUTPUT VECTORS FROM ALL
C              DATAPAC SUBROUTINES ARE SINGLE PRECISION.
C              THIS CONVENTION IS BASED ON THE BELIEF THAT
C              1) A MIXTURE OF MODES (FLOATING POINT
C              VERSUS INTEGER) IS INCONSISTENT AND
C              AN UNNECESSARY COMPLICATION
C              IN A DATA ANALYSIS; AND
C              2) FLOATING POINT MACHINE ARITHMETIC
C              (AS OPPOSED TO INTEGER ARITHMETIC)
C              IS THE MORE NATURAL MODE FOR DOING
C              DATA ANALYSIS.
C     REFERENCES--COX AND MILLER, THE THEORY OF STOCHASTIC
C                 PROCESSES, 1965, PAGE 7.
C               --TOCHER, THE ART OF SIMULATION,
C                 1963, PAGES 36-37.
C               --JOHNSON AND KOTZ, DISCRETE
C                 DISTRIBUTIONS, 1969, PAGES 87-121.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGES 108-113.
C               --FELLER, AN INTRODUCTION TO PROBABILITY
C                 THEORY AND ITS APPLICATIONS, VOLUME 1,
C                 EDITION 2, 1957, PAGES 146-154.
C               --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
C                 SERIES 55, 1964, PAGE 929.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82.6
C     ORIGINAL VERSION--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
CCCCC CHARACTER*4 IFEEDB
CCCCC CHARACTER*4 IPRINT
C
CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
CCCCC COMMON /PRINT/IFEEDB,IPRINT
C
      IPR=6
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(ALAMBA.LE.0.0)GOTO55
      GOTO90
   50 WRITE(IPR, 5)
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,15)
      WRITE(IPR,46)ALAMBA
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 POIRAN SUBROUTINE IS NON-POSITIVE *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 POIRAN SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C     GENERATE N POISSON RANDOM NUMBERS
C     USING THE FACT THAT THE DISTRIBUTION
C     OF EXPONENTIAL WAITING TIMES IS POISSON.
C
      DO100I=1,N
      SUM=0.0
      J=1
  150 CALL UNIRAN(1,ISEED,U)
      E=-ALOG(1.0-U)
      SUM=SUM+E
      IF(SUM.GT.ALAMBA)GOTO250
      J=J+1
      GOTO150
  250 X(I)=J-1
  100 CONTINUE
C
      RETURN
      END
      SUBROUTINE POLY(Y,X,W,N,IDEG,IWRITE,B,SDB,S,DF,PRED,RES)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT POLY
      EXTERNAL DOT
C
C     PURPOSE--THIS SUBROUTINE COMPUTES A LEAST SQUARES
C              POLYNOMIAL FIT (OF DEGREE = IDEG) OF THE
C              RESPONSE VARIABLE DATA IN THE SINGLE PRECISION
C              VECTOR Y AS A FUNCTION OF THE INDEPENDENT
C              VARIABLE DATA IN THE SINGLE PRECISION
C              VECTOR X.
C     INPUT  ARGUMENTS--Y      = SINGLE PRECISION VECTOR OF 
C                                RESPONSE DATA (THAT IS, THE
C                                DEPENDENT VARIABLE).
C                     --X      = SINGLE PRECISION VECTOR OF 
C                                THE INDEPENDENT VARIABLE.
C                     --W      = THE SINGLE PRECISION VECTOR
C                                OF WEIGHTS FOR THE RESPONSE
C                                VARIABLE.
C                     --N      = THE INTEGER VALUE OF THE SAMPLE SIZE.
C                     --IDEG   = THE INTEGER VALUE OF THE DESIRED
C                                DEGREE OF THE POLYNOMIAL
C                                TO BE FIT.
C                     --IWRITE = THE INTEGER VALUE WHICH IF ZERO WILL 
C                                RESULT IN NO PRINTED OUTPUT, AND IF
C                                NON-ZERO (E.G., 1) WILL RESULT IN
C                                SOME LIMITED PRINTED OUTPUT
C                                (COEFFICIENTS, STANDARD DEVIATIONS OF
C                                COEFFICIENTS, RESIDUAL STANDARD DEVIATION).
C     OUTPUT ARGUMENTS--B      = THE SINGLE PRECISION VECTOR OF
C                                ESTIMATED REGRESSION COEFFICIENTS.
C                     --SDB    = THE SINGLE PRECISION VECTOR OF
C                                ESTIMATED STANDARD DEVIATIONS OF THE 
C                                ESTIMATED REGRESSION COEFFICIENTS.
C                     --S      = THE ESTIMATED RESIDUAL STANDARD
C                                DEVIATION.
C                     --DF     = THE DEGREES OF FREEDOM
C                                ASSOCIATED WITH THE RESIDUAL
C                                STANDARD DEVIATION =
C                                NUMBER OF OBSERVATIONS MINUS
C                                NUMBER OF PARAMETERS =
C                                N - (IDEG + 1).
C                     --PRED   = THE SINGLE PRECISION VECTOR OF
C                                PREDICTED VALUES FROM THE
C                                LEAST SQUARES FIT.
C                     --RES    = THE SINGLE PRECISION VECTOR OF
C                                RESIDUALS FROM THE LEAST SQUARES FIT.
C     SUBROUTINES NEEDED--DECOMP, INVXWX, DOT, FCDF.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--MARCH     1974
C     UPDATED--OCTOBER   1974 
C     UPDATED--MARCH     1975 
C     UPDATED--MAY       1975 
C     UPDATED--JULY      1975 
C     UPDATED--SEPTEMBER 1975 
C     UPDATED--NOVEMBER  1975.
C     UPDATED--FEBRUARY  1976.
C     UPDATED--JUNE      1976.
C     UPDATED--OCTOBER   1976.
C     UPDATED--MAY       1977.
C     UPDATED--JUNE      1977.
C
C---------------------------------------------------------------------
C
      DIMENSION Y(1),X(1),W(1),B(1),SDB(1),PRED(1),RES(1)
      DIMENSION B2(50)
      DIMENSION F(3000),WRES(3000),G(50),H(50)
      DIMENSION Q(10000),R(2500),D(50),IPIVOT(50) 
      COMMON /BLOCK2/ WS(15000)
      COMMON /BLOCK3/ DUM1(3000),DUM2(3000)
      EQUIVALENCE (Q(1),WS(1))
      EQUIVALENCE (R(1),WS(10001))
      EQUIVALENCE (D(1),WS(12501))
      EQUIVALENCE (IPIVOT(1),WS(12551)) 
C
      IPR=6
      AN=N
      K=IDEG+1
      AK=K
      NK=N*K
      KK=K*K
      NMAX=3000
      KMAX=50
      NKMAX=10000
C
C-----START POINT-----------------------------------------------------
C
C     WRITE OUT THE TITLE
C
      IF(IWRITE.EQ.0)GOTO150
      WRITE(IPR,999)
      WRITE(IPR,999)
      WRITE(IPR,101)
      WRITE(IPR,102)N
      WRITE(IPR,103)IDEG
C
C     PRE-SET THE OUTPUT VARIABLES AND VECTORS
C     TO A LARGE VALUE
C     IN CASE A PREMATURE EXIT OCCURS DUE TO NUMERICAL INSTABILITY.
C
  150 VALUE=(10.0**10)+1000.0 
      S=VALUE
      IF(K.LE.0)GOTO155
      DO160I=1,K
      B(I)=VALUE
      SDB(I)=VALUE
  160 CONTINUE
  155 IF(N.LE.0)GOTO175
      DO170I=1,N
      RES(I)=VALUE
  170 CONTINUE
C
C     CHECK THE INPUT ARGUMENTS N AND K 
C
  175 IF(N.LE.0.OR.N.GT.NMAX)WRITE(IPR,105)N,NMAX 
      IF(N.LE.0.OR.N.GT.NMAX)RETURN
      IF(K.LE.0.OR.K.GT.KMAX)WRITE(IPR,110)K,KMAX 
      IF(K.LE.0.OR.K.GT.KMAX)RETURN
      IF(K.GT.N)WRITE(IPR,115)K,N
      IF(K.GT.N)RETURN
C
C     INSPECT THE WEIGHT VECTOR W--IF ALL ELEMENTS ARE IDENTICAL,
C     THEN RESET ALL ELEMENTS TO 1.0.  THIS AVOIDS THE
C     PROBLEM OF AN UNDEFINED EMPTY WEIGHT VECTOR W WHEN
C     IN FACT AN EQUAL WEIGHTING SCHEME IS DESIRED.
C
      IWFLAG=0
      WHOLD=W(1)
      DO600I=1,N
      IF(W(I).EQ.WHOLD)GOTO600
      GOTO850
  600 CONTINUE
      IWFLAG=1
  850 IF(IWFLAG.EQ.0.AND.IWRITE.NE.0)WRITE(IPR,851)
      IF(IWFLAG.EQ.1.AND.IWRITE.NE.0)WRITE(IPR,852)
C
C     COMPUTE THE ORIGINAL FORM FOR THE Q MATRIX
C     WHICH WILL BE IDENTICAL TO THE DATA MATRIX X
C     OF INDEPENDENT VARIABLES IF THE WEIGHTS
C     SPECIFIED ARE ALL EQUAL.  NOTE THAT THE
C     DATA MATRIX X IS NEVER COMPUTED AS SUCH.
C     NOTE THAT THE DATA MATRIX X IS NOT TO BE
C     CONFUSED WITH THE SINGLE INDEPENDENT
C     VARIABLE VECTOR X.
C     THE Q MATRIX WILL BE CHANGED IN THE DECOMP SUBROUTINE.
C
      DO100J=1,K
      IF(J.EQ.1)GOTO250
      IF(J.EQ.2)GOTO350
      JM1=J-1
      DO200I=1,N
      IQARG1=(I-1)*K+J
      IQARG2=(I-1)*K+JM1
      Q(IQARG1)=Q(IQARG2)*X(I)
  200 CONTINUE
      GOTO100
  250 DO300I=1,N
      IQARG=(I-1)*K+1
      Q(IQARG)=1.0
  300 CONTINUE
      GOTO100
  350 DO400I=1,N
      IQARG=(I-1)*K+2
      Q(IQARG)=X(I) 
  400 CONTINUE
  100 CONTINUE
      IF(IWFLAG.EQ.1)GOTO1440 
      DO1300I=1,N
      DO1400J=1,K
      IQARG=(I-1)*K+J
      Q(IQARG)=Q(IQARG)*SQRT(W(I))
 1400 CONTINUE
 1300 CONTINUE
C
C     COMPUTE ETA AND TOL (FOR THE UNIVAC 1108, ETA = 2**-27)
C     WHICH WILL BE USED IN THE DECOMP SUBROUTINE 
C
 1440 ETA=1.0
 1450 ETA=0.5*ETA
      ETAP1=ETA+1.0 
      IF(ETAP1.GT.1.0)GOTO1450
      TOL=ETA*AK
      NM5=N-5
      NKM5=NK-5
CCCCC WRITE(IPR,1505)(Y(I),I=1,6)
CCCCC WRITE(IPR,1505)(Y(I),I=NM5,N)
CCCCC WRITE(IPR,1505)(X(I),I=1,6)
CCCCC WRITE(IPR,1505)(X(I),I=NM5,N)
CCCCC WRITE(IPR,1505)(W(I),I=1,6)
CCCCC WRITE(IPR,1505)(W(I),I=NM5,N)
CCCCC WRITE(IPR,1505)(Q(IQARG),IQARG=1,6)
CCCCC WRITE(IPR,1505)(Q(IQARG),IQARG=NKM5,NK)
CCCCC WRITE(IPR,1505)(Q(IQARG),IQARG=1,NK)
C
      CALL DECOMP(N,K,ETA,TOL,IRANK,INSING)
C
CCCCC WRITE(IPR,1505)(Q(IQARG),IQARG=1,NK)
CCCCC WRITE(IPR,1505)(R(IRARG),IRARG=1,KK)
CCCCC WRITE(IPR,1505)(D(J),J=1,K)
      IF(INSING.EQ.1)GOTO1550 
      WRITE(IPR,1510)IRANK,K
      RETURN
 1550 KP1=K+1
C
C     *************************************************************** 
C
C     THE PURPOSE OF THIS NEXT SEGMENT (BETWEEN THE STARRED LINES)
C     IS TO SOLVE FOR THE DESIRED REGRESSION COEFFICIENTS.
C     ITERATIVE REFINEMENT IS USED.
C     A SECOND OUTPUT FROM THIS SEGMENT IS THE RESIDUALS FROM THE
C     FINAL FIT.
C     A THIRD OUTPUT FROM THIS SEGMENT IS AN INDICATION (IN THE
C     VARIABLE ICONV) AS TO WHETHER THE ITERATIVE REFINEMENT
C     CONVERGED OR NOT.
C     X--USED IN THIS SEGMENT 
C     Q--USED IN THIS SEGMENT 
C     R--USED IN THIS SEGMENT 
C     D--USED IN THIS SEGMENT 
C     IPIVOT--USED IN THIS SEGMENT
C
C
      ETA2=ETA*ETA
      B2(KP1)=-1.0
      DO 50010 I=1,N
      F(I)=Y(I)
      WRES(I)=0.0
      RES(I)=0.0
50010 CONTINUE
      DO 50020 J=1,K
      B2(J)=0.0
      G(J)=0.0
      H(J)=0.0
50020 CONTINUE
      M=0 
      AMDB2=0.0
      AMDR2=0.0
C
C     BEGIN THE M-TH ITERATION STEP IN THE ITERATIVE REFINEMENT
C
50030 IF (M.LT.2) GO TO 50040 
      IF (((64.*AMDB2.LT.AMDB1).AND.(AMDB2.GT.ETA2*AMB)).OR.((64.*AMDR2.
     1LT.AMDR1).AND.(AMDR2.GT.ETA2*AMR))) GO TO 50040
      GO TO 50250
50040 AMDB1=AMDB2
      AMDR1=AMDR2
      AMDB2=0.0
      AMDR2=0.0
      IF (M.EQ.0) GO TO 50100 
C
C     BEGIN FORMING NEW RESIDUALS
C
      IF(IWFLAG.EQ.0)GOTO50044
      DO50045I=1,N
      WRES(I)=WRES(I)+F(I)
      RES(I)=RES(I)+F(I)
50045 CONTINUE
      GOTO50055
50044 DO 50050 I=1,N
      WRES(I)=WRES(I)+F(I)*SQRT(W(I))
      RES(I)=RES(I)+F(I)/SQRT(W(I))
50050 CONTINUE
50055 DO 50070 IS=1,IRANK
      J=IPIVOT(IS)
      B2(J)=B2(J)+G(IS)
      DO 50060 L=1,N
      IF(J.GE.2)GOTO50065
      DUM1(L)=1.0
      GOTO50060
50065 DUM1(L)=X(L)**(J-1)
50060 CONTINUE
C
      CALL DOT(DUM1,WRES,1,N,0.0,G(IS)) 
50070 G(IS)=-G(IS)
C
      DO 50090 I=1,N
      E=RES(I)
      DO 50080 L=1,K
      IF(L.GE.2)GOTO50085
      DUM1(L)=1.0
      GOTO50080
50085 DUM1(L)=X(I)**(L-1)
50080 CONTINUE
      DUM1(KP1)=Y(I)
C
      CALL DOT(DUM1,B2,1,KP1,E,F(I))
      IF(IWFLAG.EQ.0)F(I)=-F(I)*SQRT(W(I))
      IF(IWFLAG.EQ.1)F(I)=-F(I)
50090 CONTINUE
C
C     END FORMING NEW RESIDUALS
C
50100 DO 50150 IS=1,IRANK
      J=IPIVOT(IS)
      IF (IS.NE.1) GO TO 50110
50110 ISM1=IS-1
      DO 50120 L=1,ISM1
      IRARG=(L-1)*K+IS
50120 DUM1(L)=R(IRARG)
      ANEGGI=-G(IS) 
C
      CALL DOT(DUM1,H,1,ISM1,ANEGGI,H(IS))
      H(IS)=-H(IS)
C
      E=-H(IS)
      DO 50130 L=1,N
      IQARG=(L-1)*K+J
50130 DUM1(L)=Q(IQARG)
C
      CALL DOT(DUM1,F,1,N,E,E)
      E=E/D(IS)
C
      G(IS)=E
      DO 50140 I=1,N
      IQARG=(I-1)*K+J
50140 F(I)=F(I)-E*Q(IQARG)
50150 CONTINUE
C
      DO 50210 IS=1,IRANK
      JS=IRANK+1-IS 
      JSP1=JS+1
      DO 50200 L=JSP1,IRANK
      IRARG=(JS-1)*K+L
50200 DUM1(L)=R(IRARG)
      ANEGGJ=-G(JS) 
C
      CALL DOT(DUM1,G,JSP1,IRANK,ANEGGJ,G(JS))
50210 G(JS)=-G(JS)
C
      DO 50220 IS=1,IRANK
50220 AMDB2=AMDB2+G(IS)*G(IS) 
      DO 50230 I=1,N
50230 AMDR2=AMDR2+F(I)*F(I)
      IF (M.NE.0) GO TO 50240 
      AMB=AMDB2
      AMR=AMDR2
50240 CONTINUE
CCCCC WRITE(IPR,50505)M
CCCCC WRITE(IPR,50506)(B2(I),I=1,K)
CCCCC DO5555I=1,N
CCCCC WRITE(IPR,50506)Y(I),X(I),RES(I),WRES(I),F(I),G(I),H(I)
C5555 CONTINUE
50505 FORMAT(I8)
50506 FORMAT(1H ,8F10.5)
C
C     END THE M-TH ITERATION STEP IN THE ITERATIVE REFINEMENT
C
      M=M+1
      GO TO 50030
50250 IF ((AMDR2.GT.4.*ETA2*AMR).AND.(AMDB2.GT.4.*ETA2*AMB)) GO TO 50260
      ICONV=1
      GO TO 1700
50260 ICONV=0
C
C     *************************************************************** 
C
 1700 IF(ICONV.EQ.1)GOTO1750
      WRITE(IPR,1520)
      RETURN
C
C     ADJUST THE R MATRIX
C     WHICH WILL BE USED IN THE INVERT (INVRR) SUBROUTINE.
C
1750  DO1800J=1,K
      IRARG=(J-1)*K+J
      R(IRARG)=SQRT(D(J))
      IF(J.EQ.K)GOTO1800
      JP1=J+1
      DO1900L=JP1,K 
      IRARG1=(J-1)*K+L
      IRARG2=(J-1)*K+J
      R(IRARG1)=R(IRARG1)*R(IRARG2)
 1900 CONTINUE
 1800 CONTINUE
CCCCC WRITE(IPR,1505)(R(IRARG),IRARG=1,KK)
C
      CALL INVXWX(N,K)
C
CCCCC WRITE(IPR,1505)(R(IRARG),IRARG=1,KK)
C
C     COMPUTE STATISTICAL CALCULATIONS AND THEN WRITE OUT COEFFICIENTS
C     AND STANDARD DEVIATIONS OF COEFFICIENTS ALONG WITH THE
C     RESIDUAL STANDARD DEVIATION.
C
      DO3040I=1,K
      B(I)=B2(I)
 3040 CONTINUE
      DO3070I=1,N
      IF(RES(I).EQ.0.0)GOTO3070
      GOTO3050
 3070 CONTINUE
      WRITE(IPR,3080)
 3080 FORMAT(' ',10X,'NOTE THAT AN EXACT FIT HAS BEEN OBTAINED')
 3050 SUM=0.0
      IF(IWFLAG.EQ.0)GOTO3060 
      DO3055I=1,N
      SUM=SUM+RES(I)*RES(I)
 3055 CONTINUE
      RESSS=SUM
      GOTO3105
 3060 DO3100I=1,N
      SUM=SUM+RES(I)*RES(I)*W(I)
 3100 CONTINUE
 3105 IF(K.EQ.N.AND.IWRITE.NE.0)WRITE(IPR,3110)K
      IF(K.EQ.N)GOTO3250
 3110 FORMAT(1H ,10X,72HNOTE THAT THE NUMBER OF COEFFICIENTS K
     1  = THE SAMPLE SIZE N = ,I8)
      RESDF=AN-AK
      DF=RESDF
      IRESDF=AN-AK+0.5
      RESMS=RESSS/RESDF
      S=SQRT(RESMS) 
 3250 CONTINUE
CCCCC WRITE(IPR,3205)
      DO3300I=1,N
      PRED(I)=Y(I)-RES(I)
CCCCC WRITE(IPR,3305)Y(I),PRED(I),RES(I)
 3300 CONTINUE
      IF(K.EQ.N)GOTO3450
      GOTO3480
 3450 IF(IWRITE.NE.0)WRITE(IPR,3455)
 3455 FORMAT(1H ,21H        J        B(J))
      DO3460I=1,K
      IF(IWRITE.NE.0)WRITE(IPR,3405)J,B(J)
 3460 CONTINUE
      RETURN
 3480 IF(IWRITE.NE.0)WRITE(IPR,3310)S
      IF(IWRITE.NE.0)WRITE(IPR,3311)IRESDF
      IF(IWRITE.NE.0)WRITE(IPR,3312)
      IF(IWRITE.NE.0)WRITE(IPR,3315)
      DO3400J=1,K
      IRARG=(J-1)*K+J
      SDB(J)=S*SQRT(R(IRARG)) 
      T=B(J)/SDB(J) 
      IF(IWRITE.NE.0)WRITE(IPR,3405)J,B(J),SDB(J),T
 3400 CONTINUE
C
C     COMPUTE THE COVARIANCE AND CORRELATION MATRIX OF THE COEFFICIENTS
C
      DO3500I=1,K
      DO3600J=1,K
      IRARG=(I-1)*K+J
      R(IRARG)=R(IRARG)*S*S
 3600 CONTINUE
 3500 CONTINUE
      DO2200I=1,K
      DO2300J=1,K
      IF(I.EQ.J)GOTO2300
      IRARG1=(I-1)*K+J
      IRARG2=(I-1)*K+I
      IRARG3=(J-1)*K+J
      R(IRARG1)=R(IRARG1)/SQRT(R(IRARG2)*R(IRARG3))
 2300 CONTINUE
 2200 CONTINUE
      DO2400J=1,K
      IRARG=(J-1)*K+J
      R(IRARG)=1.0
 2400 CONTINUE
CCCCC WRITE(IPR,2405)
      DO2500I=1,K
      IRAMIN=(I-1)*K+1
      IRAMAX=I*K
CCCCC WRITE(IPR,2505)(R(IRARG),IRARG=IRAMIN,IRAMAX)
 2500 CONTINUE
C
C     CHECK FOR REPLICATION.
C     IF SO, COMPUTE A POOLED STANDARD DEVIATION. 
C     THEN COMPUTE A LACK OF FIT F TEST.
C
C     DETERMINE THE NUMBER OF DISTINCT SUBSETS
C
      NUMSET=0
      DO4200I=1,N
      IF(NUMSET.EQ.0)GOTO4350 
      DO4300J=1,NUMSET
      IF(X(I).EQ.DUM1(J))GOTO4200
 4300 CONTINUE
 4350 NUMSET=NUMSET+1
      DUM1(NUMSET)=X(I)
 4200 CONTINUE
      IF(NUMSET.EQ.0)WRITE(IPR,4205)
      IF(NUMSET.EQ.0)RETURN
C
C     COPY OUT EACH SUBSET INTO THE DUM2 VECTOR
C     AND ANALYZE IT THEREIN
C
      IREPDF=0
      REPSS=0.0
      DO4600ISET=1,NUMSET
      NI=0
      DO4700I=1,N
      IF(X(I).EQ.DUM1(ISET))NI=NI+1
      IF(X(I).EQ.DUM1(ISET))DUM2(NI)=Y(I)
 4700 CONTINUE
      ANI=NI
      SUM=0.0
      DO5100I=1,NI
      SUM=SUM+DUM2(I)
 5100 CONTINUE
      YMEAN=SUM/ANI 
      SUM=0.0
      DO5200I=1,NI
      SUM=SUM+(DUM2(I)-YMEAN)**2
 5200 CONTINUE
      IREPDF=IREPDF+NI-1
      REPSS=REPSS+SUM
 4600 CONTINUE
      IF(IREPDF.LE.0)RETURN
      REPDF=IREPDF
      REPV=REPSS/REPDF
      REPSD=SQRT(REPV)
      IF(IWRITE.NE.0)WRITE(IPR,999)
      IF(IWRITE.NE.0)WRITE(IPR,4930)REPSD
      IF(IWRITE.NE.0)WRITE(IPR,4935)IREPDF
      IF(IWRITE.NE.0)WRITE(IPR,4933)NUMSET
      IFITDF=IRESDF-IREPDF
      IF(IFITDF.GE.1)GOTO5250 
      IF(IWRITE.NE.0)WRITE(IPR,4936)
      IF(IWRITE.NE.0)WRITE(IPR,4937)
      IF(IWRITE.NE.0)WRITE(IPR,4938)
      IF(IWRITE.NE.0)WRITE(IPR,4939)
      RETURN
 5250 FITDF=IFITDF
      FITSS=RESSS-REPSS
      FITMS=FITSS/FITDF
      FSTAT=FITMS/RESMS
      CALL FCDF(FSTAT,IFITDF,IREPDF,CDF)
      CDF2=100.0*CDF
      IF(IWRITE.NE.0)WRITE(IPR,4940)FSTAT,CDF2
      IF(IWRITE.NE.0)WRITE(IPR,4945)IFITDF,IREPDF 
C
  999 FORMAT(1H )
 1505 FORMAT(1H ,6E15.8)
 1510 FORMAT(1H ,51H*****ERROR--THE MATRIX IS SINGULAR--IT HAS IRANK = ,
     1I8,51H WHICH IS LESS THAN THE NUMBER OF COEFFICIENTS K = ,I8,6H **
     1***)
 1520 FORMAT(1H ,51H*****ERROR--THE ITERATIONS ARE NOT CONVERGING *****)
 1605 FORMAT(1H ,I8,5X,E15.8) 
 2005 FORMAT(1H ,8E15.8)
 2405 FORMAT(1H ,34HCORRELATION MATRIX OF COEFFICIENTS)
 2505 FORMAT(1H ,8E15.8)
 3205 FORMAT(1H ,44H      OBSERVED      PREDICTED      RESIDUALS)
 3305 FORMAT(1H ,8E15.8)
 3310 FORMAT(1H ,10X,30HRESIDUAL STANDARD DEVIATION = ,E15.8)
 3311 FORMAT(1H ,10X,30HRESIDUAL DEGREES OF FREEDOM = ,I8)
 3312 FORMAT(1H ,10X,13HCOEFFICIENTS:)
 3315 FORMAT(1H ,58H          J        B(J)      SD(B(J))        B(J)/SD
     1(B(J)))
 3405 FORMAT(1H ,3X,I8,8E15.8)
  101 FORMAT(1H ,28HLEAST SQUARES POLYNOMIAL FIT) 
  102 FORMAT(1H ,10X,16HSAMPLE SIZE N = ,I8)
  103 FORMAT(1H ,10X,9HDEGREE = ,I8)
  105 FORMAT(1H ,33H*****ERROR--THE SAMPLE SIZE N (= ,I8,40H) IS NON-POS
     1ITIVE OR LARGER THAN NMAX = ,I8,6H *****)
  110 FORMAT(1H ,52H*****ERROR--THE DESIRED NUMBER OF COEFFICIENTS K (=
     1,I8,40H) IS NON-POSITIVE OR LARGER THAN KMAX = ,I8,6H *****)
  115 FORMAT(1H ,52H*****ERROR--THE DESIRED NUMBER OF COEFFICIENTS K (=
     1,I8,38H) IS LARGER THAN THE SAMPLE SIZE N (= ,I8,7H) *****)
  851 FORMAT(1H ,10X,20HUNEQUAL WEIGHTS CASE)
  852 FORMAT(1H ,10X,18HEQUAL WEIGHTS CASE)
 4205 FORMAT(1H ,38HERROR IN POLY   SUBROUTINE--NUMSET = 0) 
 4930 FORMAT(1H ,44H          REPLICATION STANDARD DEVIATION  = ,D15.7)
 4935 FORMAT(1H ,44H          REPLICATION DEGREES OF FREEDOM  = ,I8)
 4933 FORMAT(1H ,44H          NUMBER OF DISTINCT SUBSETS      = ,I8)
 4936 FORMAT(1H ,51H          LACK OF FIT F TEST CANNOT BE DONE BECAUSE)
 4937 FORMAT(1H ,44H          HAVE ONLY 0 DEGREES OF FREEDOM IN ,        ,
     121HNUMERATOR OF F RATIO.)
 4938 FORMAT(1H ,49H          THIS HAPPENS WHEN NUMBER OF PARAMETERS ,
     16HFITTED )
 4939 FORMAT(1H ,45H          IS IDENTICAL TO NUMBER OF DISTINCT ,
     18HSUBSETS.)
 4940 FORMAT(1H ,32H          LACK OF FIT F RATIO = ,F10.4,7H = THE , 
     1F8.4,14H% POINT OF THE) 
 4945 FORMAT(1H ,30H          F DISTRIBUTION WITH ,I6,5H AND ,I6,
     119H DEGREES OF FREEDOM) 
C
      RETURN
      END 
      SUBROUTINE PROPOR(X,N,XMIN,XMAX,IWRITE,XPROP)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT PROPOR
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              THE SAMPLE PROPORTION WHICH IS THE 
C              PROPORTION OF DATA BETWEEN XMIN AND XMAX (INCLUSIVELY) 
C              IN THE INPUT VECTOR X.
C              THE SAMPLE PROPORTION = (THE NUMBER OF OBSERVATIONS
C              IN THE SAMPLE BETWEEN XMIN AND XMAX, INCLUSIVELY) / N. 
C              THE SAMPLE PROPORTION WILL BE A SINGLE PRECISION
C              VALUE BETWEEN 0.0 AND 1.0 (INCLUSIVELY).
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                     --XMIN   = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES THE LOWER LIMIT
C                                (INCLUSIVELY) OF THE REGION
C                                OF INTEREST.
C                     --XMAX   = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES THE UPPER LIMIT
C                                (INCLUSIVELY) OF THE REGION
C                                OF INTEREST.
C                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SAMPLE PROPORTION
C                                AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SAMPLE PROPORTION
C                                AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--XPROP  = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE PROPORTION.
C                                THIS WILL BE A VALUE BETWEEN
C                                0.0 AND 1.0 (INCLUSIVELY). 
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE PROPORTION.
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--SNEDECOR AND COCHRAN, STATISTICAL METHODS,
C                 EDITION 6, 1967, PAGES 207-213. 
C               --DIXON AND MASSEY, INTRODUCTION TO STATISTICAL
C                 ANALYSIS, EDITION 2, 1957, PAGES 81-82, 228-231.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1974. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      IF(XMIN.EQ.XMAX)GOTO80
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      XPROP=0.0
      RETURN
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XPROP=0.0
      RETURN
   80 WRITE(IPR,26) 
      WRITE(IPR,49)XMIN
      XPROP=0.0
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE PROPOR SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 PROPOR SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE PROPOR SUBROUTINE HAS THE VALUE 1 *****)
   26 FORMAT(1H ,46H***** FATAL ERROR--THE THIRD AND FOURTH INPUT ,
     1 48HARGUMENTS TO THE PROPOR SUBROUTINE ARE IDENTICAL) 
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
   49 FORMAT(1H , 37H***** THE VALUE OF THE ARGUMENTS ARE ,E15.7   ,6H *
     1****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
      XPROP=0.0
      ISUM=0
      DO100I=1,N
      IF(X(I).LT.XMIN.OR.XMAX.LT.X(I))GOTO100
      ISUM=ISUM+1
  100 CONTINUE
      SUM=ISUM
      XPROP=SUM/AN
C
  101 IF(IWRITE.EQ.0)RETURN
      WRITE(IPR,999)
      WRITE(IPR,105)N,XMIN,XMAX,XPROP
  105 FORMAT(1H ,22HTHE PROPORTION OF THE ,I6,30H OBSERVATIONS IN THE IN
     1TERVAL ,E15.7,4H TO ,E15.7,4H IS ,E15.7)
  999 FORMAT(1H )
      RETURN
      END 
      SUBROUTINE RANGE(X,N,IWRITE,XRANGE)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT RANGE
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SAMPLE RANGE
C              OF THE DATA IN THE INPUT VECTOR X. 
C              THE SAMPLE RANGE = SAMPLE MAX - SAMPLE MIN.
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                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SAMPLE RANGE
C                                AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SAMPLE RANGE
C                                AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--XRANGE = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE RANGE.
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE RANGE.
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 1, EDITION 2, 1963, PAGE 338.
C               --DAVID, ORDER STATISTICS, 1970, PAGE 10-11.
C               --SNEDECOR AND COCHRAN, STATISTICAL METHODS,
C                 EDITION 6, 1967, PAGE 39.
C               --DIXON AND MASSEY, INTRODUCTION TO STATISTICAL
C                 ANALYSIS, EDITION 2, 1957, PAGE 21.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --JUNE      1974. 
C     UPDATED         --APRIL     1975. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
      IF(N.LT.1)GOTO50
C
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      XRANGE=0.0
      GOTO101
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XRAMGE=0.0
      GOTO101
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE RANGE  SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 RANGE  SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE RANGE  SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      XMIN=X(1)
      XMAX=X(1)
      DO100I=1,N
      IF(X(I).LT.XMIN)XMIN=X(I)
      IF(X(I).GT.XMAX)XMAX=X(I)
  100 CONTINUE
      XRANGE=XMAX-XMIN
C
  101 IF(IWRITE.EQ.0)RETURN
      WRITE(IPR,999)
      WRITE(IPR,105)N,XRANGE
  105 FORMAT(1H ,24HTHE SAMPLE RANGE OF THE ,I6,17H OBSERVATIONS IS ,E15
     1.8) 
  999 FORMAT(1H )
      RETURN
      END 
      SUBROUTINE RANK(X,N,XR) 
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT RANK
C
C     PURPOSE--THIS SUBROUTINE RANKS (IN ASCENDING ORDER)
C              THE N ELEMENTS OF THE SINGLE PRECISION VECTOR X,
C              AND PUTS THE RESULTING N RANKS INTO THE
C              SINGLE PRECISION VECTOR XR.
C              THIS SUBROUTINE GIVES THE DATA ANALYST
C              THE ABILITY TO (FOR EXAMPLE) RANK THE DATA
C              PRELIMINARY TO CERTAIN DISTRIBUTION-FREE
C              ANALYSES.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                                OBSERVATIONS TO BE RANKED. 
C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR X. 
C     OUTPUT ARGUMENTS--XR     = THE SINGLE PRECISION VECTOR
C                                INTO WHICH THE RANKS
C                                FROM X WILL BE PLACED.
C     OUTPUT--THE SINGLE PRECISION VECTOR XR
C             CONTAINING THE RANKS
C             (IN ASCENDING ORDER)
C             OF THE VALUES
C             IN THE SINGLE PRECISION VECTOR X.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--THE RANK OF THE FIRST ELEMENT
C              OF THE VECTOR X
C              WILL BE PLACED IN THE FIRST POSITION
C              OF THE VECTOR XR,
C              THE RANK OF THE SECOND ELEMENT
C              OF THE VECTOR X
C              WILL BE PLACED IN THE SECOND POSITION
C              OF THE VECTOR XR,
C              ETC. 
C     COMMENT--THE SMALLEST ELEMENT IN THE VECTOR X
C              WILL HAVE A RANK OF 1 (UNLESS TIES EXIST).
C              THE LARGEST ELEMENT IN THE VECTOR X
C              WILL HAVE A RANK OF N (UNLESS TIES EXIST).
C     COMMENT--ALTHOUGH RANKS ARE USUALLY (UNLESS TIES EXIST)
C              INTEGRAL VALUES FROM 1 TO N, IT IS TO BE
C              NOTED THAT THEY ARE OUTPUTED AS SINGLE
C              PRECISION INTEGERS IN THE SINGLE PRECISION
C              VECTOR XR.
C              XR IS SINGLE PRECISION SO AS TO BE 
C              CONSISTENT WITH THE FACT THAT ALL
C              VECTOR ARGUMENTS IN ALL OTHER
C              DATAPAC SUBROUTINES ARE SINGLE PRECISION;
C              BUT MORE IMPORTANTLY, BECAUSE TIES FREQUENTLY
C              DO EXIST IN DATA SETS AND SO SOME OF THE
C              RESULTING RANKS WILL BE NON-INTEGRAL
C              AND SO THE OUTPUT VECTOR OF RANKS MUST NECESSARILY
C              BE SINGLE PRECISION AND NOT INTEGER.
C     COMMENT--THE INPUT VECTOR X REMAINS UNALTERED.
C     COMMENT--DUE TO CONFLICTING USE OF LABELED
C              COMMON /BLOCK2/ BY THIS RANK
C              SUBROUTINE AND THE SPCORR (SPEARMAN RANK
C              CORRELATION COEFFICIENT) SUBROUTINE,
C              THE VECTOR XS OF THIS RANK
C              SUBROUTINE HAS BEEN PLACED IN
C              LABELED COMMON /BLOCK4/
C     COMMENT--THE FIRST AND THIRD ARGUMENTS IN THE
C              CALLING SEQUENCE MAY
C              BE IDENTICAL; THAT IS, AN 'IN PLACE'
C              RANKING IS PERMITTED.
C              THE CALLING SEQUENCE
C              CALL RANK(X,N,X) IS VALID, IF DESIRED.
C     COMMENT--THE SORTING ALGORTHM USED HEREIN
C              IS THE BINARY SORT.
C              THIS ALGORTHIM IS EXTREMELY FAST AS THE
C              FOLLOWING TIME TRIALS INDICATE.
C              THESE TIME TRIALS WERE CARRIED OUT ON THE
C              UNIVAC 1108 EXEC 8 SYSTEM AT NBS
C              IN AUGUST OF 1974.
C              BY WAY OF COMPARISON, THE TIME TRIAL VALUES
C              FOR THE EASY-TO-PROGRAM BUT EXTREMELY
C              INEFFICIENT BUBBLE SORT ALGORITHM HAVE
C              ALSO BEEN INCLUDED--
C              NUMBER OF RANDOM        BINARY SORT       BUBBLE SORT
C               NUMBERS SORTED
C                N = 10                 .002 SEC          .002 SEC
C                N = 100                .011 SEC          .045 SEC
C                N = 1000               .141 SEC         4.332 SEC
C                N = 3000               .476 SEC        37.683 SEC
C                N = 10000             1.887 SEC      NOT COMPUTED
C     REFERENCES--CACM MARCH 1969, PAGE 186 (BINARY SORT ALGORITHM
C                 BY RICHARD C. SINGLETON).
C               --CACM JANUARY 1970, PAGE 54.
C               --CACM OCTOBER 1970, PAGE 624.
C               --JACM JANUARY 1961, PAGE 41.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --JANUARY   1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --JANUARY   1977. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1),XR(1)
      COMMON /BLOCK4/ XS(7500)
C
      AN=N
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      AVRANK=(AN+1.0)/2.0
      DO61I=1,N
      XR(I)=AVRANK
   61 CONTINUE
      RETURN
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XR(1)=1.0
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE RANK   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 RANK   SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE RANK   SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
C     FIRST SORT THE DATA FROM THE INPUT VECTOR X 
C     INTO THE INTERMEDIATE STORAGE VECTOR XS.
C
      CALL SORT(X,N,XS)
C
C     NOW DETERMINE THE RANKS.
C     THE BASIC ALGORITHM IS TO TAKE A GIVEN ELEMENT
C     IN THE ORIGINAL INPUT VECTOR X,
C     AND SCAN THE SORTED VALUES IN THE XS VECTOR 
C     UNTIL A MATCH IS FOUND; 
C     WHEN A MATCH IS FOUND, THEN THE RANK FOR THAT
C     VALUE IN THE XS VECTOR IS DETERMINED.
C     THAT RANK IS THEN WRITTEN INTO THAT POSITION
C     IN THE OUTPUT Y VECTOR WHICH CORRESPONDS TO THE POSITION OF THE 
C     GIVEN ELEMENT OF INTEREST IN THE ORIGINAL X VECTOR.
C     THE CODE IS LENGTHENED FROM THIS BASIC ALGORITHM
C     BY A SECTION WHICH CUTS DOWN THE SEARCH IN THE XS VECTOR,
C     AND BY A SECTION WHICH OBVIATES (UNDER CERTAIN CIRCUMSTANCES)
C     THE NEED FOR RECALCULATING THE RANK OF AN ELEMENT IN XS.
C
      NM1=N-1
      XPREV=X(1)
      DO700I=1,N
      JMIN=1
      IF(X(I).GT.XPREV)GOTO770
      IF(I.EQ.1)GOTO790
      IF(X(I).EQ.XPREV)GOTO750
      GOTO790
  750 CONTINUE
      XR(I)=RPREV
      GOTO880
  770 CONTINUE
      JMIN=K
      IF(JMIN.LT.N)GOTO790
      IF(JMIN.EQ.N)GOTO820
      IBRAN=1
      WRITE(IPR,109)IBRAN
      WRITE(IPR,101)JMIN
  109 FORMAT(1H ,40H*****INTERNAL ERROR IN RANK SUBROUTINE--,
     146HIMPOSSIBLE BRANCH CONDITION AT BRANCH POINT = ,I8) 
  101 FORMAT(1H ,'JMIN = ',I8)
      STOP
  790 CONTINUE
      DO800J=JMIN,NM1
      IF(X(I).NE.XS(J))GOTO800
      JP1=J+1
      DO900K=JP1,N
      IF(XS(K).NE.XS(J))GOTO950
  900 CONTINUE
      K=N+1
  950 CONTINUE
      AVRANK=J+K-1
      AVRANK=AVRANK/2.0
      XR(I)=AVRANK
      GOTO880
  800 CONTINUE
  820 CONTINUE
      J=N 
      K=N+1
      IF(X(I).EQ.XS(J))GOTO850
      IBRAN=2
      WRITE(IPR,109)IBRAN
      WRITE(IPR,102)X(I),XS(J)
  102 FORMAT(1H ,'X(I) = ',F15.7,'   XS(J) = ',F15.7)
      STOP
  850 CONTINUE
      XR(I)=N
  880 CONTINUE
      XPREV=X(I)
      RPREV=XR(I)
  700 CONTINUE
C
      RETURN
      END 
      SUBROUTINE RANPER(N,ISTART,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT RANPER
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM PERMUTATION OF SIZE N
C              OF THE VALUES 1.0, 2.0, 3.0, ..., N-1, N.
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER SIZE
C                                OF THE RANDOM 1 TO N PERMUTATION.
C                     --ISTART = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL START THE
C                                GENERATOR OVER AND HENCE
C                                PRODUCE THE SAME RANDOM PERMUTATION
C                                OVER AND OVER AGAIN
C                                UPON SUCCESSIVE CALLS TO
C                                THIS SUBROUTINE WITHIN A RUN; OR
C                                (IF SET TO SOME INTEGER
C                                VALUE NOT EQUAL TO 0,
C                                LIKE, SAY, 1) WILL ALLOW
C                                THE GENERATOR TO CONTINUE
C                                FROM WHERE IT STOPPED
C                                AND HENCE PRODUCE DIFFERENT
C                                RANDOM PERMUTATIONS UPON
C                                SUCCESSIVE CALLS TO
C                                THIS SUBROUTINE WITHIN A RUN.
C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
C                                (OF DIMENSION AT LEAST N)
C                                INTO WHICH THE GENERATED
C                                RANDOM PERMUTATION WILL BE PLACED.
C     OUTPUT--A RANDOM PERMUTATION OF SIZE N
C             OF THE VALUES 1.0, 2.0, 3.0, ..., N-1, N.
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--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--ALGORITHM SUGGESTED BY DAN LOZIER, 
C              NATIONAL BUREAU OF STANDARDS (205.01).
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --MAY       1974. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION U(1)
C
      AN=N
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      GOTO90
   50 WRITE(IPR, 5) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR, 8) 
      X(1)=1
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 RANPER SUBROUTINE IS NON-POSITIVE *****)
    8 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE RANPER SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      CALL UNIRAN(1,ISTART,U) 
C
      DO100I=1,N
      X(I)=I
  100 CONTINUE
C
      DO200I=1,N
      CALL UNIRAN(1,1,U)
      ADD=AN*U(1)+1.0
      IADD=ADD
      IF(IADD.LT.1)IADD=1
      IF(IADD.GT.N)IADD=N
      J=I+IADD
      IF(J.GT.N)J=J-N
      HOLD=X(J)
      X(J)=X(I)
      X(I)=HOLD
  200 CONTINUE
      RETURN
      END 
      SUBROUTINE READ(ICOL1,ICOL2,X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT READ
C
C     PURPOSE--THIS SUBROUTINE PERFORMS A FORMAT-FREE READ
C              OF DATA FROM PUNCHED CARDS.
C              ONLY THE CARD COLUMNS BETWEEN ICOL1 AND ICOL2
C              (INCLUSIVELY) ARE SCANNED FOR THE READ.
C              THIS SUBROUTINE GIVES THE DATA ANALYST THE ABILITY
C              TO GET DATA INTO THE MACHINE WITHOUT HAVING
C              TO WORRY ABOUT AND SPECIFY FORMATS.
C              THE DATA CARDS MAY BE PUNCHED UP
C              WITHOUT REGARD TO ANY PARTICULAR FORMAT
C              AND MAY BE ENTERED INTO THE MACHINE
C              WITHOUT DEFINING ANY FORMATS.
C     INPUT  ARGUMENTS--ICOL1  = THE INTEGER CARD COLUMN NUMBER
C                                WHICH DEFINES THE LOWER BOUND
C                                (INCLUSIVELY) OF THE INTERVAL
C                                ON EACH CARD TO BE SCANNED 
C                                FOR THE READ.
C                     --ICOL2  = THE INTEGER CARD COLUMN NUMBER
C                                WHICH DEFINES THE UPPER BOUND
C                                (INCLUSIVELY) OF THE INTERVAL
C                                ON EACH CARD TO BE SCANNED 
C                                FOR THE READ.
C     OUTPUT ARGUMENTS--X      = THE SINGLE PRECISION VECTOR
C                                INTO WHICH THE READ DATA VALUES
C                                WILL BE SEQUENTIALLY PLACED.
C                     --N      = THE INTEGER VALUE
C                                WHICH WILL EQUAL THE NUMBER OF DATA
C                                VALUES WHICH WERE READ.
C     OUTPUT--THE SINGLE PRECISION VECTOR X WHICH 
C             WILL CONTAIN THE READ
C             DATA VALUES, AND
C             THE INTEGER VALUE N WHICH WILL
C             EQUAL THE NUMBER OF DATA VALUES
C             READ INTO X.
C             ALSO, 7 LINES OF SUMMARY INFORMATION
C             WILL BE GENERATED--
C             REGARDING WHAT WAS IN FACT READ INTO THE MACHINE--
C             1) THE VALUES OF ICOL1 AND ICOL2;
C             2) THE (ENTIRE) FIRST DATA CARD READ;
C             3) THE (ENTIRE) LAST DATA CARD READ;
C             4) THE TOTAL NUMBER OF DATA CARDS READ;
C             5) THE TOTAL NUMBER OF DATA VALUES READ.
C     PRINTING--YES.
C     RESTRICTIONS--ICOL1 AND ICOL2 MUST BE BETWEEN 1 AND 80,
C                   INCLUSIVELY.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--ADJACENT DATA VALUES ON THE SAME CARD
C              MUST BE SEPARATED BY AT LEAST 1 BLANK
C              OR 1 ALPHABETIC CHARACTER, OR BY  ANY
C              COMBINATION OF BLANKS AND ALPHABETIC
C              CHARACTERS.  IN THIS CONTEXT, AN
C              ALPHABETIC CHARACTER IS ANY CHARACTER
C              OTHER THAN 0, 1, 2, ..., 9, +, -, OR ..
C              IN EFFECT, THEREFORE, ALL ALPHABETIC INFORMATION
C              IN THE INTERVAL DEFINED BY ICOL1 AND ICOL2
C              (INCLUSIVELY) IS IGNORED FOR READING PURPOSES.
C              ALL INFORMATION (BOTH NUMERIC AND ALPHABETIC)
C              OUTSIDE THE DEFINED INTERVAL IS ALSO IGNORED 
C              FOR READING PURPOSES.
C     COMMENT--THE DATA VALUES ON THE CARDS ARE FREE-FORMAT.
C              THEY MAY BE EITHER INTEGER OR FLOATING POINT 
C              (THAT IS, WITHOUT OR WITH THE DECIMAL POINTS).
C              EXPONENTIAL FLOATING POINT FORMAT (E FORMAT) 
C              IS NOT PERMITTED.
C              ALL DATA, WHETHER WITHOUT OR WITH THE DECIMAL POINT
C              ON THE CARDS, WILL BE READ INTO THE MACHINE
C              INTO THE X VECTOR AND WILL RESIDE THERE AS FLOATING
C              POINT NUMBERS. 
C     COMMENT--ANY PARTICULAR DATA VALUE MUST START AND END 
C              ON THE SAME DATA CARD; DATA VALUES MAY NOT
C              START ON ONE CARD AND FINISH ON THE NEXT.
C              VARIOUS ILLEGAL COMBINATIONS (SUCH AS
C              MULTIPLE DECIMAL POINTS, MULTIPLE PLUSSES OR 
C              MINUSES, INCOMPLETE VALUES CONSISTING ONLY
C              OF A DECIMAL POINT, OR ONLY OF A SIGN AND A DECIMAL
C              POINT, ETC. ARE NOT ACCEPTED AND THE
C              DATA ANALYST WILL BE INFORMED OF THE EXISTENCE OF
C              SUCH BY AN ERROR DIAGNOSTIC.
C              IN THE EVENT OF SUCH AN ILLEGAL COMBINATION, 
C              THAT 'NUMBER' AND ALL REMAINING NUMBERS ON THAT CARD WILL
C              WILL BE IGNORED (NOT READ INTO THE MACHINE)
C              AND THE NEXT DATA CARD WILL THEN
C              BE READ.
C     COMMENT--THIS SUBROUTINE WILL CONTINUOUSLY AND
C              SEQUENTIALLY READ CARDS UNTIL A CARD WITH
C              THE WORD         END       (SOMEWHERE BETWEEN
C              COLUMNS ICOL1 AND ICOL2 (INCLUSIVELY)
C              IS ENCOUNTERED.
C              TO TERMINATE A DATA SET, THE ANALYST SHOULD
C              APPEND SUCH A CARD WHICH HAS THE WORD
C              END        SOMEWHERE IN THE INTERVAL
C              DEFINED BY ICOL1 AND ICOL2.
C              FOR EXAMPLE, IF ICOL1 = 1 AND ICOL2 = 20,
C              THEN A SEPARATE CARD WITH     END
C              IN COLUMNS 1, 2, AND 3, OR
C              IN COLUMNS 10, 11, AND 12, ETC.
C              WOULD TERMINATE THE READ.
C              IT IS IMPORTANT TO APPEND SUCH A CARD--
C              FAILURE TO DO SO WILL RESULT IN AN INCOMPLETE
C              DATA SET OR (ON SOME COMPUTERS) AN 
C              UNPREDICTABLE RUN TERMINATION.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--DECEMBER  1972. 
C     UPDATED         --AUGUST    1974. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --OCTOBER   1976. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 PLUS,MINUS,POINT,BLANK
      CHARACTER*4 ALPHAE,ALPHAN,ALPHAD
      CHARACTER*4 IC
      CHARACTER*4 IA
      CHARACTER*4 ICHAR
      CHARACTER*4 ISTOR1
      CHARACTER*4 ISTOR2
C
      DIMENSION X(1)
      DIMENSION IA(80),ICHAR(41),IC(10) 
      DIMENSION ISTOR1(80),ISTOR2(80)
C
      DATA PLUS,MINUS,POINT,BLANK /'+','-','.',' '/
      DATA ALPHAE,ALPHAN,ALPHAD /'E','N','D'/
      DATA IC(1),IC(2),IC(3),IC(4),IC(5),IC(6),IC(7),IC(8),IC(9),IC(10)
     1/'0','1','2','3','4','5','6','7','8','9'/
C
      N=0 
      IRD=5
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      MINCOL=ICOL1
      MAXCOL=ICOL2
      IF(ICOL2.LT.ICOL1)MINCOL=ICOL2
      IF(ICOL2.LT.ICOL1)MAXCOL=ICOL1
      IF(MINCOL.LT.1.OR.MAXCOL.GT.80)GOTO51
      GOTO90
   51 WRITE(IPR,41) 
      WRITE(IPR,42) 
      WRITE(IPR,43)ICOL1,ICOL2
      RETURN
   90 CONTINUE
   41 FORMAT(1H ,103H***** FATAL ERROR--THE FIRST OR SECOND (OR BOTH) IN
     1PUT ARGUMENT TO THE READ   SUBROUTINE IS OUTSIDE THE) 
   42 FORMAT(1H , 37H      ALLOWABLE (1,80) INTERVAL *****) 
   43 FORMAT(1H , 41H***** THE VALUE OF THE FIRST ARGUMENT IS ,I7, 42H
     1AND THE VALUE OF THE SECOND ARGUMENT IS ,I7,6H *****) 
C
C-----START POINT-----------------------------------------------------
C
      IBUG=0
C
      NUMCRD=0
  120 CONTINUE
      READ(IRD,2031,END=1950)(IA(I),I=1,80)
      IF(IBUG.EQ.1)WRITE(6,1111)(IA(I),I=1,80)
 1111 FORMAT(1H ,80A1)
      DO101J=1,78
      JP1=J+1
      JP2=J+2
      IF(IA(J).EQ.ALPHAE.AND.IA(JP1).EQ.ALPHAN.
     1AND.IA(JP2).EQ.ALPHAD)GOTO1950
  101 CONTINUE
  102 NUMCRD=NUMCRD+1
      IF(NUMCRD.EQ.1)GOTO103
      DO104J=1,80
      ISTOR2(J)=IA(J)
  104 CONTINUE
      GOTO105
  103 DO106J=1,80
      ISTOR1(J)=IA(J)
      ISTOR2(J)=IA(J)
  106 CONTINUE
  105 I=MINCOL
C
  150 DO100J=1,41
      ICHAR(J)=BLANK
  100 CONTINUE
      NC=0
      NDP=0
  160 DO200J=1,10
      IF(IA(I).EQ.IC(J))GOTO250
  200 CONTINUE
      IF(IA(I).EQ.PLUS)GOTO350
      IF(IA(I).EQ.MINUS)GOTO450
      IF(IA(I).EQ.POINT)GOTO550
      IF(NC.EQ.0)GOTO650
      IF(NC.EQ.1)GOTO750
      IF(NC.EQ.2)GOTO850
      IEND=0
      GOTO1050
C
  250 IF(NC.EQ.0)GOTO260
      GOTO270
  260 NC=1
      ICHAR(NC)=PLUS
  270 NC=NC+1
      ICHAR(NC)=IA(I)
      I=I+1
      IF(I.LE.MAXCOL)GOTO160
      IEND=1
      GOTO1050
C
  350 IF(NC.EQ.0)GOTO360
      WRITE(IPR,999)
      WRITE(IPR,2001)
      WRITE(IPR,2021)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,2023)(IA(J),J=1,80)
      WRITE(IPR,999)
      GOTO120
  360 NC=1
      ICHAR(NC)=IA(I)
      I=I+1
      IF(I.LE.MAXCOL)GOTO160
      WRITE(IPR,999)
      WRITE(IPR,2002)
      WRITE(IPR,2021)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,2023)(IA(J),J=1,80)
      WRITE(IPR,999)
      GOTO120
C
  450 IF(NC.EQ.0)GOTO460
      WRITE(IPR,999)
      WRITE(IPR,2003)
      WRITE(IPR,2021)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,2023)(IA(J),J=1,80)
      WRITE(IPR,999)
      GOTO120
  460 NC=1
      ICHAR(NC)=IA(I)
      I=I+1
      IF(I.LE.MAXCOL)GOTO160
      WRITE(IPR,999)
      WRITE(IPR,2004)
      WRITE(IPR,2021)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,2023)(IA(J),J=1,80)
      WRITE(IPR,999)
      GOTO120
C
  550 IF(NC.EQ.0)GOTO560
      IF(NC.EQ.1)GOTO570
      IF(NDP.EQ.0)GOTO580
      WRITE(IPR,999)
      WRITE(IPR,2005)
      WRITE(IPR,2021)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,2023)(IA(J),J=1,80)
      WRITE(IPR,999)
      GOTO120
  580 NC=NC+1
      ICHAR(NC)=IA(I)
      NDP=NDP+1
      I=I+1
      IF(I.LE.MAXCOL)GOTO160
      IEND=1
      GOTO1050
  570 NC=2
      ICHAR(NC)=IA(I)
      NDP=NDP+1
      I=I+1
      IF(I.LE.MAXCOL)GOTO160
      WRITE(IPR,999)
      WRITE(IPR,2006)
      WRITE(IPR,2021)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,2023)(IA(J),J=1,80)
      WRITE(IPR,999)
      GOTO120
  560 NC=1
      ICHAR(NC)=PLUS
      NC=2
      ICHAR(NC)=IA(I)
      NDP=NDP+1
      I=I+1
      IF(I.LE.MAXCOL)GOTO160
      WRITE(IPR,999)
      WRITE(IPR,2007)
      WRITE(IPR,2021)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,2023)(IA(J),J=1,80)
      WRITE(IPR,999)
      GOTO120
C
  650 I=I+1
      IF(I.LE.MAXCOL)GOTO160
      GOTO120
C
  750 WRITE(IPR,999)
      WRITE(IPR,2008)
      WRITE(IPR,2021)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,2023)(IA(J),J=1,80)
      WRITE(IPR,999)
      GOTO120
C
  850 IF(ICHAR(1).EQ.PLUS.AND.ICHAR(2).EQ.POINT)GOTO860
      IF(ICHAR(1).EQ.MINUS.AND.ICHAR(2).EQ.POINT)GOTO870
      IEND=0
      GOTO1050
  860 WRITE(IPR,999)
      WRITE(IPR,2009)
      WRITE(IPR,2021)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,2023)(IA(J),J=1,80)
      WRITE(IPR,999)
      GOTO120
  870 WRITE(IPR,999)
      WRITE(IPR,2010)
      WRITE(IPR,2021)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,2023)(IA(J),J=1,80)
      WRITE(IPR,999)
      GOTO120
C
C
C
 1050 DO1100J=2,NC
      IF(ICHAR(J).EQ.POINT)GOTO1150
 1100 CONTINUE
      J=NC+1
      NCP1=NC+1
      ICHAR(NCP1)=POINT
      NC=NCP1
C
 1150 LOCPT=J
      NUMINT=J-2
      NUMDEC=NC-J
      SUM=0.0
      IF(NUMINT.EQ.0)GOTO1450 
      ISTART=2
      ISTOP=NUMINT+1
      IPOWER=-1
      DO1200J=ISTART,ISTOP
      JREV=ISTOP-J+2
      DO1300K=1,10
      IF(ICHAR(JREV).EQ.IC(K))GOTO1350
 1300 CONTINUE
      WRITE(IPR,999)
      WRITE(IPR,2024)
      WRITE(IPR,2025)(ICHAR(L),L=1,41)
      WRITE(IPR,2023)(IA(L),L=1,80)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,999)
      RETURN
C
 1350 Y=K-1
      IPOWER=IPOWER+1
      SUM=SUM+Y*(10.0**IPOWER)
 1200 CONTINUE
C
 1450 IF(NUMDEC.EQ.0)GOTO1750 
      ISTART=LOCPT+1
      ISTOP=NC
      IPOWER=0
      DO1500J=ISTART,ISTOP
      DO1600K=1,10
      IF(ICHAR(J).EQ.IC(K))GOTO1650
 1600 CONTINUE
      WRITE(IPR,999)
      WRITE(IPR,2026)
      WRITE(IPR,2025)(ICHAR(L),L=1,41)
      WRITE(IPR,2023)(IA(L),L=1,80)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,999)
      RETURN
C
 1650 Y=K-1
      IPOWER=IPOWER+1
      SUM=SUM+Y/(10.0**IPOWER)
 1500 CONTINUE
C
 1750 IF(ICHAR(1).EQ.MINUS)SUM=-SUM
      N=N+1
      X(N)=SUM
      IF(IEND.EQ.1)GOTO120
      I=I+1
      IF(I.LE.MAXCOL)GOTO150
      GOTO120
 1950 WRITE(IPR,999)
      IF(NUMCRD.EQ.0)GOTO1960 
      WRITE(IPR,2300)
      WRITE(IPR,2301)IRD
      WRITE(IPR,2302)MINCOL,MAXCOL
      WRITE(IPR,2303)(ISTOR1(J),J=1,80) 
      WRITE(IPR,2304)(ISTOR2(J),J=1,80) 
 1960 WRITE(IPR,2305)NUMCRD
      WRITE(IPR,2306)N
      WRITE(IPR,999)
      WRITE(IPR,999)
      RETURN
C
  999 FORMAT(1H )
 2001 FORMAT(1H ,103H***** PUNCHED INPUT ERROR--A PLUS HAS OCCURRED IN T
     1HE MIDDLE OF SOME DATA VALUE ON THE CARD BELOW *****) 
 2002 FORMAT(1H , 94H***** PUNCHED INPUT ERROR--THE LAST DATA VALUE ON T
     1HE CARD BELOW CONSISTS OF ONLY A PLUS *****)
 2003 FORMAT(1H ,104H***** PUNCHED INPUT ERROR--A MINUS HAS OCCURRED IN
     1THE MIDDLE OF SOME DATA VALUE ON THE CARD BELOW *****)
 2004 FORMAT(1H , 95H***** PUNCHED INPUT ERROR--THE LAST DATA VALUE ON T
     1HE CARD BELOW CONSISTS OF ONLY A MINUS *****)
 2005 FORMAT(1H , 94H***** PUNCHED INPUT ERROR--SOME DATA VALUE ON THE C
     1ARD BELOW HAS MULTIPLE DECIMAL POINTS *****)
 2006 FORMAT(1H ,125H***** PUNCHED INPUT ERROR--THE LAST DATA VALUE ON T
     1HE CARD BELOW CONSISTS OF ONLY A      +.     OR OF ONLY A      -.
     1   *****)
 2007 FORMAT(1H ,103H***** PUNCHED INPUT ERROR--THE LAST DATA VALUE ON T
     1HE CARD BELOW CONSISTS OF ONLY A DECIMAL POINT *****) 
 2008 FORMAT(1H ,109H***** PUNCHED INPUT ERROR--SOME DATA VALUE ON THE C
     1ARD BELOW CONSISTS OF ONLY A PLUS OR OF ONLY A MINUS *****)
 2009 FORMAT(1H , 97H***** PUNCHED INPUT ERROR--SOME DATA VALUE ON THE C
     1ARD BELOW CONSISTS OF ONLY A      +.     *****)
 2010 FORMAT(1H , 97H***** PUNCHED INPUT ERROR--SOME DATA VALUE ON THE C
     1ARD BELOW CONSISTS OF ONLY A      -.     *****)
 2021 FORMAT(1H , 98H      THIS ILLEGAL DATA VALUE AND ALL SUBSEQUENT DA
     1TA VALUES ON THIS CARD (ONLY) HAVE BEEN DELETED)
 2022 FORMAT(1H , 24H      THIS CARD WAS THE ,I7,27H-TH DATA CARD THAT W
     1AS READ)
 2023 FORMAT(1H , 33H      THE CARD IS AS FOLLOWS--   ,80A1)
 2024 FORMAT(1H ,121H***** PROGRAMMING ERROR IN THE READ   SUBROUTINE--
     1A NON-NUMERIC CHARACTER WAS ENCOUNTERED IN CONVERTING THE INTEGER
     1PART)
 2025 FORMAT(1H , 38H      OF THE FOLLOWING DATA VALUE--   ,41A1)
 2026 FORMAT(1H ,121H***** PROGRAMMING ERROR IN THE READ   SUBROUTINE--
     1A NON-NUMERIC CHARACTER WAS ENCOUNTERED IN CONVERTING THE DECIMAL
     1PART)
 2031 FORMAT(80A1)
 2300 FORMAT(1H , 35HOUTPUT FROM THE READ   SUBROUTINE--)
 2301 FORMAT(1H , 31HTHE INPUT UNIT DEVICE NUMBER = ,I7)
 2302 FORMAT(1H , 53HTHE SCANNING INTERVAL FOR EACH DATA CARD WAS COLUMN
     1  ,I3, 17H THROUGH COLUMN  ,I3, 12H (INCLUSIVE))
 2303 FORMAT(1H , 41HTHE (ENTIRE) FIRST  DATA CARD READ WAS   ,80A1)
 2304 FORMAT(1H , 41HTHE (ENTIRE) LAST   DATA CARD READ WAS   ,80A1)
 2305 FORMAT(1H , 47HTHE TOTAL NUMBER OF DATA CARDS READ WAS        ,I7)
 2306 FORMAT(1H , 47HTHE TOTAL NUMBER (= N) OF DATA VALUES READ WAS ,I7)
      END 
      SUBROUTINE READG(IRD,ICOL1,ICOL2,X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT READG
C
C     PURPOSE--THIS SUBROUTINE PERFORMS A FORMAT-FREE READ
C              OF DATA FROM INPUT UNIT = IRD.
C              ONLY THE CARD COLUMNS BETWEEN ICOL1 AND ICOL2
C              (INCLUSIVELY) ARE SCANNED FOR THE READ.
C              THIS SUBROUTINE IS IDENTICAL TO THE READ SUBROUTINE
C              EXCEPT THAT THE READ SUBROUTINE ASSUMES INPUT UNIT 5,
C              WHEREAS THIS READG SUBROUTINE ALLOWS THE ANALYST
C              TO SPECIFY THE INPUT UNIT.
C              THIS SUBROUTINE GIVES THE DATA ANALYST THE ABILITY
C              TO GET DATA INTO THE MACHINE
C              FROM A VARIETY OF INPUT SOURCES
C              (CARD, TAPE, DISC, ETC.) 
C              WITHOUT HAVING 
C              TO WORRY ABOUT AND SPECIFY FORMATS.
C              THE DATA CARD IMAGES MAY BE MADE
C              WITHOUT REGARD TO ANY PARTICULAR FORMAT
C              AND MAY BE ENTERED INTO THE MACHINE
C              WITHOUT DEFINING ANY FORMATS.
C     INPUT  ARGUMENTS--IRD    = THE INTEGER VALUE SPECIFYING
C                                THE INPUT UNIT FROM WHICH
C                                THE CARD IMAGES WILL COME. 
C                     --ICOL1  = THE INTEGER CARD COLUMN NUMBER
C                                WHICH DEFINES THE LOWER BOUND
C                                (INCLUSIVELY) OF THE INTERVAL
C                                ON EACH CARD IMAGE TO BE SCANNED
C                                FOR THE READ.
C                     --ICOL2  = THE INTEGER CARD COLUMN NUMBER
C                                WHICH DEFINES THE UPPER BOUND
C                                (INCLUSIVELY) OF THE INTERVAL
C                                ON EACH CARD IMAGE TO BE SCANNED
C                                FOR THE READ.
C     OUTPUT ARGUMENTS--X      = THE SINGLE PRECISION VECTOR
C                                INTO WHICH THE READ DATA VALUES
C                                WILL BE SEQUENTIALLY PLACED.
C                     --N      = THE INTEGER VALUE
C                                WHICH WILL EQUAL THE NUMBER OF DATA
C                                VALUES WHICH WERE READ.
C     OUTPUT--THE SINGLE PRECISION VECTOR X WHICH 
C             WILL CONTAIN THE READ
C             DATA VALUES, AND
C             THE INTEGER VALUE N WHICH WILL
C             EQUAL THE NUMBER OF DATA VALUES
C             READ INTO X.
C             ALSO, 7 LINES OF SUMMARY INFORMATION
C             WILL BE GENERATED--
C             REGARDING WHAT WAS IN FACT READ INTO THE MACHINE--
C             1) THE VALUES OF ICOL1 AND ICOL2;
C             2) THE (ENTIRE) FIRST DATA CARD READ;
C             3) THE (ENTIRE) LAST DATA CARD READ;
C             4) THE TOTAL NUMBER OF DATA CARDS READ;
C             5) THE TOTAL NUMBER OF DATA VALUES READ.
C     PRINTING--YES.
C     RESTRICTIONS--ICOL1 AND ICOL2 MUST BE BETWEEN 1 AND 80,
C                   INCLUSIVELY.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--ADJACENT DATA VALUES ON THE SAME CARD
C              MUST BE SEPARATED BY AT LEAST 1 BLANK
C              OR 1 ALPHABETIC CHARACTER, OR BY  ANY
C              COMBINATION OF BLANKS AND ALPHABETIC
C              CHARACTERS.  IN THIS CONTEXT, AN
C              ALPHABETIC CHARACTER IS ANY CHARACTER
C              OTHER THAN 0, 1, 2, ..., 9, +, -, OR ..
C              IN EFFECT, THEREFORE, ALL ALPHABETIC INFORMATION
C              IN THE INTERVAL DEFINED BY ICOL1 AND ICOL2
C              (INCLUSIVELY) IS IGNORED FOR READING PURPOSES.
C              ALL INFORMATION (BOTH NUMERIC AND ALPHABETIC)
C              OUTSIDE THE DEFINED INTERVAL IS ALSO IGNORED 
C              FOR READING PURPOSES.
C     COMMENT--THE DATA VALUES ON THE CARDS ARE FREE-FORMAT.
C              THEY MAY BE EITHER INTEGER OR FLOATING POINT 
C              (THAT IS, WITHOUT OR WITH THE DECIMAL POINTS).
C              EXPONENTIAL FLOATING POINT FORMAT (E FORMAT) 
C              IS NOT PERMITTED.
C              ALL DATA, WHETHER WITHOUT OR WITH THE DECIMAL POINT
C              ON THE CARDS, WILL BE READ INTO THE MACHINE
C              INTO THE X VECTOR AND WILL RESIDE THERE AS FLOATING
C              POINT NUMBERS. 
C     COMMENT--ANY PARTICULAR DATA VALUE MUST START AND END 
C              ON THE SAME DATA CARD; DATA VALUES MAY NOT
C              START ON ONE CARD AND FINISH ON THE NEXT.
C              VARIOUS ILLEGAL COMBINATIONS (SUCH AS
C              MULTIPLE DECIMAL POINTS, MULTIPLE PLUSSES OR 
C              MINUSES, INCOMPLETE VALUES CONSISTING ONLY
C              OF A DECIMAL POINT, OR ONLY OF A SIGN AND A DECIMAL
C              POINT, ETC. ARE NOT ACCEPTED AND THE
C              DATA ANALYST WILL BE INFORMED OF THE EXISTENCE OF
C              SUCH BY AN ERROR DIAGNOSTIC.
C              IN THE EVENT OF SUCH AN ILLEGAL COMBINATION, 
C              THAT 'NUMBER' AND ALL REMAINING NUMBERS ON THAT CARD WILL
C              WILL BE IGNORED (NOT READ INTO THE MACHINE)
C              AND THE NEXT DATA CARD WILL THEN
C              BE READ.
C     COMMENT--THIS SUBROUTINE WILL CONTINUOUSLY AND
C              SEQUENTIALLY READ CARDS UNTIL A CARD WITH
C              THE WORD         END       (SOMEWHERE BETWEEN
C              COLUMNS ICOL1 AND ICOL2 (INCLUSIVELY)
C              IS ENCOUNTERED.
C              TO TERMINATE A DATA SET, THE ANALYST SHOULD
C              APPEND SUCH A CARD WHICH HAS THE WORD
C              END        SOMEWHERE IN THE INTERVAL
C              DEFINED BY ICOL1 AND ICOL2.
C              FOR EXAMPLE, IF ICOL1 = 1 AND ICOL2 = 20,
C              THEN A SEPARATE CARD WITH     END
C              IN COLUMNS 1, 2, AND 3, OR
C              IN COLUMNS 10, 11, AND 12, ETC.
C              WOULD TERMINATE THE READ.
C              IT IS IMPORTANT TO APPEND SUCH A CARD--
C              FAILURE TO DO SO WILL RESULT IN AN INCOMPLETE
C              DATA SET OR (ON SOME COMPUTERS) AN 
C              UNPREDICTABLE RUN TERMINATION.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--DECEMBER  1972. 
C     UPDATED         --AUGUST    1974. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --OCTOBER   1976. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 PLUS,MINUS,POINT,BLANK
      CHARACTER*4 ALPHAE,ALPHAN,ALPHAD
      CHARACTER*4 IC
      CHARACTER*4 IA
      CHARACTER*4 ICHAR
      CHARACTER*4 ISTOR1
      CHARACTER*4 ISTOR2
C
      DIMENSION X(1)
      DIMENSION IA(80),ICHAR(41),IC(10) 
      DIMENSION ISTOR1(80),ISTOR2(80)
C
      DATA PLUS,MINUS,POINT,BLANK /'+','-','.',' '/
      DATA ALPHAE,ALPHAN,ALPHAD /'E','N','D'/
      DATA IC(1),IC(2),IC(3),IC(4),IC(5),IC(6),IC(7),IC(8),IC(9),IC(10)
     1/'0','1','2','3','4','5','6','7','8','9'/
C
      N=0 
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      MINCOL=ICOL1
      MAXCOL=ICOL2
      IF(ICOL2.LT.ICOL1)MINCOL=ICOL2
      IF(ICOL2.LT.ICOL1)MAXCOL=ICOL1
      IF(MINCOL.LT.1.OR.MAXCOL.GT.80)GOTO51
      GOTO90
   51 WRITE(IPR,41) 
      WRITE(IPR,42) 
      WRITE(IPR,43)ICOL1,ICOL2
      RETURN
   90 CONTINUE
   41 FORMAT(1H ,103H***** FATAL ERROR--THE FIRST OR SECOND (OR BOTH) IN
     1PUT ARGUMENT TO THE READG  SUBROUTINE IS OUTSIDE THE) 
   42 FORMAT(1H , 37H      ALLOWABLE (1,80) INTERVAL *****) 
   43 FORMAT(1H , 41H***** THE VALUE OF THE FIRST ARGUMENT IS ,I7, 42H
     1AND THE VALUE OF THE SECOND ARGUMENT IS ,I7,6H *****) 
C
C-----START POINT-----------------------------------------------------
C
C
      NUMCRD=0
  120 READ(IRD,2031,END=1950)(IA(I),I=1,80)
      DO101J=1,78
      IF(IA(J).NE.ALPHAE)GOTO101
      JP1=J+1
      IF(IA(JP1).NE.ALPHAN)GOTO101
      JP2=J+2
      IF(IA(JP2).NE.ALPHAD)GOTO101
      GOTO1950
  101 CONTINUE
  102 NUMCRD=NUMCRD+1
      IF(NUMCRD.EQ.1)GOTO103
      DO104J=1,80
      ISTOR2(J)=IA(J)
  104 CONTINUE
      GOTO105
  103 DO106J=1,80
      ISTOR1(J)=IA(J)
      ISTOR2(J)=IA(J)
  106 CONTINUE
  105 I=MINCOL
C
  150 DO100J=1,41
      ICHAR(J)=BLANK
  100 CONTINUE
      NC=0
      NDP=0
  160 DO200J=1,10
      IF(IA(I).EQ.IC(J))GOTO250
  200 CONTINUE
      IF(IA(I).EQ.PLUS)GOTO350
      IF(IA(I).EQ.MINUS)GOTO450
      IF(IA(I).EQ.POINT)GOTO550
      IF(NC.EQ.0)GOTO650
      IF(NC.EQ.1)GOTO750
      IF(NC.EQ.2)GOTO850
      IEND=0
      GOTO1050
C
  250 IF(NC.EQ.0)GOTO260
      GOTO270
  260 NC=1
      ICHAR(NC)=PLUS
  270 NC=NC+1
      ICHAR(NC)=IA(I)
      I=I+1
      IF(I.LE.MAXCOL)GOTO160
      IEND=1
      GOTO1050
C
  350 IF(NC.EQ.0)GOTO360
      WRITE(IPR,999)
      WRITE(IPR,2001)
      WRITE(IPR,2021)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,2023)(IA(J),J=1,80)
      WRITE(IPR,999)
      GOTO120
  360 NC=1
      ICHAR(NC)=IA(I)
      I=I+1
      IF(I.LE.MAXCOL)GOTO160
      WRITE(IPR,999)
      WRITE(IPR,2002)
      WRITE(IPR,2021)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,2023)(IA(J),J=1,80)
      WRITE(IPR,999)
      GOTO120
C
  450 IF(NC.EQ.0)GOTO460
      WRITE(IPR,999)
      WRITE(IPR,2003)
      WRITE(IPR,2021)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,2023)(IA(J),J=1,80)
      WRITE(IPR,999)
      GOTO120
  460 NC=1
      ICHAR(NC)=IA(I)
      I=I+1
      IF(I.LE.MAXCOL)GOTO160
      WRITE(IPR,999)
      WRITE(IPR,2004)
      WRITE(IPR,2021)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,2023)(IA(J),J=1,80)
      WRITE(IPR,999)
      GOTO120
C
  550 IF(NC.EQ.0)GOTO560
      IF(NC.EQ.1)GOTO570
      IF(NDP.EQ.0)GOTO580
      WRITE(IPR,999)
      WRITE(IPR,2005)
      WRITE(IPR,2021)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,2023)(IA(J),J=1,80)
      WRITE(IPR,999)
      GOTO120
  580 NC=NC+1
      ICHAR(NC)=IA(I)
      NDP=NDP+1
      I=I+1
      IF(I.LE.MAXCOL)GOTO160
      IEND=1
      GOTO1050
  570 NC=2
      ICHAR(NC)=IA(I)
      NDP=NDP+1
      I=I+1
      IF(I.LE.MAXCOL)GOTO160
      WRITE(IPR,999)
      WRITE(IPR,2006)
      WRITE(IPR,2021)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,2023)(IA(J),J=1,80)
      WRITE(IPR,999)
      GOTO120
  560 NC=1
      ICHAR(NC)=PLUS
      NC=2
      ICHAR(NC)=IA(I)
      NDP=NDP+1
      I=I+1
      IF(I.LE.MAXCOL)GOTO160
      WRITE(IPR,999)
      WRITE(IPR,2007)
      WRITE(IPR,2021)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,2023)(IA(J),J=1,80)
      WRITE(IPR,999)
      GOTO120
C
  650 I=I+1
      IF(I.LE.MAXCOL)GOTO160
      GOTO120
C
  750 WRITE(IPR,999)
      WRITE(IPR,2008)
      WRITE(IPR,2021)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,2023)(IA(J),J=1,80)
      WRITE(IPR,999)
      GOTO120
C
  850 IF(ICHAR(1).EQ.PLUS.AND.ICHAR(2).EQ.POINT)GOTO860
      IF(ICHAR(1).EQ.MINUS.AND.ICHAR(2).EQ.POINT)GOTO870
      IEND=0
      GOTO1050
  860 WRITE(IPR,999)
      WRITE(IPR,2009)
      WRITE(IPR,2021)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,2023)(IA(J),J=1,80)
      WRITE(IPR,999)
      GOTO120
  870 WRITE(IPR,999)
      WRITE(IPR,2010)
      WRITE(IPR,2021)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,2023)(IA(J),J=1,80)
      WRITE(IPR,999)
      GOTO120
C
C
C
 1050 DO1100J=2,NC
      IF(ICHAR(J).EQ.POINT)GOTO1150
 1100 CONTINUE
      J=NC+1
      NCP1=NC+1
      ICHAR(NCP1)=POINT
      NC=NCP1
C
 1150 LOCPT=J
      NUMINT=J-2
      NUMDEC=NC-J
      SUM=0.0
      IF(NUMINT.EQ.0)GOTO1450 
      ISTART=2
      ISTOP=NUMINT+1
      IPOWER=-1
      DO1200J=ISTART,ISTOP
      JREV=ISTOP-J+2
      DO1300K=1,10
      IF(ICHAR(JREV).EQ.IC(K))GOTO1350
 1300 CONTINUE
      WRITE(IPR,999)
      WRITE(IPR,2024)
      WRITE(IPR,2025)(ICHAR(L),L=1,41)
      WRITE(IPR,2023)(IA(L),L=1,80)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,999)
      RETURN
C
 1350 Y=K-1
      IPOWER=IPOWER+1
      SUM=SUM+Y*(10.0**IPOWER)
 1200 CONTINUE
C
 1450 IF(NUMDEC.EQ.0)GOTO1750 
      ISTART=LOCPT+1
      ISTOP=NC
      IPOWER=0
      DO1500J=ISTART,ISTOP
      DO1600K=1,10
      IF(ICHAR(J).EQ.IC(K))GOTO1650
 1600 CONTINUE
      WRITE(IPR,999)
      WRITE(IPR,2026)
      WRITE(IPR,2025)(ICHAR(L),L=1,41)
      WRITE(IPR,2023)(IA(L),L=1,80)
      WRITE(IPR,2022)NUMCRD
      WRITE(IPR,999)
      RETURN
C
 1650 Y=K-1
      IPOWER=IPOWER+1
      SUM=SUM+Y/(10.0**IPOWER)
 1500 CONTINUE
C
 1750 IF(ICHAR(1).EQ.MINUS)SUM=-SUM
      N=N+1
      X(N)=SUM
      IF(IEND.EQ.1)GOTO120
      I=I+1
      IF(I.LE.MAXCOL)GOTO150
      GOTO120
 1950 WRITE(IPR,999)
      IF(NUMCRD.EQ.0)GOTO1960 
      WRITE(IPR,2300)
      WRITE(IPR,2301)IRD
      WRITE(IPR,2302)MINCOL,MAXCOL
      WRITE(IPR,2303)(ISTOR1(J),J=1,80) 
      WRITE(IPR,2304)(ISTOR2(J),J=1,80) 
 1960 WRITE(IPR,2305)NUMCRD
      WRITE(IPR,2306)N
      WRITE(IPR,999)
      WRITE(IPR,999)
      RETURN
C
  999 FORMAT(1H )
 2001 FORMAT(1H ,103H***** INPUT    DATA ERROR--A PLUS HAS OCCURRED IN T
     1HE MIDDLE OF SOME DATA VALUE ON THE CARD BELOW *****) 
 2002 FORMAT(1H , 94H***** INPUT    DATA ERROR--THE LAST DATA VALUE ON T
     1HE CARD BELOW CONSISTS OF ONLY A PLUS *****)
 2003 FORMAT(1H ,104H***** INPUT     DATA ERROR--A MINUS HAS OCCURRED IN
     1THE MIDDLE OF SOME DATA VALUE ON THE CARD BELOW *****)
 2004 FORMAT(1H , 95H***** INPUT     DATA ERROR--THE LAST DATA VALUE ON T
     1HE CARD BELOW CONSISTS OF ONLY A MINUS *****)
 2005 FORMAT(1H , 94H***** INPUT     DATA ERROR--SOME DATA VALUE ON THE C
     1ARD BELOW HAS MULTIPLE DECIMAL POINTS *****)
 2006 FORMAT(1H ,125H***** INPUT     DATA ERROR--THE LAST DATA VALUE ON T
     1HE CARD BELOW CONSISTS OF ONLY A      +.     OR OF ONLY A      -.
     1   *****)
 2007 FORMAT(1H ,103H***** INPUT     DATA ERROR--THE LAST DATA VALUE ON T
     1HE CARD BELOW CONSISTS OF ONLY A DECIMAL POINT *****) 
 2008 FORMAT(1H ,109H***** INPUT     DATA ERROR--SOME DATA VALUE ON THE C
     1ARD BELOW CONSISTS OF ONLY A PLUS OR OF ONLY A MINUS *****)
 2009 FORMAT(1H , 97H***** INPUT     DATA ERROR--SOME DATA VALUE ON THE C
     1ARD BELOW CONSISTS OF ONLY A      +.     *****)
 2010 FORMAT(1H , 97H***** INPUT     DATA ERROR--SOME DATA VALUE ON THE C
     1ARD BELOW CONSISTS OF ONLY A      -.     *****)
 2021 FORMAT(1H ,104H      THIS ILLEGAL DATA VALUE AND ALL SUBSEQUENT DA
     1TA VALUES ON THIS CARD IMAGE (ONLY) HAVE BEEN DELETED)
 2022 FORMAT(1H , 30H      THIS CARD IMAGE WAS THE ,I7,33H-TH DATA CARD
     1IMAGE THAT WAS READ)
 2023 FORMAT(1H , 39H      THE CARD IMAGE IS AS FOLLOWS--   ,80A1)
 2024 FORMAT(1H ,121H***** PROGRAMMING ERROR IN THE READG  SUBROUTINE--
     1A NON-NUMERIC CHARACTER WAS ENCOUNTERED IN CONVERTING THE INTEGER
     1PART)
 2025 FORMAT(1H , 38H      OF THE FOLLOWING DATA VALUE--   ,41A1)
 2026 FORMAT(1H ,121H***** PROGRAMMING ERROR IN THE READG  SUBROUTINE--
     1A NON-NUMERIC CHARACTER WAS ENCOUNTERED IN CONVERTING THE DECIMAL
     1PART)
 2031 FORMAT(80A1)
 2300 FORMAT(1H , 35HOUTPUT FROM THE READG  SUBROUTINE--)
 2301 FORMAT(1H , 31HTHE INPUT UNIT DEVICE NUMBER = ,I7)
 2302 FORMAT(1H , 59HTHE SCANNING INTERVAL FOR EACH DATA CARD IMAGE WAS
     1COLUMN  ,I3, 17H THROUGH COLUMN  ,I3, 12H (INCLUSIVE))
 2303 FORMAT(1H , 47HTHE (ENTIRE) FIRST  DATA CARD IMAGE   READ WAS , 
     180A1)
 2304 FORMAT(1H , 47HTHE (ENTIRE) LAST   DATA CARD IMAGE   READ WAS , 
     180A1)
 2305 FORMAT(1H , 47HTHE TOTAL NUMBER OF DATA CARD IMAGES  READ WAS ,        )
     1I7) 
 2306 FORMAT(1H , 47HTHE TOTAL NUMBER (= N) OF DATA VALUES READ WAS ,I7)
C
      END 
      SUBROUTINE RELSD(X,N,IWRITE,XRELSD)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT RELSD
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SAMPLE RELATIVE STANDARD DEVIATION 
C              OF THE DATA IN THE INPUT VECTOR X. 
C              THE SAMPLE RELATIVE STANDARD DEVIATION = (THE SAMPLE
C              STANDARD DEVIATION)/(THE SAMPLE MEAN).
C              THE DENOMINATOR N-1 IS USED IN COMPUTING THE 
C              SAMPLE STANDARD DEVIATION.
C              THE SAMPLE RELATIVE STANDARD DEVIATION IS ALTERNATIVELY
C              REFERRED TO AS THE SAMPLE COEFFICIENT OF VARIATION.
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                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SAMPLE RELATIVE STANDARD DEVIATION
C                                AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SAMPLE RELATIVE STANDARD DEVIATION
C                                AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--XRELSD = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE RELATIVE
C                                STANDARD DEVIATION.
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE RELATIVE STANDARD DEVIATION. 
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 47, 233.
C               --SNEDECOR AND COCHRAN, STATISTICAL METHODS,
C                 EDITION 6, 1967, PAGES 62-65.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --MARCH     1975. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      AN=N
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      XRELSD=0.0
      GOTO201
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XRELSD=0.0
      GOTO201
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE RELSD  SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 RELSD  SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE RELSD  SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      SUM=0.0
      DO100I=1,N
      SUM=SUM+X(I)
  100 CONTINUE
      XMEAN=SUM/AN
      SUM=0.0
      DO200I=1,N
      SUM=SUM+(X(I)-XMEAN)**2 
  200 CONTINUE
      VAR=SUM/(AN-1.0)
      SD=SQRT(VAR)
      XRELSD=100.0*SD/XMEAN
C
  201 IF(IWRITE.EQ.0)RETURN
      WRITE(IPR,999)
      WRITE(IPR,205)N,XRELSD
  205 FORMAT(' THE RELATIVE STANDARD DEVIATION (= STANDARD ',
     1'DEVIATION/MEAN) FOR THE ',I6,' OBSERVATIONS IS ',
     1E12.8,' PERCENT')
  999 FORMAT(1H )
      RETURN
      END 
      SUBROUTINE REPLAC(X,N,XMIN,XMAX,XNEW)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT REPLAC
C
C     PURPOSE--THIS SUBROUTINE REPLACES (WITH THE VALUE XNEW)
C              ALL OBSERVATIONS IN THE
C              SINGLE PRECISION VECTOR X WHICH ARE INSIDE
C              THE CLOSED (INCLUSIVE) INTERVAL
C              DEFINED BY XMIN AND XMAX.
C              ALL OBSERVATIONS OUTSIDE OF
C              THIS INTERVAL ARE LEFT UNCHANGED.
C              THUS ALL OBSERVATIONS IN X WHICH ARE
C              EQUAL TO OR LARGER THAN XMIN AND
C              EQUAL TO OR SMALLER THAN XMAX,
C              WILL BE REPLACED BY XNEW.
C              THIS SUBROUTINE (AND THE 
C              RETAIN AND DELETE SUBROUTINES)
C              GIVES THE DATA ANALYST THE ABILITY TO
C              EASILY 'CLEAN UP' A DATA SET WHICH HAS
C              MISSING AND/OR OUTLYING OBSERVATIONS
C              SO THAT A MORE APPROPRIATE SUBSEQUENT
C              DATA ANALYSIS MAY BE PERFORMED.
C              FOR EXAMPLE, REPLACEMENT OF AN OUTLIER WITH
C              A MORE APPROPRIATE VALUE CAN EASILY
C              BE DONE BY THIS SUBROUTINE.
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                     --XMIN   = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES THE LOWER LIMIT
C                                (INCLUSIVELY) OF THE PARTICULAR
C                                INTERVAL OF INTEREST FOR REPLACEMENT.
C                     --XMAX   = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES THE UPPER LIMIT
C                                (INCLUSIVELY) OF THE PARTICULAR
C                                INTERVAL OF INTEREST FOR REPLACEMENT.
C                     --XNEW   = THE SINGLE PRECISION VALUE 
C                                WITH WHICH ALL OF THE
C                                OBSERVATIONS IN THE INTERVAL
C                                OF INTEREST
C                                WILL BE REPLACED.
C     OUTPUT--THE SINGLE PRECISION VECTOR X
C             IN WHICH ONLY THOSE VALUES INSIDE
C             (INCLUSIVELY) THE INTERVAL OF INTEREST
C             HAVE BEEN REPLACED BY XNEW.
C             ALSO, 6 LINES OF SUMMARY INFORMATION
C             WILL BE GENERATED INDICATING
C             1) WHAT THE INTERVAL OF INTEREST WAS;
C             2) WHAT THE REPLACEMENT VALUE WAS;
C             3) HOW MANY OBSERVATIONS WERE REPLACED;
C             4) WHAT THE SAMPLE SIZE WAS (N);
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--THIS SUBROUTINE MAY BE USEFULLY EMPLOYED
C              IN CONJUNCTION WITH THE DATAPAC
C              PLOTTING SUBROUTINES INASMUCH
C              AS THE LATTER HAVE BEEN
C              SET UP WITH THE CONVENTION
C              THAT ALL VALUES IN THE VERTICAL AXIS
C              VECTOR OR HORIZONTAL AXIS VECTOR
C              WHICH ARE EQUAL TO OR IN EXCESS OF 10.0**10
C              WILL BE AUTOMATICALLY IGNORED
C              IN THE PLOT (THAT IS, NOT PLOTTED).
C              THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM
C              OF PLOTTING WHEN SOME ELEMENTS IN THE VERTICAL
C              OR HORIZONTAL AXIS VECTORS
C              ARE 'MISSING DATA', OR WHEN WE PURPOSELY
C              WANT TO IGNORE CERTAIN ELEMENTS IN THESE VECTORS
C              FOR PLOTTING PURPOSES (THAT IS, WE DO NOT
C              WANT CERTAIN ELEMENTS TO BE PLOTTED).
C              TO CAUSE SPECIFIC ELEMENTS IN THE VERTICAL
C              OR HORIZONTAL AXIS VECTORS TO BE
C              IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND
C              (BY USE OF THE   REPLAC   SUBROUTINE)
C              BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND
C              THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTTING
C              SUBROUTINES.
C     COMMENT--THIS IS ONE OF THE FEW SUBRUTINES IN DATAPAC 
C              IN WHICH THE INPUT VECTOR X IS ALTERED.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1972. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE REPLAC SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 REPLAC SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE REPLAC SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      POINTL=XMIN
      POINTU=XMAX
      IF(XMIN.GT.XMAX)POINTL=XMAX
      IF(XMIN.GT.XMAX)POINTU=XMIN
C
      K=0 
      DO100I=1,N
      IF(X(I).LT.POINTL.OR.X(I).GT.POINTU)GOTO100 
      K=K+1
      X(I)=XNEW
  100 CONTINUE
      NDEL=N-K
C
C     WRITE OUT A BRIEF SUMMARY
C
      WRITE(IPR,999)
      WRITE(IPR,101)
      WRITE(IPR,105)POINTL,POINTU
      WRITE(IPR,106)
      WRITE(IPR,107)
      WRITE(IPR,108)
      WRITE(IPR,109)XNEW
      WRITE(IPR,110)N
      WRITE(IPR,115)K
      WRITE(IPR,120)NDEL
  101 FORMAT(1H ,35HOUTPUT FROM THE REPLAC SUBROUTINE--)
  105 FORMAT(1H ,7X,26HONLY OBSERVATIONS BETWEEN ,E15.8,5H AND ,E15.8)
  106 FORMAT(1H ,7X,31H(INCLUSIVE) HAVE BEEN REPLACED.)
  107 FORMAT(1H ,7X,41HALL OBSERVATIONS OUTSIDE OF THIS INTERVAL)
  108 FORMAT(1H ,7X,25HHAVE BEEN LEFT UNCHANGED.) 
  109 FORMAT(1H ,7X,25HTHE REPLACEMENT VALUE IS ,E15.8)
  110 FORMAT(1H ,7X,40HTHE INPUT  NUMBER OF OBSERVATIONS    IS ,I6)
  115 FORMAT(1H ,7X,40HTHE NUMBER OF OBSERVATIONS REPLACED  IS ,I6)
  120 FORMAT(1H ,7X,40HTHE NUMBER OF OBSERVATIONS UNCHANGED IS ,I6)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE RETAIN(X,N,XMIN,XMAX,NEWN)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT RETAIN
C
C     PURPOSE--THIS SUBROUTINE RETAINS ALL OBSERVATIONS IN THE
C              SINGLE PRECISION VECTOR X WHICH ARE INSIDE
C              THE CLOSED (INCLUSIVE) INTERVAL
C              DEFINED BY XMIN AND XMAX,
C              WHILE DELETING ALL OBSERVATIONS OUTSIDE OF
C              THIS INTERVAL. 
C              THUS ALL OBSERVATIONS IN X WHICH ARE SMALLER 
C              THAN XMIN OR LARGER THAN XMAX ARE DELETED FROM X.
C              THIS SUBROUTINE (AND THE 
C              REPLAC AND DELETE SUBROUTINES)
C              GIVES THE DATA ANALYST THE ABILITY TO
C              EASILY 'CLEAN UP' A DATA SET WHICH HAS
C              MISSING AND/OR OUTLYING OBSERVATIONS
C              SO THAT A MORE APPROPRIATE SUBSEQUENT
C              DATA ANALYSIS MAY BE PERFORMED.
C              FOR EXAMPLE, A TRIMMED SAMPLE CAN EASILY
C              BE CONSTRUCTED BY USE OF THIS SUBROUTINE.
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                     --XMIN   = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES THE LOWER LIMIT
C                                (INCLUSIVELY) OF THE PARTICULAR
C                                INTERVAL OF INTEREST TO BE RETAINED. 
C                     --XMAX   = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES THE UPPER LIMIT
C                                (INCLUSIVELY) OF THE PARTICULAR
C                                INTERVAL OF INTEREST TO BE RETAINED. 
C     OUTPUT ARGUMENTS--NEWN   = THE INTEGER NUMBER OF OBSERVATIONS
C                                REMAINING (RETAINED) IN X AFTER ALL
C                                OF THE OBSERVATIONS OUTSIDE THE
C                                INTERVAL OF INTEREST HAVE BEEN
C                                DELETED.
C     OUTPUT--THE SINGLE PRECISION VECTOR X
C             IN WHICH ONLY THOSE VALUES INSIDE
C             (INCLUSIVELY) THE INTERVAL OF INTEREST
C             HAVE BEEN RETAINED, AND
C             THE INTEGER VALUE NEWN
C             WHICH GIVES THE NUMBER OF 
C             OBSERVATIONS RETAINED IN X.
C             ALSO, 6 LINES OF SUMMARY INFORMATION
C             WILL BE GENERATED INDICATING
C             1) WHAT THE INTERVAL OF INTEREST WAS;
C             2) HOW MANY OBSERVATIONS WERE DELETED;
C             3) WHAT THE OLD (ORIGINAL) SAMPLE SIZE WAS (N);
C             4) WHAT THE NEW SAMPLE SIZE IS (NEWN).
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--IN THE END, AFTER THIS SUBROUTINE HAS
C              MADE WHATEVER DELETIONS ARE APPROPRIATE,
C              THE OUTPUT VECTOR X WILL BE 'PACKED';
C              THAT IS, NO 'HOLES' WILL EXIST IN THE
C              VECTOR X--ALL OF THE RETAINED ELEMENTS
C              OF X WILL BE PACKED INTO THE FIRST AVAILABLE 
C              LOCATIONS IN X, WHILE THE REMAINDER
C              OF THE N LOCATIONS IN X WILL BE ZERO-FILLED. 
C     COMMENT--IN THE MAIN (CALLING) ROUTINE, IT IS
C              PERMISSABLE (IF THE ANALYST SO DESIRES)
C              TO USE THE SAME VARIABLE NAME
C              IN THE FIFTH ARGUMENT AS USED IN THE SECOND
C              ARGUMENT IN THE CALLING SEQUENCE TO THIS
C              RETAIN SUBROUTINE--NO CONFLICT WILL RESULT
C              IN THE INTERNAL OPERATION OF THE     RETAIN
C              SUBROUTINE.  FOR EXAMPLE, IT IS PERMISSIBLE
C              TO HAVE     CALL RETAIN(X,N,-10.0,10.0,N)
C              IN WHICH THE VARIABLE NAME      N    IS USED 
C              AS BOTH THE SECOND AND FIFTH ARGUMENTS.
C     COMMENT--THIS IS ONE OF THE FEW SUBROUTINES IN DATAPAC
C              IN WHICH THE INPUT VECTOR X IS ALTERED.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1972. 
C     UPDATED         --JULY      1974. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE RETAIN SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 RETAIN SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE RETAIN SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      POINTL=XMIN
      POINTU=XMAX
      IF(XMIN.GT.XMAX)POINTL=XMAX
      IF(XMIN.GT.XMAX)POINTU=XMIN
C
      NOLD=N
      K=0 
      DO100I=1,NOLD 
      IF(X(I).LT.POINTL.OR.X(I).GT.POINTU)GOTO100 
      K=K+1
      X(K)=X(I)
  100 CONTINUE
      NEWN=K
      NDEL=NOLD-NEWN
C
      NEWNP1=NEWN+1 
      IF(NEWNP1.GT.NOLD)GOTO250
      DO200I=NEWNP1,NOLD
      X(I)=0.0
  200 CONTINUE
  250 CONTINUE
C
C     WRITE OUT A BRIEF SUMMARY
C
      WRITE(IPR,999)
      WRITE(IPR,101)
      WRITE(IPR,105)POINTL,POINTU
      WRITE(IPR,106)
      WRITE(IPR,107)
      WRITE(IPR,108)
      WRITE(IPR,110)NOLD
      WRITE(IPR,115)NEWN
      WRITE(IPR,120)NDEL
  101 FORMAT(1H ,35HOUTPUT FROM THE RETAIN SUBROUTINE--)
  105 FORMAT(1H ,7X,26HONLY OBSERVATIONS BETWEEN ,E15.8,5H AND ,E15.8)
  106 FORMAT(1H ,7X,31H(INCLUSIVE) HAVE BEEN RETAINED.)
  107 FORMAT(1H ,7X,41HALL OBSERVATIONS OUTSIDE OF THIS INTERVAL)
  108 FORMAT(1H ,7X,18HHAVE BEEN DELETED.)
  110 FORMAT(1H ,7X,44HTHE INPUT  NUMBER OF OBSERVATIONS (IN X) IS ,I6)
  115 FORMAT(1H ,7X,44HTHE OUTPUT NUMBER OF OBSERVATIONS (IN X) IS ,I6)
  120 FORMAT(1H ,7X,44HTHE NUMBER OF OBSERVATIONS DELETED       IS ,I6)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE RUNS(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT RUNS
C
C     PURPOSE--THIS SUBROUTINE PERFORMS A RUNS ANALYSIS
C              OF THE DATA IN THE INPUT VECTOR X. 
C              THE ANALYSIS CONSISTS OF FIRST DETERMINING
C              THE OBSERVED NUMBER OF RUNS FROM THE DATA,
C              AND THEN COMPUTING
C              THE EXPECTED NUMBER OF RUNS,
C              THE STANDARD DEVIATION OF THE NUMBER OF RUNS,
C              AND THE RESULTING STANDARDIZED STATISTIC
C              FOR THE NUMBER OF RUNS FOR RUNS OF VARIOUS
C              LENGTHS.
C              THIS IS DONE FOR RUNS UP, RUNS DOWN, AND
C              RUNS UP AND DOWN.
C              THIS RUNS ANSLYSIS IS A USEFUL DISTRIBUTION-FREE
C              TEST OF THE RANDOMNESS OF A DATA SET.
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--4 PAGES OF AUTOMATIC PRINTOUT
C             CONSISTING OF THE OBSERVED NUMBER,
C             EXPECTED NUMBER, STANDARD DEVIATION 
C             AND RESULTING STANDARDIZED STATISTIC
C             FOR RUNS OF VARIOUS LENGTHS.
C             AND THE CUMULATIVE FREQUENCY.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 15000. 
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--LEVENE AND WOLFOWITZ, ANNALS OF MATHEMATICAL
C                 STATISTICS, 1944, PAGES 58-69;
C                 ESPECIALLY PAGES 60, 63, AND 64.
C     REFERENCES--BRADLEY, DISTRIBUTION-FREE STATISTICAL TESTS,
C                 1968, CHAPTER 12, PAGES 271-282.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(15000)
      DIMENSION  NRUL(16), NRDL(16), NRTL(16), NRULG(16), NRDLG(16)
      DIMENSION  NRTLG(16)
      DIMENSION ENRUL(16),ENRTL(16),ENRULG(16),ENRTLG(16)
      DIMENSION SNRUL(16),SNRTL(16),SNRULG(16),SNRTLG(16)
      DIMENSION ZNRUL(16),ZNRDL(16),ZNRTL(16),ZNRULG(16),ZNRDLG(16)
      DIMENSION ZNRTLG(16)
      DIMENSION C1(15),C2(15),C3(15),C4(15)
      DIMENSION ANRUL(16),ANRDL(16),ANRTL(16)
      DIMENSION ANRULG(16),ANRDLG(16),ANRTLG(16)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1))
C
      DATA C1(1),C1(2),C1(3),C1(4),C1(5),C1(6),C1(7),C1(8),C1(9),C1(10),
     1C1(11),C1(12),C1(13),C1(14),C1(15)
     1/ .4236111111E+00,  .1126675485E+00,  .4191688713E-01,
     1  .1076912487E-01,  .2003959238E-02,  .3023235799E-03,
     1  .3911555473E-04,  .4459038843E-05,  .4551105210E-06,
     1  .4207466837E-07,  .3555930927E-08,  .2768273257E-09,
     1  .1997821524E-10,  .1343876568E-11,  .8465610177E-13/
      DATA C2(1),C2(2),C2(3),C2(4),C2(5),C2(6),C2(7),C2(8),C2(9),C2(10),
     1C2(11),C2(12),C2(13),C2(14),C2(15)
     1/-.4819444444E+00, -.1628284832E+00, -.9690696649E-01,
     1 -.3778106786E-01, -.9289228716E-02, -.1724429252E-02,
     1 -.2638557888E-03, -.3466965096E-04, -.4004129153E-05,
     1 -.4130382587E-06, -.3851876069E-07, -.3279103786E-08,
     1 -.2568491117E-09, -.1863433868E-10, -.1259220466E-11/
      DATA C3(1),C3(2),C3(3),C3(4),C3(5),C3(6),C3(7),C3(8),C3(9),C3(10),
     1C3(11),C3(12),C3(13),C3(14),C3(15)
     1/ .1777777778E+00,  .7916666667E-01,  .4738977072E-01,
     1  .1274801587E-01,  .2338606059E-02,  .3461358734E-03,
     1  .4407121770E-04,  .4960020603E-05,  .5010387575E-06,
     1  .4592883352E-07,  .3854170274E-08,  .2982393839E-09,
     1  .2141205844E-10,  .1433843200E-11,  .8996663214E-13/
      DATA C4(1),C4(2),C4(3),C4(4),C4(5),C4(6),C4(7),C4(8),C4(9),C4(10),
     1C4(11),C4(12),C4(13),C4(14),C4(15)
     1/-.3222222222E+00, -.5972222222E-01, -.1130268959E+00,
     1 -.4696428571E-01, -.1123273065E-01, -.2025170849E-02,
     1 -.3029410411E-03, -.3912824548E-04, -.4459234519E-05,
     1 -.4551128785E-06, -.4207469124E-07, -.3555931110E-08,
     1 -.2768273269E-09, -.1997821525E-10, -.1343876568E-11/
C
      IPR=6
      IUPPER=15000
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE RUNS   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 RUNS   SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** FATAL ERROR--         THE SECOND INPUT ARGUME
     1NT TO THE RUNS   SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     FORM THE SEQUENTIAL DIFFERENCE TABLE
C
      NM1=N-1
      DO100I=1,NM1
      IP1=I+1
      Y(I)=X(IP1)-X(I)
  100 CONTINUE
C
C     ZERO-OUT THE 6 'NUMBER OF RUNS' VECTORS
C
      DO200I=1,16
      NRUL(I)=0
      NRDL(I)=0
      NRTL(I)=0
      NRULG(I)=0
      NRDLG(I)=0
      NRTLG(I)=0
  200 CONTINUE
C
C     DETERMINE THE NUMBER OF RUNS UP OF LENGTH EXACTLY I
C     AND THE NUMBER OF RUNS DOWN OF LENGTH EXACTLY I
C     DETERMINE THE LENGTH OF THE LONGEST RUN UP
C     AND THE LENGTH OF THE LONGEST RUN DOWN
C
      LENUP=0
      LENDN=0
      MAXLNU=0
      MAXLND=0
      DO300I=1,NM1
      IF(Y(I).EQ.0.0.AND.LENUP.GE.1)LENUP=LENUP+1 
      IF(Y(I).EQ.0.0.AND.LENDN.GE.1)LENDN=LENDN+1 
      IF(Y(I).EQ.0.0.AND.LENUP.EQ.0.AND.LENDN.EQ.0)LENUP=LENUP+1
      IF(Y(I).GT.0.0.AND.LENDN.GE.1.AND.LENDN.LE.15)NRDL(LENDN)=NRDL(LEN
     1DN)+1
      IF(Y(I).GT.0.0.AND.LENDN.GE.1.AND.LENDN.GE.16)NRDL(16)=NRDL(16)+1
      IF(Y(I).GT.0.0)LENDN=0
      IF(Y(I).GT.0.0)LENUP=LENUP+1
      IF(Y(I).LT.0.0.AND.LENUP.GE.1.AND.LENUP.LE.15)NRUL(LENUP)=NRUL(LEN
     1UP)+1
      IF(Y(I).LT.0.0.AND.LENUP.GE.1.AND.LENUP.GE.16)NRUL(16)=NRUL(16)+1
      IF(Y(I).LT.0.0)LENUP=0
      IF(Y(I).LT.0.0)LENDN=LENDN+1
      IF(I.EQ.NM1.   AND.LENDN.GE.1.AND.LENDN.LE.15)NRDL(LENDN)=NRDL(LEN
     1DN)+1
      IF(I.EQ.NM1.   AND.LENDN.GE.1.AND.LENDN.GE.16)NRDL(16)=NRDL(16)+1
      IF(I.EQ.NM1.   AND.LENUP.GE.1.AND.LENUP.LE.15)NRUL(LENUP)=NRUL(LEN
     1UP)+1
      IF(I.EQ.NM1.   AND.LENUP.GE.1.AND.LENUP.GE.16)NRUL(16)=NRUL(16)+1
      IF(LENUP.GT.MAXLNU)MAXLNU=LENUP
      IF(LENDN.GT.MAXLND)MAXLND=LENDN
  300 CONTINUE
C
C     DETERMINE THE NUMBER OF RUNS TOTAL OF LENGTH EXACTLY I
C     AND THE LENGTH OF THE LONGEST RUN UP OR DOWN
C
      DO400I=1,16
      NRTL(I)=NRUL(I)+NRDL(I) 
  400 CONTINUE
      MAXLNT=MAXLNU 
      IF(MAXLND.GT.MAXLNU)MAXLNT=MAXLND 
C
C     DETERMINE THE NUMBER OF RUNS UP OF LENGTH I OR MORE
C     AND THE NUMBER OF RUNS DOWN OF LENGTH I OR MORE
C     AND THE NUMBER OF RUNS TOTAL OF LENGTH I OR MORE
C
      NRULG(16)=NRUL(16)
      NRDLG(16)=NRDL(16)
      NRTLG(16)=NRTL(16)
      DO500I=1,15
      J=16-I
      JP1=J+1
      NRULG(J)=NRULG(JP1)+NRUL(J)
      NRDLG(J)=NRDLG(JP1)+NRDL(J)
      NRTLG(J)=NRTLG(JP1)+NRTL(J)
  500 CONTINUE
C
C     DETERMINE THE NUMBER OF POSITIVE, ZERO, AND NEGATIVE ENTRIES
C     IN THE DIFFERENCE TABLE.  IF RANDOM, THE NUMBER OF POSITIVE SHOULD BE
C     APPROXIMATELY EQUAL TO THE NUMBER OF NEGATIVE
C
      NNEG=0
      NZER=0
      NPOS=0
      DO800I=1,NM1
      IF(Y(I).LT.0.0)NNEG=NNEG+1
      IF(Y(I).EQ.0.0)NZER=NZER+1
      IF(Y(I).GT.0.0)NPOS=NPOS+1
  800 CONTINUE
C
C     COMPUTE THE EXPECTED NUMBER OF RUNS UP OF LENGTH EXACTLY I =
C     THE EXPECTED NUMBER OF RUNS DOWN OF LENGTH EXACTLY I =
C     ONE HALF THE EXPECTED NUMBER OF RUNS TOTAL OF LENGTH EXACTLY I
C
      DEN=6.0
      DO2000I=1,15
      AI=I
      ENRUL(I)=AN*(AI*AI+3.0*AI+1.0)-(AI*AI*AI+3.0*AI*AI-AI-4.0)
      DEN=DEN*(AI+3.0)
      ENRUL(I)=ENRUL(I)/DEN
      ENRTL(I)=2.0*ENRUL(I)
 2000 CONTINUE
C
C     COMPUTE THE EXPECTED NUMBER OF RUNS UP OF LENGTH I OR MORE =
C     THE EXPECTED NUMBER OF RUNS DOWN OF LENGTH I OR MORE =
C     ONE HALF THE EXPECTED NUMBER OF RUNS TOTAL OF LENGTH I OR MORE
C
      DEN=2.0
      DO2100I=1,15
      AI=I
      ENRULG(I)=AN*(AI+1.0)-(AI*AI+AI-1.0)
      DEN=DEN*(AI+2.0)
      ENRULG(I)=ENRULG(I)/DEN 
      ENRTLG(I)=2.0*ENRULG(I) 
 2100 CONTINUE
C
C     COMPUTE THE STANDARD DEV. OF THE NUMBER OF RUNS UP OF LENGTH EXACTLY I =
C     THE STANDARD DEV. OF THE NUMBER OF RUNS DOWN OF LENGTH EXACTLY I =
C     SQRT(0.5)* THE STAND. DEV. OF THE NUMBER OF RUNS TOTAL OF LENGTH EXACTLY I
C
      DO2500I=1,15
      SNRTL(I)=SQRT(C1(I)*AN+C2(I))
      SNRUL(I)=SQRT(0.5)*SNRTL(I)
 2500 CONTINUE
C
C     COMPUTE THE STAND. DEV. OF THE NUMBER OF RUNS UP OF LENGTH I OR MORE =
C     THE STAND. DEV. OF THE NUMBER OF RUNS DOWN OF LENGTH I OR MORE =
C     SQRT(0.5)* THE STAND. DEV. OF THE NUMBER OF RUNS TOTAL OF LENGTH I OR MORE
C
      DO2600I=1,15
      SNRTLG(I)=SQRT(C3(I)*AN+C4(I))
      SNRULG(I)=SQRT(0.5)*SNRTLG(I)
 2600 CONTINUE
C
C     FORM Z STATISTICS
C
      DO3100I=1,15
      STAT=NRUL(I)
      ZNRUL(I)=(STAT   -ENRUL(I))/SNRUL(I)
      STAT=NRDL(I)
      ZNRDL(I)=(STAT   -ENRUL(I))/SNRUL(I)
      STAT=NRTL(I)
      ZNRTL(I)=(STAT   -ENRTL(I))/SNRTL(I)
      STAT=NRULG(I) 
      ZNRULG(I)=(STAT    -ENRULG(I))/SNRULG(I)
      STAT=NRDLG(I) 
      ZNRDLG(I)=(STAT    -ENRULG(I))/SNRULG(I)
      STAT=NRTLG(I) 
      ZNRTLG(I)=(STAT    -ENRTLG(I))/SNRTLG(I)
 3100 CONTINUE
C
      DO3200I=1,15
      ANRUL(I)=NRUL(I)
      ANRDL(I)=NRDL(I)
      ANRTL(I)=NRTL(I)
      ANRULG(I)=NRULG(I)
      ANRDLG(I)=NRDLG(I)
      ANRTLG(I)=NRTLG(I)
 3200 CONTINUE
C
C     WRITE EVERYTHING OUT
C
      IMAX=15
      WRITE(IPR,998)
      WRITE(IPR,4002)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(IPR,4004)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(IPR,4006)
      WRITE(IPR,999)
      DO4050I=1,IMAX
      WRITE(IPR,4060)I,ANRUL(I),ENRUL(I),SNRUL(I),ZNRUL(I)
 4050 CONTINUE
      WRITE(6,999)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(IPR,4064)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(IPR,4006)
      WRITE(IPR,999)
      DO4070I=1,IMAX
      WRITE(IPR,4060)I,ANRULG(I),ENRULG(I),SNRULG(I),ZNRULG(I)
 4070 CONTINUE
      WRITE(IPR,998)
      WRITE(IPR,4102)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(IPR,4104)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(IPR,4006)
      WRITE(IPR,999)
      DO4150I=1,IMAX
      WRITE(IPR,4060)I,ANRDL(I),ENRUL(I),SNRUL(I),ZNRDL(I)
 4150 CONTINUE
      WRITE(6,999)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(IPR,4164)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(IPR,4006)
      WRITE(IPR,999)
      DO4170I=1,IMAX
      WRITE(IPR,4060)I,ANRDLG(I),ENRULG(I),SNRULG(I),ZNRDLG(I)
 4170 CONTINUE
      WRITE(IPR,998)
      WRITE(IPR,4202)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(IPR,4204)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(IPR,4006)
      WRITE(IPR,999)
      DO4250I=1,IMAX
      WRITE(IPR,4060)I,ANRTL(I),ENRTL(I),SNRTL(I),ZNRTL(I)
 4250 CONTINUE
      WRITE(6,999)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(IPR,4264)
      WRITE(6,999)
      WRITE(6,999)
      WRITE(IPR,4006)
      WRITE(IPR,999)
      DO4270I=1,IMAX
      WRITE(IPR,4060)I,ANRTLG(I),ENRTLG(I),SNRTLG(I),ZNRTLG(I)
 4270 CONTINUE
      WRITE(IPR,998)
      WRITE(IPR,4601)MAXLNU
      WRITE(IPR,4602)MAXLND
      WRITE(IPR,4603)MAXLNT
      WRITE(IPR,999)
      WRITE(IPR,4611)NPOS
      WRITE(IPR,4612)NNEG
      WRITE(IPR,4613)NZER
 4002 FORMAT(1H ,48X,7HRUNS UP)
 4102 FORMAT(1H ,48X,9HRUNS DOWN)
 4202 FORMAT(1H ,40X,32HRUNS TOTAL = RUNS UP + RUNS DOWN)
 4004 FORMAT(1H ,27X,52HSTATISTIC = NUMBER OF RUNS UP    OF LENGTH EXACT
     1LY I)
 4104 FORMAT(1H ,27X,52HSTATISTIC = NUMBER OF RUNS DOWN  OF LENGTH EXACT
     1LY I)
 4204 FORMAT(1H ,27X,52HSTATISTIC = NUMBER OF RUNS TOTAL OF LENGTH EXACT
     1LY I)
 4064 FORMAT(1H ,27X,52HSTATISTIC = NUMBER OF RUNS UP    OF LENGTH I OR
     1MORE)
 4164 FORMAT(1H ,27X,52HSTATISTIC = NUMBER OF RUNS DOWN  OF LENGTH I OR
     1MORE)
 4264 FORMAT(1H ,27X,52HSTATISTIC = NUMBER OF RUNS TOTAL OF LENGTH I OR
     1MORE)
 4006 FORMAT(1H ,105HI = LENGTH OF RUN         VALUE OF STAT        EXP(
     1STAT)            SD(STAT)    (STAT-EXP(STAT))/SD(STAT))
 4060 FORMAT(1H ,4X,I4,13X,6X,F7.1,13X,F8.4,12X,F8.4,11X,F8.2)
 4601 FORMAT(1H ,39HLENGTH OF THE LONGEST RUN UP         = ,I5)
 4602 FORMAT(1H ,39HLENGTH OF THE LONGEST RUN DOWN       = ,I5)
 4603 FORMAT(1H ,39HLENGTH OF THE LONGEST RUN UP OR DOWN = ,I5)
 4611 FORMAT(1H ,33HNUMBER OF POSITIVE DIFFERENCES = ,I5)
 4612 FORMAT(1H ,33HNUMBER OF NEGATIVE DIFFERENCES = ,I5)
 4613 FORMAT(1H ,33HNUMBER OF ZERO     DIFFERENCES = ,I5)
 4010 FORMAT(1H ,2(I4,2X,F7.1,2X,F8.4,2X,F8.4,2X,F8.2,8X))
 4605 FORMAT(1H ,I6,2X,I6,2X,I6)
  998 FORMAT(1H1)
  999 FORMAT(1H )
      RETURN
      END 
      SUBROUTINE SAMPP(X,N,P,IWRITE,PP) 
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT SAMPP
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SAMPLE 100P PERCENT POINT
C              (WHERE P IS BETWEEN 0.0 AND 1.0, EXCLUSIVELY)
C              OF THE DATA IN THE INPUT VECTOR X. 
C              THE SAMPLE 100P PERCENT POINT =  IS THAT POINT IN WHICH
C              100P PERCENT OF THE DATA IN THE SAMPLE IS BELOW.
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                     --P      = THE SINGLE PRECISION FRACTION VALUE
C                                (BETWEEN 0.0 AND 1.0, EXCLUSIVELY)
C                                WHICH DEFINES THE DESIRED PERCENT
C                                POINT TO BE COMPUTED.
C                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SAMPLE 100P PERCENT POINT
C                                AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SAMPLE 100P PERCENT POINT
C                                AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--PP     = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE 100P PERCENT POINT.
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE 100P PERCENT POINT.
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 15000. 
C                 --THE INPUT ARGUMENTS N AND P SHOULD BE SUCH THAT
C                   THE PRODUCT OF N+1 AND P IS NOT SMALLER THAN 1 NOR
C                   LARGER THAN N.  THIS RESTRICTION IS DUE TO THE
C                   INTRINSIC DIFFICULTY OF ESTIMATING
C                   SAMPLE PERCENT POINTS SMALLER THAN THE OBSERVED
C                   SAMPLE MINIMUM OR LARGER THAN THE OBSERVED
C                   SAMPLE MAXIMUM.
C                   IF (N+1)P IS SMALLER THAN 1, AN ERROR MESSAGE WILL
C                   BE PRINTED OUT AND PP WILL BE SET TO -999999999.0 
C                   IF(N+1)P IS LARGER THAN N, AN ERROR MESSAGE WILL
C                   BE PRINTED OUT AND PP WILL BE SET TO 999999999.0. 
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 236-239,
C                 243.
C               --MOOD AND GRABLE, 'INTRODUCTION TO THE THEORY
C                 OF STATISTICS, EDITION 2, 1963, PAGES 406-407.
C               --SNEDECOR AND COCHRAN, STATISTICAL METHODS,
C                 EDITION 6, 1967, PAGE 125.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--DECEMBER  1974. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(15000)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1))
C
      IPR=6
      IUPPER=15000
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      AN=N
      ANP1=N+1
      AJ=P*ANP1
      J=AJ
      JP1=J+1
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      IF(J.LT.1)GOTO60
      IF(JP1.GT.N)GOTO65
      HOLD=X(1)
      DO70I=2,N
      IF(X(I).NE.HOLD)GOTO90
   70 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      PP=X(1)
      RETURN
   60 WRITE(IPR,48) 
      WRITE(IPR,51)N,P
      PP=-999999999.0
      RETURN
   65 WRITE(IPR,49) 
      WRITE(IPR,51)N,P
      PP=999999999.0
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE SAMPP  SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 SAMPP  SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE SAMPP  SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
   48 FORMAT(1H ,48HTHE THIRD INPUT ARGUMENT IS SMALLER THAN 1/(N+1), 
     1 32H = 1/(SECOND INPUT ARGUMENT + 1))
   49 FORMAT(1H ,47HTHE THIRD INPUT ARGUMENT IS LARGER THAN N/(N+1),
     1 54H = (SECOND INPUT ARGUMENT)/(SECOND INPUT ARGUMENT + 1))
   51 FORMAT(1H ,46H*****THE VALUE OF THE SECOND INPUT ARGUMENT = ,I8,
     142H  THE VALUE OF THE THIRD INPUT ARGUMENT = ,E20.10,5H*****)
C
C-----START POINT-----------------------------------------------------
C
      CALL SORT(X,N,Y)
C
      AJINT=J
      W=1.0-(AJ-AJINT)
      PP=W*Y(J)+(1.0-W)*Y(JP1)
C
      HUNP=100.0*P
      IF(IWRITE.EQ.0)RETURN
      WRITE(IPR,205)HUNP,N,PP 
  205 FORMAT(1H ,14HTHE EMPIRICAL ,F9.5,22H PERCENT POINT OF THE ,
     1  I6,17H OBSERVATIONS IS ,F16.7)
C
      RETURN
      END 
      SUBROUTINE SCALE(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT SCALE
C
C     PURPOSE--THIS SUBROUTINE COMPUTES 4 ESTIMATES OF THE
C              SCALE (VARIATION, SCATTER, DISPERSION)
C              OF THE DATA IN THE INPUT VECTOR X. 
C              THE 4 ESTIMATORS EMPLOYED ARE--
C              1) THE SAMPLE RANGE;
C              2) THE SAMPLE STANDARD DEVIATION;
C              3) THE SAMPLE RELATIVE STANDARD DEVIATION; AND
C              4) THE SAMPLE VARIANCE.
C              NOTE THAT N-1 (RATHER THAN N)
C              IS USED IN THE DIVISOR IN THE
C              COMPUTATION OF THE SAMPLE STANDARD 
C              DEVIATION, THE SAMPLE RELATIVE
C              STANDARD DEVIATION, AND THE
C              SAMPLE VARIANCE.
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--1/4 PAGE OF AUTOMATIC OUTPUT
C             CONSISTING OF THE FOLLOWING 4
C             ESTIMATES OF SCALE
C             FOR THE DATA IN THE INPUT VECTOR X--
C             1) THE SAMPLE RANGE;
C             2) THE SAMPLE STANDARD DEVIATION;
C             3) THE SAMPLE RELATIVE STANDARD DEVIATION; AND
C             4) THE SAMPLE VARIANCE.
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--THE SAMPLE RELATIVE STANDARD DEVIATION
C              IS THE SAMPLE STANDARD DEVIATION RELATIVE
C              TO THE MAGNITUDE OF THE SAMPLE MEAN.
C              THE RELATIVE SAMPLE STANDARD DEVIATION
C              IS EXPRESSED AS A PERCENT.
C              THE RELATIVE SAMPLE STANDARD DEVIATION
C              IS EQUIVALENTLY CALLED THE
C              SAMPLE COEFFICIENT OF VARIATION.
C     REFERENCES--DIXON AND MASSEY, PAGES 19 AND 21
C               --SNEDECOR AND COCHRAN, PAGE 62
C               --DIXON AND MASSEY, PAGES 14, 70, AND 71
C               --CROW, JOURNAL OF THE AMERICAN STATISTICAL ASSOCIATION,
C                 PAGES 357 AND 387
C               --KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 1, EDITION 2, 1963, PAGE 8.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      XRANGE=0.0
      XSD=0.0
      XRELSD=0.0
      XVAR=0.0
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XRANGE=0.0
      XSD=0.0
      XRELSD=0.0
      GOTO301
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE SCALE  SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 SCALE  SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE SCALE  SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     DETERMINE THE SAMPLE MINIMUM AND THE SAMPLE MAXIMUM,
C     THEN COMPUTE THE SAMPLE RANGE.
C
      XMIN=X(1)
      XMAX=X(1)
      DO100I=1,N
      IF(X(I).LT.XMIN)XMIN=X(I)
      IF(X(I).GT.XMAX)XMAX=X(I)
  100 CONTINUE
      XRANGE=XMAX-XMIN
C
C     COMPUTE THE SAMPLE VARIANCE,
C     AND THEN THE SAMPLE STANDARDD DEVIATION.
C
      SUM=0.0
      DO150I=1,N
      SUM=SUM+X(I)
  150 CONTINUE
      XMEAN=SUM/AN
      SUM=0.0
      DO200I=1,N
      SUM=SUM+(X(I)-XMEAN)**2 
  200 CONTINUE
      XVAR=SUM/(AN-1.0)
      XSD=SQRT(XVAR)
C
C     COMPUTE THE SAMPLE RELATIVE STANDARD DEVIATION;
C     THAT IS, THE SAMPLE STANDARD DEVIATION RELATIVE
C     TO THE MAGNITUDE OF THE SAMPLE MEAN.
C     THE RESULTING SAMPLE STANDARD DEVIATION IS EXPRESSED
C     AS A PERCENT. 
C
      XRELSD=100.0*XSD/XMEAN
      IF(XRELSD.LT.0.0)XRELSD=-XRELSD
C
C     WRITE EVERYTHING OUT
C
  301 DO300I=1,5
      WRITE(IPR,999)
  300 CONTINUE
      WRITE(IPR,305)
      WRITE(IPR,999)
      WRITE(IPR,310)N
      WRITE(IPR,999)
      WRITE(IPR,999)
      WRITE(IPR,315)XRANGE
      WRITE(IPR,320)XSD
      WRITE(IPR,325)XVAR
      WRITE(IPR,330)XRELSD
C
  305 FORMAT(1H ,30X,32HESTIMATES OF THE SCALE PARAMETER)
  310 FORMAT(1H ,34X,21H(THE SAMPLE SIZE N = ,I5,1H))
  315 FORMAT(1H ,42HTHE SAMPLE RANGE IS                       ,E15.8) 
  320 FORMAT(1H ,42HTHE SAMPLE STANDARD DEVIATION IS          ,E15.8) 
  325 FORMAT(1H ,42HTHE SAMPLE VARIANCE IS                    ,E15.8) 
  330 FORMAT(1H ,42HTHE SAMPLE RELATIVE STANDARD DEVIATION IS ,E15.8,8H
     1PERCENT)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE SD(X,N,IWRITE,XSD)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT SD
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SAMPLE STANDARD DEVIATION (WITH DENOMINATOR N-1)
C              OF THE DATA IN THE INPUT VECTOR X. 
C              THE SAMPLE STANDARD DEVIATION = SQRT((THE SUM OF THE
C              SQUARED DEVIATIONS ABOUT THE SAMPLE MEAN)/(N-1)).
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                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SAMPLE STANDARD DEVIATION
C                                AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SAMPLE STANDARD DEVIATION
C                                AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--XSD    = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE STANDARD DEVIATION.
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE STANDARD DEVIATION (WITH DENOMINATOR N-1).
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--SNEDECOR AND COCHRAN, STATISTICAL METHODS,
C                 EDITION 6, 1967, PAGE 44.
C               --DIXON AND MASSEY, INTRODUCTION TO STATISTICAL
C                 ANALYSIS, EDITION 2, 1957, PAGES 19, 76.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      AN=N
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      XSD=0.0
      GOTO201
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XSD=0.0
      GOTO201
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE SD     SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 SD     SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE SD     SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      SUM=0.0
      DO100I=1,N
      SUM=SUM+X(I)
  100 CONTINUE
      XMEAN=SUM/AN
      SUM=0.0
      DO200I=1,N
      SUM=SUM+(X(I)-XMEAN)**2 
  200 CONTINUE
      VAR=SUM/(AN-1.0)
      XSD=SQRT(VAR) 
C
  201 IF(IWRITE.EQ.0)RETURN
      WRITE(IPR,999)
      WRITE(IPR,205)N,XSD
  205 FORMAT(1H ,37HTHE SAMPLE STANDARD DEVIATION OF THE ,I6,17H OBSERVA
     1TIONS IS ,E15.8)
  999 FORMAT(1H )
      RETURN
      END 
      SUBROUTINE SKIPR(NLHEAD)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT SKIPR
C
C     PURPOSE--THIS SUBROUTINE READS THROUGH (SKIPS OVER)
C              NLHEAD LINES FROM INPUT UNIT = 5.
C              IF HEADER INFORMATION EXISTS AT THE
C              BEGINNING OF A DATA FILE, THIS SUBROUTINE
C              IS CONVENIENT FOR READING THROUGH
C              (SKIPPING OVER) THAT HEADER INFORMATION.
C     INPUT  ARGUMENTS--NLHEAD = THE INTEGER NUMBER OF CARD 
C                                IMAGES TO BE READ THROUGH
C                                (SKIPPED OVER).
C     OUTPUT--NONE. 
C     PRINTING--NO. 
C     RESTRICTIONS--NLHEAD IS A NON-NEGATIVE INTEGER VARIABLE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--INTEGER.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --MAY       1976. 
C     UPDATED         --OCTOBER   1976. 
C
C---------------------------------------------------------------------
C
      IRD=5
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(NLHEAD.LT.0)GOTO55
      GOTO90
   55 WRITE(IPR,8)
      WRITE(IPR,47)NLHEAD
      RETURN
   90 CONTINUE
    8 FORMAT(1H , 87H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 SKIPR  SUBROUTINE IS NEGATIVE *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
C     SKIP OVER THE HEADER LABEL
C
      IF(NLHEAD.EQ.0)RETURN
      DO100I=1,NLHEAD
      READ(IRD,105)IA
  105 FORMAT(A1)
  100 CONTINUE
C
      RETURN
      END 
      SUBROUTINE SORT(X,N,Y)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT SORT
C
C     PURPOSE--THIS SUBROUTINE SORTS (IN ASCENDING ORDER)
C              THE N ELEMENTS OF THE SINGLE PRECISION VECTOR X
C              AND PUTS THE RESULTING N SORTED VALUES INTO THE
C              SINGLE PRECISION VECTOR Y.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                                OBSERVATIONS TO BE SORTED. 
C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR X. 
C     OUTPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR
C                                INTO WHICH THE SORTED DATA VALUES
C                                FROM X WILL BE PLACED.
C     OUTPUT--THE SINGLE PRECISION VECTOR Y
C             CONTAINING THE SORTED
C             (IN ASCENDING ORDER) VALUES
C             OF THE SINGLE PRECISION VECTOR X.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--THE DIMENSIONS OF THE VECTORS IL AND IU 
C                   (DEFINED AND USED INTERNALLY WITHIN
C                   THIS SUBROUTINE) DICTATE THE MAXIMUM
C                   ALLOWABLE VALUE OF N FOR THIS SUBROUTINE.
C                   IF IL AND IU EACH HAVE DIMENSION K,
C                   THEN N MAY NOT EXCEED 2**(K+1) - 1.
C                   FOR THIS SUBROUTINE AS WRITTEN, THE DIMENSIONS
C                   OF IL AND IU HAVE BEEN SET TO 36,
C                   THUS THE MAXIMUM ALLOWABLE VALUE OF N IS
C                   APPROXIMATELY 137 BILLION.
C                   SINCE THIS EXCEEDS THE MAXIMUM ALLOWABLE
C                   VALUE FOR AN INTEGER VARIABLE IN MANY COMPUTERS,
C                   AND SINCE A SORT OF 137 BILLION ELEMENTS
C                   IS PRESENTLY IMPRACTICAL AND UNLIKELY,
C                   THEN THERE IS NO PRACTICAL RESTRICTION
C                   ON THE MAXIMUM VALUE OF N FOR THIS SUBROUTINE.
C                   (IN LIGHT OF THE ABOVE, NO CHECK OF THE 
C                   UPPER LIMIT OF N HAS BEEN INCORPORATED
C                   INTO THIS SUBROUTINE.)
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--THE SMALLEST ELEMENT OF THE VECTOR X
C              WILL BE PLACED IN THE FIRST POSITION
C              OF THE VECTOR Y,
C              THE SECOND SMALLEST ELEMENT IN THE VECTOR X
C              WILL BE PLACED IN THE SECOND POSITION
C              OF THE VECTOR Y, ETC.
C     COMMENT--THE INPUT VECTOR X REMAINS UNALTERED.
C     COMMENT--IF THE ANALYST DESIRES A SORT 'IN PLACE',
C              THIS IS DONE BY HAVING THE SAME
C              OUTPUT VECTOR AS INPUT VECTOR IN THE CALLING SEQUENCE. 
C              THUS, FOR EXAMPLE, THE CALLING SEQUENCE
C              CALL SORT(X,N,X)
C              IS ALLOWABLE AND WILL RESULT IN
C              THE DESIRED 'IN-PLACE' SORT.
C     COMMENT--THE SORTING ALGORTHM USED HEREIN
C              IS THE BINARY SORT.
C              THIS ALGORTHIM IS EXTREMELY FAST AS THE
C              FOLLOWING TIME TRIALS INDICATE.
C              THESE TIME TRIALS WERE CARRIED OUT ON THE
C              UNIVAC 1108 EXEC 8 SYSTEM AT NBS
C              IN AUGUST OF 1974.
C              BY WAY OF COMPARISON, THE TIME TRIAL VALUES
C              FOR THE EASY-TO-PROGRAM BUT EXTREMELY
C              INEFFICIENT BUBBLE SORT ALGORITHM HAVE
C              ALSO BEEN INCLUDED--
C              NUMBER OF RANDOM        BINARY SORT       BUBBLE SORT
C               NUMBERS SORTED
C                N = 10                 .002 SEC          .002 SEC
C                N = 100                .011 SEC          .045 SEC
C                N = 1000               .141 SEC         4.332 SEC
C                N = 3000               .476 SEC        37.683 SEC
C                N = 10000             1.887 SEC      NOT COMPUTED
C     REFERENCES--CACM MARCH 1969, PAGE 186 (BINARY SORT ALGORITHM
C                 BY RICHARD C. SINGLETON).
C               --CACM JANUARY 1970, PAGE 54.
C               --CACM OCTOBER 1970, PAGE 624.
C               --JACM JANUARY 1961, PAGE 41.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1),Y(1)
      DIMENSION IU(36),IL(36) 
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      DO61I=1,N
      Y(I)=X(I)
   61 CONTINUE
      RETURN
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      Y(1)=X(1)
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE SORT   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 SORT   SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE SORT   SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
C     COPY THE VECTOR X INTO THE VECTOR Y
      DO100I=1,N
      Y(I)=X(I)
  100 CONTINUE
C
C     CHECK TO SEE IF THE INPUT VECTOR IS ALREADY SORTED
C
      NM1=N-1
      DO200I=1,NM1
      IP1=I+1
      IF(Y(I).LE.Y(IP1))GOTO200
      GOTO250
  200 CONTINUE
      RETURN
  250 M=1 
      I=1 
      J=N 
  305 IF(I.GE.J)GOTO370
  310 K=I 
      MID=(I+J)/2
      AMED=Y(MID)
      IF(Y(I).LE.AMED)GOTO320 
      Y(MID)=Y(I)
      Y(I)=AMED
      AMED=Y(MID)
  320 L=J 
      IF(Y(J).GE.AMED)GOTO340 
      Y(MID)=Y(J)
      Y(J)=AMED
      AMED=Y(MID)
      IF(Y(I).LE.AMED)GOTO340 
      Y(MID)=Y(I)
      Y(I)=AMED
      AMED=Y(MID)
      GOTO340
  330 Y(L)=Y(K)
      Y(K)=TT
  340 L=L-1
      IF(Y(L).GT.AMED)GOTO340 
      TT=Y(L)
  350 K=K+1
      IF(Y(K).LT.AMED)GOTO350 
      IF(K.LE.L)GOTO330
      LMI=L-I
      JMK=J-K
      IF(LMI.LE.JMK)GOTO360
      IL(M)=I
      IU(M)=L
      I=K 
      M=M+1
      GOTO380
  360 IL(M)=K
      IU(M)=J
      J=L 
      M=M+1
      GOTO380
  370 M=M-1
      IF(M.EQ.0)RETURN
      I=IL(M)
      J=IU(M)
  380 JMI=J-I
      IF(JMI.GE.11)GOTO310
      IF(I.EQ.1)GOTO305
      I=I-1
  390 I=I+1
      IF(I.EQ.J)GOTO370
      AMED=Y(I+1)
      IF(Y(I).LE.AMED)GOTO390 
      K=I 
  395 Y(K+1)=Y(K)
      K=K-1
      IF(AMED.LT.Y(K))GOTO395 
      Y(K+1)=AMED
      GOTO390
      END 
      SUBROUTINE SORTC(X,Y,N,XS,YC)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT SORTC
C
C     PURPOSE--THIS SUBROUTINE SORTS (IN ASCENDING ORDER)
C              THE N ELEMENTS OF THE SINGLE PRECISION VECTOR X,
C              PUTS THE RESULTING N SORTED VALUES INTO THE
C              SINGLE PRECISION VECTOR XS,
C              REARRANGES THE ELEMENTS OF THE VECTOR Y
C              (ACCORDING TO THE SORT ON X),
C              AND PUTS THE REARRANGED Y VALUES
C              INTO THE SINGLE PRECISION VECTOR YC.
C              THIS SUBROUTINE GIVES THE DATA ANALYST
C              THE ABILITY TO SORT ONE DATA VECTOR
C              WHILE 'CARRYING ALONG' THE ELEMENTS
C              OF A SECOND DATA VECTOR. 
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                                OBSERVATIONS TO BE SORTED. 
C                     --Y      = THE SINGLE PRECISION VECTOR OF
C                                OBSERVATIONS TO BE 'CARRIED ALONG',
C                                THAT IS, TO BE REARRANGED ACCORDING
C                                TO THE SORT ON X.
C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR X. 
C     OUTPUT ARGUMENTS--XS     = THE SINGLE PRECISION VECTOR
C                                INTO WHICH THE SORTED DATA VALUES
C                                FROM X WILL BE PLACED.
C                     --YC     = THE SINGLE PRECISION VECTOR
C                                INTO WHICH THE REARRANGED
C                                (ACCORDING TO THE SORT OF THE
C                                VECTOR X) VALUES OF THE VECTOR Y
C                                WILL BE PLACED.
C     OUTPUT--THE SINGLE PRECISION VECTOR XS
C             CONTAINING THE SORTED
C             (IN ASCENDING ORDER) VALUES
C             OF THE SINGLE PRECISION VECTOR X, AND
C             THE SINGLE PRECISION VECTOR YC
C             CONTAINING THE REARRANGED 
C             (ACCORDING TO THE SORT ON X)
C             VALUES OF THE VECTOR Y.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--THE DIMENSIONS OF THE VECTORS IL AND IU 
C                   (DEFINED AND USED INTERNALLY WITHIN
C                   THIS SUBROUTINE) DICTATE THE MAXIMUM
C                   ALLOWABLE VALUE OF N FOR THIS SUBROUTINE.
C                   IF IL AND IU EACH HAVE DIMENSION K,
C                   THEN N MAY NOT EXCEED 2**(K+1) - 1.
C                   FOR THIS SUBROUTINE AS WRITTEN, THE DIMENSIONS
C                   OF IL AND IU HAVE BEEN SET TO 36,
C                   THUS THE MAXIMUM ALLOWABLE VALUE OF N IS
C                   APPROXIMATELY 137 BILLION.
C                   SINCE THIS EXCEEDS THE MAXIMUM ALLOWABLE
C                   VALUE FOR AN INTEGER VARIABLE IN MANY COMPUTERS,
C                   AND SINCE A SORT OF 137 BILLION ELEMENTS
C                   IS PRESENTLY IMPRACTICAL AND UNLIKELY,
C                   THEN THERE IS NO PRACTICAL RESTRICTION
C                   ON THE MAXIMUM VALUE OF N FOR THIS SUBROUTINE.
C                   (IN LIGHT OF THE ABOVE, NO CHECK OF THE 
C                   UPPER LIMIT OF N HAS BEEN INCORPORATED
C                   INTO THIS SUBROUTINE.)
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--THE SMALLEST ELEMENT OF THE VECTOR X
C              WILL BE PLACED IN THE FIRST POSITION
C              OF THE VECTOR XS,
C              THE SECOND SMALLEST ELEMENT IN THE VECTOR X
C              WILL BE PLACED IN THE SECOND POSITION
C              OF THE VECTOR XS,
C              ETC. 
C     COMMENT--THE ELEMENT IN THE VECTOR Y CORRESPONDING
C              TO THE SMALLEST ELEMENT IN X
C              WILL BE PLACED IN THE FIRST POSITION
C              OF THE VECTOR YC,
C              THE ELEMENT IN THE VECTOR Y CORRESPONDING
C              TO THE SECOND SMALLEST ELEMENT IN X
C              WILL BE PLACED IN THE SECOND POSITION
C              OF THE VECTOR YC,
C              ETC. 
C     COMMENT--THE INPUT VECTOR X REMAINS UNALTERED.
C     COMMENT--IF THE ANALYST DESIRES A SORT 'IN PLACE',
C              THIS IS DONE BY HAVING THE SAME
C              OUTPUT VECTOR AS INPUT VECTOR IN THE CALLING SEQUENCE. 
C              THUS, FOR EXAMPLE, THE CALLING SEQUENCE
C              CALL SORTC(X,Y,N,X,YC)
C              IS ALLOWABLE AND WILL RESULT IN
C              THE DESIRED 'IN-PLACE' SORT.
C     COMMENT--THE SORTING ALGORTHM USED HEREIN
C              IS THE BINARY SORT.
C              THIS ALGORTHIM IS EXTREMELY FAST AS THE
C              FOLLOWING TIME TRIALS INDICATE.
C              THESE TIME TRIALS WERE CARRIED OUT ON THE
C              UNIVAC 1108 EXEC 8 SYSTEM AT NBS
C              IN AUGUST OF 1974.
C              BY WAY OF COMPARISON, THE TIME TRIAL VALUES
C              FOR THE EASY-TO-PROGRAM BUT EXTREMELY
C              INEFFICIENT BUBBLE SORT ALGORITHM HAVE
C              ALSO BEEN INCLUDED--
C              NUMBER OF RANDOM        BINARY SORT       BUBBLE SORT
C               NUMBERS SORTED
C                N = 10                 .002 SEC          .002 SEC
C                N = 100                .011 SEC          .045 SEC
C                N = 1000               .141 SEC         4.332 SEC
C                N = 3000               .476 SEC        37.683 SEC
C                N = 10000             1.887 SEC      NOT COMPUTED
C     REFERENCES--CACM MARCH 1969, PAGE 186 (BINARY SORT ALGORITHM
C                 BY RICHARD C. SINGLETON).
C               --CACM JANUARY 1970, PAGE 54.
C               --CACM OCTOBER 1970, PAGE 624.
C               --JACM JANUARY 1961, PAGE 41.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1),Y(1),XS(1),YC(1)
      DIMENSION IU(36),IL(36) 
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IPR=6
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      DO61I=1,N
      XS(I)=X(I)
      YC(I)=Y(I)
   61 CONTINUE
      RETURN
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XS(1)=X(1)
      YC(1)=Y(1)
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE SORTC  SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 SORTC  SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE SORTC  SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
C     COPY THE VECTOR X INTO THE VECTOR XS
      DO100I=1,N
      XS(I)=X(I)
  100 CONTINUE
C
C     COPY THE VECTOR Y INTO THE VECTOR YS
C
      DO150I=1,N
      YC(I)=Y(I)
  150 CONTINUE
C
C     CHECK TO SEE IF THE INPUT VECTOR IS ALREADY SORTED
C
      NM1=N-1
      DO200I=1,NM1
      IP1=I+1
      IF(XS(I).LE.XS(IP1))GOTO200
      GOTO250
  200 CONTINUE
      RETURN
  250 M=1 
      I=1 
      J=N 
  305 IF(I.GE.J)GOTO370
  310 K=I 
      MID=(I+J)/2
      AMED=XS(MID)
      BMED=YC(MID)
      IF(XS(I).LE.AMED)GOTO320
      XS(MID)=XS(I) 
      YC(MID)=YC(I) 
      XS(I)=AMED
      YC(I)=BMED
      AMED=XS(MID)
      BMED=YC(MID)
  320 L=J 
      IF(XS(J).GE.AMED)GOTO340
      XS(MID)=XS(J) 
      YC(MID)=YC(J) 
      XS(J)=AMED
      YC(J)=BMED
      AMED=XS(MID)
      BMED=YC(MID)
      IF(XS(I).LE.AMED)GOTO340
      XS(MID)=XS(I) 
      YC(MID)=YC(I) 
      XS(I)=AMED
      YC(I)=BMED
      AMED=XS(MID)
      BMED=YC(MID)
      GOTO340
  330 XS(L)=XS(K)
      YC(L)=YC(K)
      XS(K)=TX
      YC(K)=TY
  340 L=L-1
      IF(XS(L).GT.AMED)GOTO340
      TX=XS(L)
      TY=YC(L)
  350 K=K+1
      IF(XS(K).LT.AMED)GOTO350
      IF(K.LE.L)GOTO330
      LMI=L-I
      JMK=J-K
      IF(LMI.LE.JMK)GOTO360
      IL(M)=I
      IU(M)=L
      I=K 
      M=M+1
      GOTO380
  360 IL(M)=K
      IU(M)=J
      J=L 
      M=M+1
      GOTO380
  370 M=M-1
      IF(M.EQ.0)RETURN
      I=IL(M)
      J=IU(M)
  380 JMI=J-I
      IF(JMI.GE.11)GOTO310
      IF(I.EQ.1)GOTO305
      I=I-1
  390 I=I+1
      IF(I.EQ.J)GOTO370
      AMED=XS(I+1)
      BMED=YC(I+1)
      IF(XS(I).LE.AMED)GOTO390
      K=I 
  395 XS(K+1)=XS(K) 
      YC(K+1)=YC(K) 
      K=K-1
      IF(AMED.LT.XS(K))GOTO395
      XS(K+1)=AMED
      YC(K+1)=BMED
      GOTO390
      END 
      SUBROUTINE SORTP(X,N,Y,XPOS)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT SORTP
C
C     PURPOSE--THIS SUBROUTINE SORTS (IN ASCENDING ORDER)
C              THE N ELEMENTS OF THE SINGLE PRECISION VECTOR X,
C              PUTS THE RESULTING N SORTED VALUES INTO THE
C              SINGLE PRECISION VECTOR Y,
C              AND PUTS THE POSITION (IN THE ORIGINAL VECTOR X)
C              OF EACH OF THE SORTED VALUES.
C              INTO THE SINGLE PRECISION VECTOR XPOS.
C              THIS SUBROUTINE GIVES THE DATA ANALYST
C              NOT ONLY THE ABILITY TO DETERMINE
C              WHAT THE MIN AND MAX (FOR EXAMPLE) 
C              OF THE DATA SET ARE, BUT ALSO
C              WHERE IN THE ORIGINAL DATA SET
C              THE MIN AND MAX OCCUR.
C              THIS IS ESPECIALLY USEFUL FOR
C              LARGE DATA SETS.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                                OBSERVATIONS TO BE SORTED. 
C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR X. 
C     OUTPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR
C                                INTO WHICH THE SORTED DATA VALUES
C                                FROM X WILL BE PLACED.
C                     --XPOS   = THE SINGLE PRECISION VECTOR
C                                INTO WHICH THE POSITIONS
C                                (IN THE ORIGINAL VECTOR X) 
C                                OF THE SORTED VALUES
C                                WILL BE PLACED.
C     OUTPUT--THE SINGLE PRECISION VECTOR XS
C             CONTAINING THE SORTED
C             (IN ASCENDING ORDER) VALUES
C             OF THE SINGLE PRECISION VECTOR X, AND
C             THE SINGLE PRECISION VECTOR XPOS
C             CONTAINING THE POSITIONS
C             (IN THE ORIGINAL VECTOR X)
C             OF THE SORTED VALUES.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--THE DIMENSIONS OF THE VECTORS IL AND IU 
C                   (DEFINED AND USED INTERNALLY WITHIN
C                   THIS SUBROUTINE) DICTATE THE MAXIMUM
C                   ALLOWABLE VALUE OF N FOR THIS SUBROUTINE.
C                   IF IL AND IU EACH HAVE DIMENSION K,
C                   THEN N MAY NOT EXCEED 2**(K+1) - 1.
C                   FOR THIS SUBROUTINE AS WRITTEN, THE DIMENSIONS
C                   OF IL AND IU HAVE BEEN SET TO 36,
C                   THUS THE MAXIMUM ALLOWABLE VALUE OF N IS
C                   APPROXIMATELY 137 BILLION.
C                   SINCE THIS EXCEEDS THE MAXIMUM ALLOWABLE
C                   VALUE FOR AN INTEGER VARIABLE IN MANY COMPUTERS,
C                   AND SINCE A SORT OF 137 BILLION ELEMENTS
C                   IS PRESENTLY IMPRACTICAL AND UNLIKELY,
C                   THEN THERE IS NO PRACTICAL RESTRICTION
C                   ON THE MAXIMUM VALUE OF N FOR THIS SUBROUTINE.
C                   (IN LIGHT OF THE ABOVE, NO CHECK OF THE 
C                   UPPER LIMIT OF N HAS BEEN INCORPORATED
C                   INTO THIS SUBROUTINE.)
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--THE SMALLEST ELEMENT OF THE VECTOR X
C              WILL BE PLACED IN THE FIRST POSITION
C              OF THE VECTOR Y,
C              THE SECOND SMALLEST ELEMENT IN THE VECTOR X
C              WILL BE PLACED IN THE SECOND POSITION
C              OF THE VECTOR Y,
C              ETC. 
C     COMMENT--THE POSITION (1 THROUGH N) IN X
C              OF THE SMALLEST ELEMENT IN X
C              WILL BE PLACED IN THE FIRST POSITION
C              OF THE VECTOR XPOS,
C              THE POSITION (1 THROUGH N) IN X
C              OF THE SECOND SMALLEST ELEMENT IN X
C              WILL BE PLACED IN THE SECOND POSITION
C              OF THE VECTOR XPOS,
C              ETC. 
C              ALTHOUGH THESE POSITIONS ARE NECESSARILY
C              INTEGRAL VALUES FROM 1 TO N, IT IS TO BE
C              NOTED THAT THEY ARE OUTPUTED AS SINGLE
C              PRECISION INTEGERS IN THE SINGLE PRECISION
C              VECTOR XPOS.
C              XPOS IS SINGLE PRECISION SO AS TO BE
C              CONSISTENT WITH THE FACT THAT ALL
C              VECTOR ARGUMENTS IN ALL OTHER
C              DATAPAC SUBROUTINES ARE SINGLE PRECISION.
C     COMMENT--THE INPUT VECTOR X REMAINS UNALTERED.
C     COMMENT--IF THE ANALYST DESIRES A SORT 'IN PLACE',
C              THIS IS DONE BY HAVING THE SAME
C              OUTPUT VECTOR AS INPUT VECTOR IN THE CALLING SEQUENCE. 
C              THUS, FOR EXAMPLE, THE CALLING SEQUENCE
C              CALL SORTP(X,N,X,XPOS)
C              IS ALLOWABLE AND WILL RESULT IN
C              THE DESIRED 'IN-PLACE' SORT.
C     COMMENT--THE SORTING ALGORTHM USED HEREIN
C              IS THE BINARY SORT.
C              THIS ALGORTHIM IS EXTREMELY FAST AS THE
C              FOLLOWING TIME TRIALS INDICATE.
C              THESE TIME TRIALS WERE CARRIED OUT ON THE
C              UNIVAC 1108 EXEC 8 SYSTEM AT NBS
C              IN AUGUST OF 1974.
C              BY WAY OF COMPARISON, THE TIME TRIAL VALUES
C              FOR THE EASY-TO-PROGRAM BUT EXTREMELY
C              INEFFICIENT BUBBLE SORT ALGORITHM HAVE
C              ALSO BEEN INCLUDED--
C              NUMBER OF RANDOM        BINARY SORT       BUBBLE SORT
C               NUMBERS SORTED
C                N = 10                 .002 SEC          .002 SEC
C                N = 100                .011 SEC          .045 SEC
C                N = 1000               .141 SEC         4.332 SEC
C                N = 3000               .476 SEC        37.683 SEC
C                N = 10000             1.887 SEC      NOT COMPUTED
C     REFERENCES--CACM MARCH 1969, PAGE 186 (BINARY SORT ALGORITHM
C                 BY RICHARD C. SINGLETON).
C               --CACM JANUARY 1970, PAGE 54.
C               --CACM OCTOBER 1970, PAGE 624.
C               --JACM JANUARY 1961, PAGE 41.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1),Y(1),XPOS(1)
      DIMENSION IU(36),IL(36) 
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IPR=6
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      DO61I=1,N
      Y(I)=X(I)
      XPOS(I)=I
   61 CONTINUE
      RETURN
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      Y(1)=X(1)
      XPOS(1)=1.0
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE SORTP  SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 SORTP  SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE SORTP  SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
C     COPY THE VECTOR X INTO THE VECTOR Y
      DO100I=1,N
      Y(I)=X(I)
  100 CONTINUE
C
C     DEFINE THE XPOS (POSITION) VECTOR.  BEFORE SORTING, THIS WILL
C     BE A VECTOR WHOSE I-TH ELEMENT IS EQUAL TO I.
C
      DO150I=1,N
      XPOS(I)=I
  150 CONTINUE
C
C     CHECK TO SEE IF THE INPUT VECTOR IS ALREADY SORTED
C
      NM1=N-1
      DO200I=1,NM1
      IP1=I+1
      IF(Y(I).LE.Y(IP1))GOTO200
      GOTO250
  200 CONTINUE
      RETURN
  250 M=1 
      I=1 
      J=N 
  305 IF(I.GE.J)GOTO370
  310 K=I 
      MID=(I+J)/2
      AMED=Y(MID)
      BMED=XPOS(MID)
      IF(Y(I).LE.AMED)GOTO320 
      Y(MID)=Y(I)
      XPOS(MID)=XPOS(I)
      Y(I)=AMED
      XPOS(I)=BMED
      AMED=Y(MID)
      BMED=XPOS(MID)
  320 L=J 
      IF(Y(J).GE.AMED)GOTO340 
      Y(MID)=Y(J)
      XPOS(MID)=XPOS(J)
      Y(J)=AMED
      XPOS(J)=BMED
      AMED=Y(MID)
      BMED=XPOS(MID)
      IF(Y(I).LE.AMED)GOTO340 
      Y(MID)=Y(I)
      XPOS(MID)=XPOS(I)
      Y(I)=AMED
      XPOS(I)=BMED
      AMED=Y(MID)
      BMED=XPOS(MID)
      GOTO340
  330 Y(L)=Y(K)
      XPOS(L)=XPOS(K)
      Y(K)=TT
      XPOS(K)=ITT
  340 L=L-1
      IF(Y(L).GT.AMED)GOTO340 
      TT=Y(L)
      ITT=XPOS(L)
  350 K=K+1
      IF(Y(K).LT.AMED)GOTO350 
      IF(K.LE.L)GOTO330
      LMI=L-I
      JMK=J-K
      IF(LMI.LE.JMK)GOTO360
      IL(M)=I
      IU(M)=L
      I=K 
      M=M+1
      GOTO380
  360 IL(M)=K
      IU(M)=J
      J=L 
      M=M+1
      GOTO380
  370 M=M-1
      IF(M.EQ.0)RETURN
      I=IL(M)
      J=IU(M)
  380 JMI=J-I
      IF(JMI.GE.11)GOTO310
      IF(I.EQ.1)GOTO305
      I=I-1
  390 I=I+1
      IF(I.EQ.J)GOTO370
      AMED=Y(I+1)
      BMED=XPOS(I+1)
      IF(Y(I).LE.AMED)GOTO390 
      K=I 
  395 Y(K+1)=Y(K)
      XPOS(K+1)=XPOS(K)
      K=K-1
      IF(AMED.LT.Y(K))GOTO395 
      Y(K+1)=AMED
      XPOS(K+1)=BMED
      GOTO390
      END 
      SUBROUTINE SPCORR(X,Y,N,IWRITE,SPC)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT SPCORR
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SPEARMAN RANK CORRELATION COEFFICIENT
C              BETWEEN THE 2 SETS OF DATA IN THE INPUT VECTORS X AND Y.
C              THE SPEARMAN RANK CORRELATION COEFFICIENT WILL BE A
C              SINGLE PRECISION VALUE BETWEEN -1.0 AND 1.0
C              (INCLUSIVELY). 
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                                (UNSORTED OR SORTED) OBSERVATIONS
C                                WHICH CONSTITUTE THE FIRST SET
C                                OF DATA.
C                     --Y      = THE SINGLE PRECISION VECTOR OF
C                                (UNSORTED OR SORTED) OBSERVATIONS
C                                WHICH CONSTITUTE THE SECOND SET
C                                OF DATA.
C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR X, OR EQUIVALENTLY,
C                                THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR Y. 
C                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SPEARMAN RANK CORRELATION COEFFICIENT
C                                AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SPEARMAN CORRELATION COEFFICIENT
C                                AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--SPC    = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SPEARMAN RANK CORRELATION
C                                COEFFICIENT BETWEEN THE 2 SETS OF DATA
C                                IN THE INPUT VECTORS X AND Y.
C                                THIS SINGLE PRECISION VALUE
C                                WILL BE BETWEEN -1.0 AND 1.0
C                                (INCLUSIVELY).
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SPEARMAN RANK CORRELATION COEFFICIENT BETWEEN THE 2 SETS
C             OF DATA IN THE INPUT VECTORS X AND Y.
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C     OTHER DATAPAC   SUBROUTINES NEEDED--RANK AND SORT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 2, EDITION 1, 1961, PAGES 476-477.
C               --SNEDECOR AND COCHRAN, STATISTICAL METHODS,
C                 EDITION 6, 1967, PAGES 193-195. 
C               --DIXON AND MASSEY, INTRODUCTION TO STATISTICAL
C                 ANALYSIS, EDITION 2, 1957, PAGES 294-295. 
C               --MOOD AND GRABLE, 'INTRODUCTION TO THE THEORY
C                 OF STATISTICS, EDITION 2, 1963, PAGE 424. 
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --OCTOBER   1974. 
C     UPDATED         --JANUARY   1975. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1),Y(1)
      DIMENSION XR(7500),YR(7500)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (XR(1),WS(1)),(YR(1),WS(7501))
C
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      AN=N
      SPC=0.0
      IFLAG=0
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO65
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      IFLAG=1
   65 HOLD=Y(1)
      DO70I=2,N
      IF(Y(I).NE.HOLD)GOTO80
   70 CONTINUE
      WRITE(IPR,19)HOLD
      IFLAG=1
   80 IF(IFLAG.EQ.1)RETURN
      GOTO90
   50 WRITE(IPR,27)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,28) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE SPCORR SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   19 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT (A VECTOR) TO THE SPCORR SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   27 FORMAT(' ***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE SP',
     1'CORR SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *',
     1'****')
   28 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE THIRD  INPUT ARGUME
     1NT TO THE SPCORR SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      CALL RANK(X,N,XR)
      CALL RANK(Y,N,YR)
      SUM=0.0
      DO100I=1,N
      SUM=SUM+(XR(I)-YR(I))**2
  100 CONTINUE
      SPC   =1.0-(6.0*SUM/((AN-1.0)*AN*(AN+1.0))) 
C
      IF(IWRITE.NE.0)WRITE(IPR,105)N,SPC
  105 FORMAT(1H ,59HTHE SPEARMAN RANK CORRELATION COEFFICIENT OF THE 2 S
     1ETS OF ,I6,17H OBSERVATIONS IS ,F14.5)
      RETURN
      END 
      SUBROUTINE STMOM3(X,N,IWRITE,XSMOM3)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT STMOM3
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SAMPLE STANDARDIZED THIRD CENTRAL MOMENT
C              OF THE DATA IN THE INPUT VECTOR X. 
C              THE SAMPLE STANDARDIZED THIRD CENTRAL MOMENT =
C              (THE SAMPLE THIRD CENTRAL MOMENT)/((THE SAMPLE
C              STANDARD DEVIATION)**3). 
C              N (RATHER THAN N-1) HAS BEEN USED IN THE DENOMINATOR
C              IN THE CALCULATION OF BOTH THE SAMPLE THIRD CENTRAL
C              MOMENT AND THE SAMPLE STANDARD DEVIATION.
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                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SAMPLE STANDARDIZED THIRD CENTRAL
C                                MOMENT AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SAMPLE STANDARDIZED THIRD CENTRAL
C                                MOMENT AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--XSMOM3 = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE STANDARDIZED THIRD
C                                CENTRAL MOMENT.
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE STANDARDIZED THIRD CENTRAL MOMENT.
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 85,
C                 234, 243, 297-298, 305.
C               --SNEDECOR AND COCHRAN, STATISTICAL METHODS,
C                 EDITION 6, 1967, PAGES 86-90.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      AN=N
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      XSMOM3=0.0
      GOTO201
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XSMOM3=0.0
      GOTO201
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE STMOM3 SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 STMOM3 SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE STMOM3 SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      SUM=0.0
      DO100I=1,N
      SUM=SUM+X(I)
  100 CONTINUE
      XMEAN=SUM/AN
      SUM2=0.0
      SUM3=0.0
      DO200I=1,N
      SUM2=SUM2+(X(I)-XMEAN)**2
      SUM3=SUM3+(X(I)-XMEAN)**3
  200 CONTINUE
      SUM3=SUM3/AN
      VB=SUM2/AN
      XSMOM3=SUM3/(VB**1.5)
C
  201 IF(IWRITE.EQ.0)RETURN
      WRITE(IPR,999)
      WRITE(IPR,205)N,XSMOM3
  205 FORMAT(1H , 54HTHE SAMPLE STANDARDIZED THIRD  CENTRAL MOMENT FOR T
     1HE ,I6,17H OBSERVATIONS IS ,E15.8)
  999 FORMAT(1H )
      RETURN
      END 
      SUBROUTINE STMOM4(X,N,IWRITE,XSMOM4)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT STMOM4
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SAMPLE STANDARDIZED FOURTH CENTRAL MOMENT
C              OF THE DATA IN THE INPUT VECTOR X. 
C              THE SAMPLE STANDARDIZED FOURTH CENTRAL MOMENT =
C              (THE SAMPLE FOURTH CENTRAL MOMENT)/((THE SAMPLE
C              STANDARD DEVIATION)**4). 
C              N (RATHER THAN N-1) HAS BEEN USED IN THE DENOMINATOR
C              IN THE CALCULATION OF BOTH THE SAMPLE FOURTH CENTRAL
C              MOMENT AND THE SAMPLE STANDARD DEVIATION.
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                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SAMPLE STANDARDIZED FOURTH CENTRAL
C                                MOMENT AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SAMPLE STANDARDIZED FOURTH CENTRAL
C                                MOMENT AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--XSMOM4 = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE STANDARDIZED FOURTH
C                                CENTRAL MOMENT.
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE STANDARDIZED FOURTH CENTRAL MOMENT.
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 85, 243.
C               --SNEDECOR AND COCHRAN, STATISTICAL METHODS,
C                 EDITION 6, 1967, PAGES 86-90.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      AN=N
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      XSMOM4=0.0
      GOTO201
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XSMOM4=0.0
      GOTO201
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE STMOM4 SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 STMOM4 SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE STMOM4 SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      SUM=0.0
      DO100I=1,N
      SUM=SUM+X(I)
  100 CONTINUE
      XMEAN=SUM/AN
      SUM2=0.0
      SUM4=0.0
      DO200I=1,N
      SUM2=SUM2+(X(I)-XMEAN)**2
      SUM4=SUM4+(X(I)-XMEAN)**4
  200 CONTINUE
      VB=SUM2/AN
      SUM4=SUM4/AN
      XSMOM4=SUM4/(VB*VB)
C
  201 IF(IWRITE.EQ.0)RETURN
      WRITE(IPR,999)
      WRITE(IPR,205)N,XSMOM4
  205 FORMAT(1H , 54HTHE SAMPLE STANDARDIZED FOURTH CENTRAL MOMENT FOR T
     1HE ,I6,17H OBSERVATIONS IS ,E15.8)
  999 FORMAT(1H )
      RETURN
      END 
      SUBROUTINE SUBSE1(X,N,D,DMIN,DMAX,Y,NY)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT SUBSE1
C
C     PURPOSE--THIS SUBROUTINE CARRIES OVER INTO Y ALL OBSERVATIONS
C              OF THE SINGLE PRECISION VECTOR X FOR WHICH THE
C              CORRESPONDING ELEMENTS IN THE
C              SINGLE PRECISION VECTOR D ARE INSIDE
C              THE CLOSED (INCLUSIVE) INTERVAL
C              DEFINED BY DMIN AND DMAX,
C              WHILE NOT CARRYING OVER ANY OBSERVATIONS OF X
C              CORRESPONDING TO ELEMENTS OF D
C              OUTSIDE OF THIS INTERVAL.
C              THE INPUT VECTOR X IS ITSELF UNALTERED;
C              THOSE ELEMENTS OF X TO BE RETAINED ARE
C              COPIED OVER INTO THE SINGLE PRECISION
C              OUTPUT VECTOR Y.
C              THUS ALL OBSERVATIONS OF X WHICH
C              CORRESPOND TO ELEMENTS IN D WHICH ARE SMALLER
C              THAN DMIN OR LARGER THAN DMAX ARE
C              NOT COPIED OVER INTO Y.
C              THE USE OF THIS SUBROUTINE
C              GIVES THE DATA ANALYST THE CAPABILITY TO
C              EASILY EXTRACT SUBSETS OF THE DATA 
C              PRIOR TO DATA ANALYSIS ON EACH SUBSET.
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                     --D      = THE SINGLE PRECISION VECTOR
C                                WHICH 'DEFINES' THE VARIOUS
C                                POSSIBLE SUBSETS OF X.
C                     --DMIN   = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES THE LOWER LIMIT
C                                (INCLUSIVELY) OF THE PARTICULAR
C                                SUBSET OF INTEREST TO BE RETAINED.
C                     --DMAX   = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES THE UPPER LIMIT
C                                (INCLUSIVELY) OF THE PARTICULAR
C                                SUBSET OF INTEREST TO BE RETAINED.
C     OUTPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR
C                                CONTAINING ONLY THOSE ELEMENTS
C                                OF X CORRESPONDING TO
C                                VALUES OF THE D VECTOR
C                                IN THE INTERVAL DMIN TO DMAX
C                                (INCLUSIVE).
C                     --NY     = THE INTEGER NUMBER OF RETAINED
C                                OBSERVATIONS COPIED INTO
C                                THE VECTOR Y.
C     OUTPUT--THE SINGLE PRECISION VECTOR Y
C             INTO WHICH HAVE BEEN COPIED
C             ONLY THOSE VALUES OF X WHICH
C             CORRESPOND TO VALUES
C             IN THE D VECTOR INSIDE
C             (INCLUSIVELY) THE INTERVAL OF
C             INTEREST, AND
C             THE INTEGER VALUE NY
C             WHICH GIVES THE NUMBER OF 
C             OBSERVATIONS COPIED INTO Y.
C             ALSO, 12 LINES OF SUMMARY INFORMATION
C             WILL BE GENERATED INDICATING
C             1) WHAT THE INTERVAL OF INTEREST WAS
C                IN THE D VECTOR;
C             2) HOW MANY OBSERVATIONS WERE DELETED;
C             3) WHAT THE SAMPLE SIZE OF X WAS (N);
C             4) WHAT THE SAMPLE SIZE OF Y WAS (NY);
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--THE INPUT VECTOR X IS NOT ALTERED
C              BY APPLICATION OF THIS SUBROUTINE. 
C              THIS IS THE MAJOR DISTINCTION
C              BETWEEN THIS SUBROUTINE AND, SAY,
C              THE SUBSET SUBROUTINE.
C              IT IS THUS SEEN THAT THIS (SUBSE1) 
C              SUBROUTINE IS THE PREFERABLE OF THE 2
C              (SUBSET VERSUS SUBSE1)
C              FOR HANDLING THE PROBLEM OF
C              SEQUENTIALLY EXTRACTING EACH POSSIBLE
C              SUBSET OF X (FOR THE PURPOSE OF
C              ANALYZING EACH INDIVIDUAL SUBSET). 
C              INASMUCH AS THE ORIGINAL X VECTOR
C              REMAINS UNCHANGED, THE ANALYST
C              CAN ALWAYS OPERATE ON IT WITH
C              SUBSE1 IN SEQUENTIALLY EXTRACTING
C              SUBSETS OF INTEREST.
C     COMMENT--IN THE END, AFTER THIS SUBROUTINE HAS
C              MADE WHATEVER DELETIONS ARE APPROPRIATE,
C              THE OUTPUT VECTOR Y WILL BE 'PACKED';
C              THAT IS, NO 'HOLES' WILL EXIST IN THE
C              VECTOR Y--ALL OF THE RETAINED ELEMENTS
C              OF Y WILL BE PACKED INTO THE FIRST AVAILABLE 
C              LOCATIONS IN Y, WHILE THE REMAINDER
C              OF THE N LOCATIONS IN Y WILL BE ZERO-FILLED. 
C     COMMENT--ALTHOUGH THERE 
C              MAY BE A CORRESPONDANCE BETWEEN THE
C              ELEMENTS OF THE X AND D VECTORS
C              BEFORE APPLICATION OF
C              THIS SUBROUTINE, THERE WILL
C              BE NO CORRESPONDANCE BETWEEN
C              Y AND D (DUE TO THE PACKING OF
C              THE RETAINED ELEMENTS IN Y)
C              AFTER APPLICATION OF THIS SUBROUTINE.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--APRIL     1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(1)
      DIMENSION D(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE SUBSE1 SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 SUBSE1 SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE SUBSE1 SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      POINTL=DMIN
      POINTU=DMAX
      IF(DMIN.GT.DMAX)POINTL=DMAX
      IF(DMIN.GT.DMAX)POINTU=DMIN
C
      K=0 
      DO100I=1,N
      IF(D(I).LT.POINTL.OR.D(I).GT.POINTU)GOTO100 
      K=K+1
      Y(K)=X(I)
  100 CONTINUE
      NY=K
      NDEL=N-NY
C
C     WRITE OUT A BRIEF SUMMARY
C
      WRITE(IPR,999)
      WRITE(IPR,101)
      WRITE(IPR,111)POINTL,POINTU
      WRITE(IPR,160)
      WRITE(IPR,161)
      WRITE(IPR,162)
      WRITE(IPR,163)
      WRITE(IPR,164)
      WRITE(IPR,165)
      WRITE(IPR,166)
      WRITE(IPR,185)N
      WRITE(IPR,190)NY
      WRITE(IPR,195)NDEL
  101 FORMAT(1H ,35HOUTPUT FROM THE SUBSE1 SUBROUTINE--)
  111 FORMAT(1H ,7X,26HD1 LIMITS (INCLUSIVE)--   ,E15.8,5H AND ,E15.8)
  160 FORMAT(1H ,7X,28HONLY THOSE OBSERVATIONS IN X)
  161 FORMAT(1H ,7X,27HWILL BE CARRIED OVER INTO Y)
  162 FORMAT(1H ,7X,40HFOR WHICH THE CORRESPONDING ELEMENTS OF ,
     1               2HD1)
  163 FORMAT(1H ,7X,37HARE SIMULTANEOUSLY WITHIN (INCLUSIVE))
  164 FORMAT(1H ,7X,21HEACH SPECIFIED LIMIT.)
  165 FORMAT(1H ,7X,40HNO OBSERVATIONS OUTSIDE OF THIS INTERVAL)
  166 FORMAT(1H ,7X,30HHAVE BEEN CARRIED OVER INTO Y.)
  185 FORMAT(1H ,7X,44HTHE INPUT  NUMBER OF OBSERVATIONS (IN X) IS ,I6)
  190 FORMAT(1H ,7X,44HTHE OUTPUT NUMBER OF OBSERVATIONS (IN Y) IS ,I6)
  195 FORMAT(1H ,7X,44HTHE NUMBER OF OBSERVATIONS DELETED       IS ,I6)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE SUBSE2(X,N,D1,D1MIN,D1MAX,D2,D2MIN,D2MAX,Y,NY)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT SUBSE2
C
C     PURPOSE--THIS SUBROUTINE CARRIES OVER INTO Y ALL OBSERVATIONS
C              OF THE SINGLE PRECISION VECTOR X FOR WHICH THE
C              CORRESPONDING ELEMENTS IN THE
C              SINGLE PRECISION VECTOR D1 ARE INSIDE
C              THE CLOSED (INCLUSIVE) INTERVAL
C              DEFINED BY D1MIN AND D1MAX,
C              AND ALSO FOR WHICH THE
C              CORRESPONDING ELEMENTS IN THE
C              SINGLE PRECISION VECTOR D2 ARE INSIDE
C              THE CLOSED (INCLUSIVE) INTERVAL
C              DEFINED BY D2MIN AND D2MAX.
C              NO OBSERVATIONS IN X
C              CORRESPONDING TO ELEMENTS OF D1 OR D2
C              OUTSIDE OF THEIR RESPECTIVE INTERVALS
C              ARE CARRIED OVER INTO Y. 
C              THE INPUT VECTOR X IS ITSELF UNALTERED;
C              THOSE ELEMENTS OF X TO BE RETAINED ARE
C              COPIED OVER INTO THE SINGLE PRECISION
C              OUTPUT VECTOR Y.
C              THUS ALL OBSERVATIONS OF X WHICH
C              CORRESPOND TO ELEMENTS IN D1 WHICH ARE SMALLER
C              THAN D1MIN OR LARGER THAN D1MAX, OR WHICH
C              CORRESPOND TO ELEMENTS IN D2 WHICH ARE SMALLER
C              THAN D2MIN OR LARGER THAN D2MAX,
C              ARE NOT COPIED OVER INTO Y.
C              THE USE OF THIS SUBROUTINE
C              GIVES THE DATA ANALYST THE CAPABILITY TO
C              EASILY EXTRACT SUBSETS OF THE DATA 
C              PRIOR TO DATA ANALYSIS ON EACH SUBSET.
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                     --D1     = A SINGLE PRECISION VECTOR
C                                WHICH (IN CONJUNCTION WITH D2)
C                                'DEFINES' THE VARIOUS
C                                POSSIBLE SUBSETS OF X.
C                     --D1MIN  = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES IN D1 THE LOWER LIMIT
C                                (INCLUSIVELY) OF THE PARTICULAR
C                                SUBSET OF INTEREST TO BE RETAINED.
C                     --D1MAX  = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES IN D1 THE UPPER LIMIT
C                                (INCLUSIVELY) OF THE PARTICULAR
C                                SUBSET OF INTEREST TO BE RETAINED.
C                     --D2     = A SINGLE PRECISION VECTOR
C                                WHICH (IN CONJUNCTION WITH D2)
C                                'DEFINES' THE VARIOUS
C                                POSSIBLE SUBSETS OF X.
C                     --D2MIN  = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES IN D2 THE LOWER LIMIT
C                                (INCLUSIVELY) OF THE PARTICULAR
C                                SUBSET OF INTEREST TO BE RETAINED.
C                     --D2MAX  = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES IN D2 THE UPPER LIMIT
C                                (INCLUSIVELY) OF THE PARTICULAR
C                                SUBSET OF INTEREST TO BE RETAINED.
C     OUTPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR
C                                CONTAINING ONLY THOSE ELEMENTS
C                                OF X SIMULTANEOUSLY CORRESPONDING TO 
C                                VALUES OF THE D1 VECTOR
C                                IN THE INTERVAL D1MIN TO D1MAX
C                                (INCLUSIVE), AND 
C                                VALUES OF THE D2 VECTOR
C                                IN THE INTERVAL D2MIN TO D2MAX
C                                (INCLUSIVE).
C                     --NY     = THE INTEGER NUMBER OF RETAINED
C                                OBSERVATIONS COPIED INTO
C                                THE VECTOR Y.
C     OUTPUT--THE SINGLE PRECISION VECTOR Y
C             INTO WHICH HAVE BEEN COPIED
C             ONLY THOSE VALUES OF X WHICH
C             SIMULTANEOUSLY CORRESPOND TO VALUES 
C             IN THE D1 AND D2 VECTORS INSIDE
C             (INCLUSIVELY) THE RESPECTIVE
C             INTERVALS OF INTEREST, AND
C             THE INTEGER VALUE NY
C             WHICH GIVES THE NUMBER OF 
C             OBSERVATIONS COPIED INTO Y.
C             ALSO, 13 LINES OF SUMMARY INFORMATION
C             WILL BE GENERATED INDICATING
C             1) WHAT THE INTERVAL OF INTEREST WAS
C                IN THE D1 VECTOR;
C             2) WHAT THE INTERVAL OF INTEREST WAS
C                IN THE D2 VECTOR;
C             3) HOW MANY OBSERVATIONS WERE DELETED;
C             4) WHAT THE SAMPLE SIZE OF X WAS (N);
C             5) WHAT THE SAMPLE SIZE OF Y WAS (NY);
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--THE INPUT VECTOR X IS NOT ALTERED
C              BY APPLICATION OF THIS SUBROUTINE. 
C              THIS IS A MAJOR DISTINCTION
C              BETWEEN THIS SUBROUTINE AND, SAY,
C              THE SUBSET SUBROUTINE.
C     COMMENT--IN THE END, AFTER THIS SUBROUTINE HAS
C              MADE WHATEVER DELETIONS ARE APPROPRIATE,
C              THE OUTPUT VECTOR Y WILL BE 'PACKED';
C              THAT IS, NO 'HOLES' WILL EXIST IN THE
C              VECTOR Y--ALL OF THE RETAINED ELEMENTS
C              OF Y WILL BE PACKED INTO THE FIRST AVAILABLE 
C              LOCATIONS IN Y, WHILE THE REMAINDER
C              OF THE N LOCATIONS IN Y WILL BE ZERO-FILLED. 
C     COMMENT--ALTHOUGH THERE 
C              MAY BE A CORRESPONDANCE BETWEEN
C              THE ELEMENTS OF THE X AND D1 VECTORS
C              AND ELEMENTS OF THE X AND D2 VECTORS
C              BEFORE APPLICATION OF
C              THIS SUBROUTINE, THERE WILL
C              BE NO CORRESPONDANCE BETWEEN
C              Y AND D1, AND Y AND D2
C              (DUE TO THE PACKING OF
C              THE RETAINED ELEMENTS IN Y)
C              AFTER APPLICATION OF THIS SUBROUTINE.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(1)
      DIMENSION D1(1)
      DIMENSION D2(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE SUBSE2 SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 SUBSE2 SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE SUBSE2 SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      POIN1L=D1MIN
      POIN1U=D1MAX
      IF(D1MIN.GT.D1MAX)POIN1L=D1MAX
      IF(D1MIN.GT.D1MAX)POIN1U=D1MIN
C
      POIN2L=D2MIN
      POIN2U=D2MAX
      IF(D2MIN.GT.D2MAX)POIN2L=D2MAX
      IF(D2MIN.GT.D2MAX)POIN2U=D2MIN
      K=0 
      DO100I=1,N
      IF(D1(I).LT.POIN1L.OR.D1(I).GT.POIN1U)GOTO100
      IF(D2(I).LT.POIN2L.OR.D2(I).GT.POIN2U)GOTO100
      K=K+1
      Y(K)=X(I)
  100 CONTINUE
      NY=K
      NDEL=N-NY
C
C     WRITE OUT A BRIEF SUMMARY
C
      WRITE(IPR,999)
      WRITE(IPR,101)
      WRITE(IPR,111)POIN1L,POIN1U
      WRITE(IPR,112)POIN2L,POIN2U
      WRITE(IPR,160)
      WRITE(IPR,161)
      WRITE(IPR,162)
      WRITE(IPR,163)
      WRITE(IPR,164)
      WRITE(IPR,165)
      WRITE(IPR,166)
      WRITE(IPR,185)N
      WRITE(IPR,190)NY
      WRITE(IPR,195)NDEL
  101 FORMAT(1H ,35HOUTPUT FROM THE SUBSE2 SUBROUTINE--)
  111 FORMAT(1H ,7X,26HD1 LIMITS (INCLUSIVE)--   ,E15.8,5H AND ,E15.8)
  112 FORMAT(1H ,7X,26HD2 LIMITS (INCLUSIVE)--   ,E15.8,5H AND ,E15.8)
  160 FORMAT(1H ,7X,28HONLY THOSE OBSERVATIONS IN X)
  161 FORMAT(1H ,7X,27HWILL BE CARRIED OVER INTO Y)
  162 FORMAT(1H ,7X,40HFOR WHICH THE CORRESPONDING ELEMENTS OF ,
     1               9HD1 AND D2)
  163 FORMAT(1H ,7X,37HARE SIMULTANEOUSLY WITHIN (INCLUSIVE))
  164 FORMAT(1H ,7X,21HEACH SPECIFIED LIMIT.)
  165 FORMAT(1H ,7X,40HNO OBSERVATIONS OUTSIDE OF THIS INTERVAL)
  166 FORMAT(1H ,7X,30HHAVE BEEN CARRIED OVER INTO Y.)
  185 FORMAT(1H ,7X,44HTHE INPUT  NUMBER OF OBSERVATIONS (IN X) IS ,I6)
  190 FORMAT(1H ,7X,44HTHE OUTPUT NUMBER OF OBSERVATIONS (IN Y) IS ,I6)
  195 FORMAT(1H ,7X,44HTHE NUMBER OF OBSERVATIONS DELETED       IS ,I6)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE SUBSET(X,N,D,DMIN,DMAX,NEWN)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT SUBSET
C
C     PURPOSE--THIS SUBROUTINE RETAINS ALL OBSERVATIONS IN THE
C              SINGLE PRECISION VECTOR X FOR WHICH THE
C              CORRESPONDING ELEMENTS IN THE
C              SINGLE PRECISION VECTOR D ARE INSIDE
C              THE CLOSED (INCLUSIVE) INTERVAL
C              DEFINED BY DMIN AND DMAX,
C              WHILE DELETING ALL OBSERVATIONS IN X
C              CORRESPONDING TO ELEMENTS OF D
C              OUTSIDE OF THIS INTERVAL.
C              THUS ALL OBSERVATIONS IN X WHICH
C              CORRESPOND TO ELEMENTS IN D WHICH ARE SMALLER
C              THAN DMIN OR LARGER THAN DMAX ARE DELETED FROM X.
C              THE USE OF THIS SUBROUTINE
C              GIVES THE DATA ANALYST THE CAPABILITY TO
C              EASILY EXTRACT SUBSETS OF THE DATA 
C              PRIOR TO DATA ANALYSIS ON EACH SUBSET.
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                     --D      = THE SINGLE PRECISION VECTOR
C                                WHICH 'DEFINES' THE VARIOUS
C                                POSSIBLE SUBSETS OF X.
C                     --DMIN   = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES THE LOWER LIMIT
C                                (INCLUSIVELY) OF THE PARTICULAR
C                                SUBSET OF INTEREST TO BE RETAINED.
C                     --DMAX   = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES THE UPPER LIMIT
C                                (INCLUSIVELY) OF THE PARTICULAR
C                                SUBSET OF INTEREST TO BE RETAINED.
C     OUTPUT ARGUMENTS--NEWN   = THE INTEGER NUMBER OF OBSERVATIONS
C                                REMAINING (RETAINED) IN X AFTER ALL
C                                OF THE OBSERVATIONS IN X
C                                HAVE BEEN DELETED WHICH
C                                CORRESPOND TO VALUES IN THE
C                                VECTOR D OUTSIDE THE
C                                INTERVAL OF INTEREST.
C     OUTPUT--THE SINGLE PRECISION VECTOR X
C             IN WHICH ONLY THOSE VALUES
C             HAVE BEEN RETAINED WHICH
C             CORRESPOND TO VALUES
C             IN THE D VECTOR INSIDE
C             (INCLUSIVELY) THE INTERVAL OF
C             INTEREST, AND
C             THE INTEGER VALUE NEWN
C             WHICH GIVES THE NUMBER OF 
C             OBSERVATIONS RETAINED IN X.
C             ALSO, 12 LINES OF SUMMARY INFORMATION
C             WILL BE GENERATED INDICATING
C             1) WHAT THE INTERVAL OF INTEREST WAS
C                IN THE D VECTOR;
C             2) HOW MANY OBSERVATIONS WERE DELETED;
C             3) WHAT THE OLD (ORIGINAL) SAMPLE SIZE WAS (N);
C             4) WHAT THE NEW SAMPLE SIZE IS (NEWN).
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--IN THE END, AFTER THIS SUBROUTINE HAS
C              MADE WHATEVER DELETIONS ARE APPROPRIATE,
C              THE OUTPUT VECTOR X WILL BE 'PACKED';
C              THAT IS, NO 'HOLES' WILL EXIST IN THE
C              VECTOR X--ALL OF THE RETAINED ELEMENTS
C              OF X WILL BE PACKED INTO THE FIRST AVAILABLE 
C              LOCATIONS IN X, WHILE THE REMAINDER
C              OF THE N LOCATIONS IN X WILL BE ZERO-FILLED. 
C     COMMENT--CAUTION IS TO BE EXERCISED IN
C              USING THIS SUBROUTINE FOR THE
C              FOLLOWING REASON--THE INPUT VECTOR X
C              IS IRREVOCABLY ALTERED BY APPLICATION
C              OF THIS SUBROUTINE.  ALTHOUGH THERE
C              MAY BE A CORRESPONDANCE BETWEEN THE
C              ELEMENTS OF THE X AND D VECTORS
C              BEFORE APPLICATION OF
C              THIS SUBROUTINE, THERE WILL
C              BE NO CORRESPONDANCE BETWEEN
C              X AND D (DUE TO THE PACKING OF
C              THE RETAINED ELEMENTS OF X)
C              AFTER APPLICATION OF THIS SUBROUTINE.
C              TO SUCCESSIVELY EXTRACT EACH POSSIBLE
C              SUBSET OF X, IT IS
C              RECOMMENDED THAT THE
C              ANALYST USE THE      SUBSA2
C              SUBROUTINE WHICH LEAVES
C              THE ORIGINAL INPUT VECTOR X
C              UNALTERED AND OUTPUTS THE
C              RETAINED ELEMENTS IN A
C              SEPARATE SECOND VECTOR Y.
C     COMMENT--IN THE MAIN (CALLING) ROUTINE, IT IS
C              PERMISSABLE (IF THE ANALYST SO DESIRES)
C              TO USE THE SAME VARIABLE NAME
C              IN THE SIXTH ARGUMENT AS USED IN THE SECOND
C              ARGUMENT IN THE CALLING SEQUENCE TO THIS
C              SUBSET SUBROUTINE--NO CONFLICT WILL RESULT
C              IN THE INTERNAL OPERATION OF THE     SUBSET
C              SUBROUTINE.  FOR EXAMPLE, IT IS PERMISSIBLE
C              TO HAVE     CALL SUBSET(X,N,D,0.5,1.5,N)
C              IN WHICH THE VARIABLE NAME      N    IS USED 
C              AS BOTH THE SECOND AND SIXTH ARGUMENTS.
C     COMMENT--THIS IS ONE OF THE FEW SUBROUTINES IN DATAPAC
C              IN WHICH THE INPUT VECTOR X IS ALTERED.
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION D(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE SUBSET SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 SUBSET SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE SUBSET SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      POINTL=DMIN
      POINTU=DMAX
      IF(DMIN.GT.DMAX)POINTL=DMAX
      IF(DMIN.GT.DMAX)POINTU=DMIN
C
      NOLD=N
      K=0 
      DO100I=1,NOLD 
      IF(D(I).LT.POINTL.OR.D(I).GT.POINTU)GOTO100 
      K=K+1
      X(K)=X(I)
  100 CONTINUE
      NEWN=K
      NDEL=NOLD-NEWN
C
      NEWNP1=NEWN+1 
      IF(NEWNP1.GT.NOLD)GOTO250
      DO200I=NEWNP1,NOLD
      X(I)=0.0
  200 CONTINUE
  250 CONTINUE
C
C     WRITE OUT A BRIEF SUMMARY
C
      WRITE(IPR,999)
      WRITE(IPR,101)
      WRITE(IPR,105)POINTL,POINTU
      WRITE(IPR,110)
      WRITE(IPR,111)
      WRITE(IPR,112)
      WRITE(IPR,113)
      WRITE(IPR,114)
      WRITE(IPR,115)
      WRITE(IPR,116)
      WRITE(IPR,120)NOLD
      WRITE(IPR,125)NEWN
      WRITE(IPR,130)NDEL
  101 FORMAT(1H ,35HOUTPUT FROM THE SUBSET SUBROUTINE--)
  105 FORMAT(1H ,7X,26HD  LIMITS (INCLUSIVE)--   ,E15.8,5H AND ,E15.8)
  110 FORMAT(1H ,7X,28HONLY THOSE OBSERVATIONS IN X)
  111 FORMAT(1H ,7X,16HWILL BE RETAINED)
  112 FORMAT(1H ,7X,40HFOR WHICH THECORRESPONDING ELEMENTS OF D)
  113 FORMAT(1H ,7X,22HARE WITHIN (INCLUSIVE))
  114 FORMAT(1H ,7X,21HTHE SPECIFIED LIMITS.)
  115 FORMAT(1H ,7X,41HALL OBSERVATIONS OUTSIDE OF THIS INTERVAL)
  116 FORMAT(1H ,7X,23HHAVE BEEN DELETED IN X.)
  120 FORMAT(1H ,7X,44HTHE INPUT  NUMBER OF OBSERVATIONS (IN X) IS ,I6)
  125 FORMAT(1H ,7X,44HTHE OUTPUT NUMBER OF OBSERVATIONS (IN X) IS ,I6)
  130 FORMAT(1H ,7X,44HTHE NUMBER OF OBSERVATIONS DELETED       IS ,I6)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE TAIL(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT TAIL
C
C     PURPOSE--THIS SUBROUTINE PERFOMS A SYMMETRIC DISTRIBUTION
C              TAIL LENGTH ANALYSIS
C              ON THE DATA IN THE INPUT VECTOR X. 
C              THE ANALYSIS CONSISTS OF THE FOLLOWING--
C              1) VARIOUS TEST STATISTICS TO TEST 
C                 THE SPECIFIC HYPOTHESIS OF NORMALITY;
C              2) A UNIFORM PROBABILITY PLOT
C                 (A SHORT-TAILED DISTRIBUTION);
C              3) A NORMAL PROBAIBLITY PLOT
C                 (A MODERATE-TAILED DISTRIBUTION);
C              4) A TUKEY LAMBDA = -0.5 PROBABILTY PLOT
C                 (A MODERATE-LONG-TAILED DISTRIBTION);
C              5) A CAUCHY PROBABILITY PLOT
C                (A LONG-TAILED DISTRIBUTION);
C              6) A DETERMINATION OF THE BEST-FIT 
C                 SYMMETRIC DISTRIBUTION
C                 TO THE DATA SET FROM AN
C                 ADMISSABLE SET CONSISTING OF
C                 43 SYMMETRIC DISTRIBUTIONS.
C              THE ADMISSABLE SET OF SYMMETRIC
C              DISTRIBUTIONS CONSIDERED INCLUDES THE
C              UNIFORM, NORMAL, LOGISTIC,
C              DOUBLE EXPONENTIAL, CAUCHY, AND
C              37 DISTRIBUTIONS DRAWN FROM THE
C              THE TUKEY LAMBDA DISTRIBUTIONAL FAMILY.
C              THE GOODNESS OF FIT CRITERION IS THE MAXIMUM PROBABILITY
C              PLOT CORRELATION COEFFICIENT CRITERION.
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--6 PAGES OF AUTOMATIC PRINTOUT--
C             1) VARIOUS TEST STATISTICS FOR NORMALITY;
C             2) A UNIFORM PROBABILITY PLOT;
C             3) A NORMAL PROBAIBLITY PLOT;
C             4) A TUKEY LAMBDA = -0.5 PROBABILTY PLOT;
C             5) A CAUCHY PROBABILITY PLOT;
C             6) A DETERMINATION OF THE BEST-FIT
C                SYMMETRIC DISTRIBUTION 
C                TO THE DATA SET.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 3000.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, NORPPF, PLOT. 
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ALOG, ALOG10, EXP,
C                                         SIN, COS, ATAN.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCE--FILLIBEN (1972), 'TECHNIQUES FOR TAIL LENGTH
C                ANALYSIS', PROCEEDINGS OF THE EIGHTEENTH
C                CONFERENCE ON THE DESIGN OF EXPERIMENTS IN 
C                ARMY RESEARCH AND TESTING, PAGES 425-450.
C              --FILLIBEN, 'THE PERCENT POINT FUNCTION',
C                UNPUBLISHED MANUSCRIPT.
C              --JOHNSON AND KOTZ (1970), CONTINUOUS UNIVARIATE
C                DISTRIBUTIONS-1, PAGES 250-271.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFLAG1
      CHARACTER*4 IFLAG2
      CHARACTER*4 IFLAG3
      CHARACTER*4 ILINE1
      CHARACTER*4 ILINE2
C
      CHARACTER*4 ALPHAM
      CHARACTER*4 ALPHAA
      CHARACTER*4 BLANK
      CHARACTER*4 HYPHEN
      CHARACTER*4 ALPHAI
      CHARACTER*4 ALPHAX
C
      DIMENSION X(*)
      DIMENSION Y(3000),Z(3000),YM(3000)
      DIMENSION P(3000),PTENTH(3000)
      DIMENSION CORR(50),IFLAG1(50),IFLAG2(50),IFLAG3(50)
      DIMENSION  ILINE1(130),ILINE2(130)
      DIMENSION XLINE(13)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(Z(1),WS(3001)),(YM(1),WS(6001))
      EQUIVALENCE (P(1),WS(9001)),(PTENTH(1),WS(12001))
C
      DATA ALPHAM,ALPHAA/'M','A'/
      DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/
      DATA PICONS/3.14159265358979/
      DATA CONSTN/.3989422804/
C
      IPR=6
      IUPPER=3000
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      RETURN
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE TAIL   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 TAIL   SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE TAIL   SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     COMPUTE THE SAMPLE MEAN 
C
      SUM=0.0
      DO100I=1,N
      SUM=SUM+X(I)
  100 CONTINUE
      XBAR=SUM/AN
C
C     COMPUTE S, BIASED S, B1, AND B2
C
      SUM2=0.0
      SUM3=0.0
      SUM4=0.0
      DO200I=1,N
      DEL=X(I)-XBAR 
      A2=DEL*DEL
      A3=DEL*A2
      A4=A2*A2
      SUM2=SUM2+A2
      SUM3=SUM3+A3
      SUM4=SUM4+A4
  200 CONTINUE
      AM2=SUM2/AN
      AM3=SUM3/AN
      AM4=SUM4/AN
      S=SQRT(SUM2/(AN-1.0))
      BS=SQRT(AM2)
      B1=AM3/(BS**3)
      B2=AM4/(BS**4)
C
C     COMPUTE THE EXPECTED VALUE AND STANDARD DEVIATION OF B1 AND B2
C     UNDER THE NORMALITY ASSUMPTION
C     REFERENCE--CRAMER, PAGE 386
C
      EB1=0.0
      SDB1=6.0*(AN-2.0)/((AN+1.0)*(AN+3.0))
      SDB1=SQRT(SDB1)
      ZB1=(B1-EB1)/SDB1
      EB2=3.0-6.0/(AN+1.0)
      SDB2=24.0*AN*(AN-2.0)*(AN-3.0)/((AN+1.0)*(AN+1.0)*(AN+3.0)*(AN+5.0
     1))
      ZB2=(B2-EB2)/SDB2
C
C     COMPUTE GEARY'S STATISTIC
C
      SUM=0.0
      DO300I=1,N
      SUM=SUM+ABS(X(I)-XBAR)
  300 CONTINUE
      EANDEV=SUM/AN 
      GEARY=EANDEV/BS
C
C     COMPUTE THE EXPECTED VALUE AND STANDARD DEVIATION
C     OF GEARY'S STATISTIC UNDER THE NORMALITY ASSUMPTION
C     REFERENCE--BIOMETRIKA, 1936, PAGE 296
C
      AA=SQRT(2.0/PICONS)
      BB=SQRT(2.0/(AN-1.0))
      IF(N.GE.100)CC=SQRT(AN/2.0)*(1.0-(1.0/(8.0*AN/2.0))+(1.0/(128.0*AN
     1*AN/4.0)))
      IF(N.GE.100)GOTO350
      COEF=1.0
      IMAX=N-1
      IEVODD=N-2*(N/2)
      IMIN=2
      IF(IEVODD.EQ.0)IMIN=3
      IF(IMIN.GT.IMAX)GOTO310 
      DO320I=IMIN,IMAX,2
      AI=I
      COEF=((AI-1.0)/AI)*COEF 
  320 CONTINUE
  310 COEF=COEF*(AN-1.0)
      IF(IEVODD.EQ.0)GOTO330
      COEF=COEF*(SQRT(PICONS)/2.0)
      GOTO340
  330 COEF=COEF/SQRT(PICONS)
  340 CC=COEF
  350 EGEARY=AA/(BB*CC)
      DD=(2.0/PICONS)*SQRT(AN*(AN-2.0)) 
      ARG=1.0/(AN-1.0)
      ARG=ARG/SQRT(1.0-ARG*ARG)
      EE=ATAN(ARG)
      SDGEAR=(1.0/AN)*(1.0+DD+EE)
      SDGEAR=SDGEAR-EGEARY*EGEARY
      SDGEAR=SQRT(SDGEAR)
      ZGEARY=(GEARY-EGEARY)/SDGEAR
C
C     SORT THE DATA,
C     THEN COMPUTE RANGE/S.
C
      CALL SORT(X,N,Y)
      RS=(Y(N)-Y(1))/S
C
C     COMPUTE THE EXPECTED VALUE AND STANDARD DEVIATION OF THE RANGE/S
C     UNDER THE NORMALITY ASSUMPTION
C     REFERENCE--BIOMETRIKA, 1954, PAGE 483
C
      G=.33000598+((AN-2.0)**.16)/41.785
      PN=(AN-G)/(AN-2.0*G+1.0)
      P1=1.0-PN
      CALL NORPPF(PN,RPN)
      CALL NORPPF(P1,RP1)
      EXN=RPN
      EX1=RP1
      ER=EXN-EX1
      CALL NORPPF(P1,PPFNOR)
      SFP1=1.0/(CONSTN*EXP(-(PPFNOR*PPFNOR)/2.0)) 
      CALL NORPPF(PN,PPFNOR)
      SFPN=1.0/(CONSTN*EXP(-(PPFNOR*PPFNOR)/2.0)) 
      VARXN=PN*(1.0-PN)*SFPN*SFPN/(AN+2.0)
      EXNSQ=VARXN+EXN*EXN
      COX1XN=P1*P1*SFP1*SFPN/(AN+2.0)
      EX1XN=COX1XN+EX1*EXN
      ERSQ=2.0*(EXNSQ-EX1XN)
      ES=BB*CC
      ESSQ=1.0
      ERS=ER/ES
      ERSSQ=ERSQ/ESSQ
      VARRS=ERSSQ-ERS*ERS
      SDRS=SQRT(VARRS)
      ZRS=(RS-ERS)/SDRS
C
C     COMPUTE THE WILK-SHAPIRO STATISTIC
C
      AL=ALOG10(AN) 
      GAMMA=.327511+.058212*AL-.009776*AL*AL
      SUM=0.0
      IF(N.LE.20)ARG=N
      IF(N.GT.20)ARG=N+1
      ASUBN=SQRT((1.0+(1.0/(4.0*ARG)))/SQRT(ARG)) 
      ASUB1=-ASUBN
      SUM=SUM+ASUB1*Y(1)+ASUBN*Y(N)
      IF(N.LE.2)GOTO510
      NM1=N-1
      DO500I=2,NM1
      AI=I
      PI=(AI-GAMMA)/(AN-2.0*GAMMA+1.0)
      CALL NORPPF(PI,EI)
      COEFI =2.0*EI  /SQRT(-2.722+4.083*AN)
      SUM=SUM+COEFI*Y(I)
  500 CONTINUE
  510 WILKSH=SUM*SUM/(AN*BS*BS)
C
C     COMPUTE THE EXPECTED VALUE AND STANDARD DEVIATION OF THE WILK-SHAPIRO
C     STATISTIC UNDER THE NORMALITY ASSUMPTION
C     REFERENCE--JJF APPROXIMATION TO MOMENTS ON PAGE 601 OF BIOMETRIKA (1965)
C
      IF(N.EQ.3)EWILKS=.9135
      IF(N.EQ.4)EWILKS=.9012
      IF(N.GE.5)EWILKS=.9026+(AN-5.0)/(44.608+13.593*SQRT(AN)+10.267*AN)
      IF(N.EQ.3)SDWILK=.0755
      IF(N.EQ.4)SDWILK=.0719
      IF(N.GE.5)SDWILK=.0670+(AN-5.0)/(-42.368-5.026*SQRT(AN)-14.925*AN)
      ZWILKS=(WILKSH-EWILKS)/SDWILK
C
C     COMPUTE THE CORRELATION COEFFICIENT BETWEEN THE ORDERED OBSERVATIONS
C     AND THE ORDER STATISIC MEDIANS FROM 44 DIFFERENT SYMMETRIC DISTRIBUTIONS
C
      NUMDIS=44
      NHALF=N/2
      NHALFP=NHALF+1
      IEVODD=N-2*(N/2)
      CALL UNIMED(N,Z)
      DO950I=1,N
      PTENTH(I)=Z(I)**(0.1)
  950 CONTINUE
      DO1000IDIS=1,NUMDIS
      IF(IDIS.EQ.20)GOTO1199
      IF(IDIS.EQ.22)GOTO1299
      IF(IDIS.EQ.23)GOTO1399
      IF(IDIS.EQ.33)GOTO1499
      IF(IDIS.LT.20)IDIS2=IDIS
      IF(IDIS.EQ.21)IDIS2=IDIS-1
      IF(23.LT.IDIS.AND.IDIS.LT.33)IDIS2=IDIS-2
      IF(33.LT.IDIS)IDIS2=IDIS-3
      ALAMBA=-(0.1)*FLOAT(IDIS2)+2.1
      IF(IDIS.EQ. 1)GOTO1009
      IF(IDIS.EQ.11)GOTO1019
      IF(IDIS.EQ.24)GOTO1029
      IF(IDIS.EQ.34)GOTO1039
      IF(IDIS.EQ.44)GOTO1049
      GOTO1059
 1009 DO1010I=1,NHALF
      IREV=N-I+1
      P(I)=Z(I)*Z(I)
      P(IREV)=Z(IREV)*Z(IREV) 
      YM(I)=(P(I)-P(IREV))/ALAMBA
      YM(IREV)=-YM(I)
 1010 CONTINUE
      IF(IEVODD.EQ.1)YM(NHALFP)=0.0
      GOTO1999
 1019 DO1020I=1,NHALF
      IREV=N-I+1
      P(I)=Z(I)
      P(IREV)=Z(IREV)
      YM(I)=(P(I)-P(IREV))/ALAMBA
      YM(IREV)=-YM(I)
 1020 CONTINUE
      IF(IEVODD.EQ.1)YM(NHALFP)=0.0
      GOTO1999
 1029 DO1030I=1,NHALF
      IREV=N-I+1
      P(I)=Z(I)**(-0.1)
      P(IREV)=Z(IREV)**(-0.1) 
      YM(I)=(P(I)-P(IREV))/ALAMBA
      YM(IREV)=-YM(I)
 1030 CONTINUE
      IF(IEVODD.EQ.1)YM(NHALFP)=0.0
      GOTO1999
 1039 DO1040I=1,NHALF
      P(IREV)=1.0/Z(IREV)
      P(I)=1.0/Z(I) 
      IREV=N-I+1
      YM(I)=(P(I)-P(IREV))/ALAMBA
      YM(IREV)=-YM(I)
 1040 CONTINUE
      IF(IEVODD.EQ.1)YM(NHALFP)=0.0
      GOTO1999
 1049 DO1050I=1,NHALF
      IREV=N-I+1
      P(I)=1.0/(Z(I)*Z(I))
      P(IREV)=1.0/(Z(IREV)*Z(IREV))
      YM(I)=(P(I)-P(IREV))/ALAMBA
      YM(IREV)=-YM(I)
 1050 CONTINUE
      IF(IEVODD.EQ.1)YM(NHALFP)=0.0
      GOTO1999
 1059 DO1060I=1,NHALF
      IREV=N-I+1
      P(I)=P(I)/PTENTH(I)
      P(IREV)=P(IREV)/PTENTH(IREV)
      YM(I)=(P(I)-P(IREV))/ALAMBA
      YM(IREV)=-YM(I)
 1060 CONTINUE
      IF(IEVODD.EQ.1)YM(NHALFP)=0.0
      GOTO1999
 1199 DO1200I=1,NHALF
      IREV=N-I+1
      CALL NORPPF(Z(I),YM(I)) 
      YM(IREV)=-YM(I)
 1200 CONTINUE
      IF(IEVODD.EQ.1)YM(NHALFP)=0.0
      GOTO1999
 1299 DO1300I=1,NHALF
      IREV=N-I+1
      YM(I)=ALOG(Z(I)/(1.0-Z(I)))
      YM(IREV)=-YM(I)
 1300 CONTINUE
      IF(IEVODD.EQ.1)YM(NHALFP)=0.0
      GOTO1999
 1399 DO1400I=1,NHALF
      IREV=N-I+1
      IF(Z(I).LE.0.5)YM(I)=ALOG(2.0*Z(I))
      IF(Z(I).GT.0.5)YM(I)=-ALOG(2.0*(1.0-Z(I)))
      YM(IREV)=-YM(I)
 1400 CONTINUE
      IF(IEVODD.EQ.1)YM(NHALFP)=0.0
      GOTO1999
 1499 DO1500I=1,NHALF
      IREV=N-I+1
      ARG=PICONS*Z(I)
      YM(I)=-COS(ARG)/SIN(ARG)
      YM(IREV)=-YM(I)
 1500 CONTINUE
      IF(IEVODD.EQ.1)YM(NHALFP)=0.0
 1999 SUM1=0.0
      SUM2=0.0
      DO2100I=1,N
      SUM1=SUM1+Y(I)*YM(I)
      SUM2=SUM2+YM(I)*YM(I)
 2100 CONTINUE
      SUM2=SQRT(SUM2)
      SUM3=S*SQRT(AN-1.0)
      CORR(IDIS)=SUM1/(SUM2*SUM3)
 1000 CONTINUE
C
C     DETERMINE THAT DISTRIBUTION WITH THE MAXIMUM PROB PLOT CORR COEFFICIENT
C
      IDISMX=1
      CORRMX=CORR(1)
      DO2200IDIS=1,NUMDIS
      IF(CORR(IDIS).GT.CORRMX)IDISMX=IDIS
      IF(CORR(IDIS).GT.CORRMX)CORRMX=CORR(IDIS)
 2200 CONTINUE
      DO2300IDIS=1,NUMDIS
      IFLAG1(IDIS)=BLANK
      IFLAG2(IDIS)=BLANK
      IFLAG3(IDIS)=BLANK
      IF(IDIS.EQ.IDISMX)GOTO2350
      GOTO2300
 2350 IFLAG1(IDIS)=ALPHAM
      IFLAG2(IDIS)=ALPHAA
      IFLAG3(IDIS)=ALPHAX
 2300 CONTINUE
      CC=CORR(20)
C
C     COMPUTE THE EXPECTED VALUE AND STANDARD DEVIATION OF THE PROBABILITY PLOT 
C     CORRELATION COEFFICIENT UNDER THE NORMALITY ASSUMPTION
C     REFERENCE--JJF UNPUBLISHED MANUSCRIPT
C
      IF(N.EQ.2)ECC=1.0
      IF(N.EQ.3)ECC=.95492958 
      IF(N.GE.4)ECC=.94947355+(AN-4.0)/(196.815-2.9418*SQRT(AN)+19.7916*
     1AN) 
      IF(N.EQ.2)SDCC=99999999.9999
      IF(N.EQ.3)SDCC=.04007697
      IF(N.GE.4)SDCC=.039492+(AN-4.0)/(-127.0-25.3*AN)
      ZCC=(CC-ECC)/SDCC
C
C     WRITE OUT THE NORMAL TAIL LENGTH STATISTICS PAGE
C
      WRITE(IPR,998)
      WRITE(IPR,810)
      WRITE(IPR,999)
      WRITE(IPR,821)N
      WRITE(IPR,822)XBAR
      WRITE(IPR,823)S
      WRITE(IPR,999)
      WRITE(IPR,830)
      WRITE(IPR,831)
      WRITE(IPR,832)
      WRITE(IPR,833)
      WRITE(IPR,834)
      DO840I=1,6
      WRITE(IPR,999)
  840 CONTINUE
      WRITE(IPR,850)
      WRITE(IPR,851)
      WRITE(IPR,999)
      WRITE(IPR,999)
      WRITE(IPR,860)
      WRITE(IPR,999)
      WRITE(IPR,871)B1,EB1,SDB1,ZB1
      WRITE(IPR,872)
      WRITE(IPR,873)B2,EB2,SDB2,ZB2
      WRITE(IPR,874)
      WRITE(IPR,875)GEARY,EGEARY,SDGEAR,ZGEARY
      WRITE(IPR,876)
      WRITE(IPR,877)RS,ERS,SDRS,ZRS
      WRITE(IPR,878)
      WRITE(IPR,879)WILKSH,EWILKS,SDWILK,ZWILKS
      WRITE(IPR,880)
      WRITE(IPR,881)CC,ECC,SDCC,ZCC
      WRITE(IPR,882)
C
C     COMPUTE THE LINE PLOT WHICH SHOWS THE DISTRIBUTION OF THE OBSERVED
C     VALUES IN TERMS OF MULTIPLES OF SAMPLE STANDARD DEVIATIONS AWAY FROM
C     THE SAMPLE MEAN
C
      DO 900I=1,130 
      ILINE1(I)=BLANK
      ILINE2(I)=BLANK
  900 CONTINUE
      ICOUNT=0
      DO920I=1,N
      MX=10.0*(((X(I)-XBAR)/S)+6.0)+0.5 
      MX=MX+7
      IF(MX.LT. 7.OR.MX.GT.127)ICOUNT=ICOUNT+1
      IF(MX.LT. 7.OR.MX.GT.127)GOTO920
      ILINE1(MX)=ALPHAX
  920 CONTINUE
      DO940I=7,127
      ILINE2(I)=HYPHEN
  940 CONTINUE
      DO960I=7,127,10
      ILINE2(I)=ALPHAI
  960 CONTINUE
      XLINE(7)=XBAR 
      DO3315I=1,6
      IREV=13-I+1
      AI=I
      XLINE(I)=XBAR-(7.0-AI)*S
      XLINE(IREV)=XBAR+(7.0-AI)*S
 3315 CONTINUE
C
C     WRITE OUT THE LINE PLOT SHOWING THE DEVIATIONS OF THE OBSERVATIONS
C     ABOUT THE SAMPLE MEAN IN TERMS OF MULTIPLES OF THE SAMPLE STANDARD
C     DEVIATION
C
      DO3305I=1,8
 3305 WRITE(IPR,999)
      WRITE(IPR,3310)
      WRITE(IPR,999)
      WRITE(IPR,999)
      WRITE(IPR,3321)(ILINE1(I),I=1,130)
      WRITE(IPR,3321)(ILINE2(I),I=1,130)
      WRITE(IPR,3323)
      WRITE(IPR,3326)(XLINE(I),I=1,13)
      WRITE(IPR,999)
      WRITE(IPR,3324)ICOUNT
C
C     GENERATE UNIFORM, NORMAL, LAMBDA = -0.5, AND CAUCHY PROBABILITY PLOTS
C
      NHALF=(N/2)+1 
      CALL PLOT(Y,Z ,N)
      WRITE(IPR,3501)N
      WRITE(IPR,3510)CORR(11) 
      DO4100I=1,NHALF
      IREV=N-I+1
      CALL NORPPF(Z(I),YM(I)) 
      YM(IREV)=-YM(I)
 4100 CONTINUE
      CALL PLOT(Y,YM,N)
      WRITE(IPR,3502)N
      WRITE(IPR,3510)CORR(20) 
      ALAMBA=-0.5
      DO4200I=1,NHALF
      IREV=N-I+1
      Q=Z(I)
      YM(I)=(Q**ALAMBA-(1.0-Q)**ALAMBA)/ALAMBA
      YM(IREV)=-YM(I)
 4200 CONTINUE
      CALL PLOT(Y,YM,N)
      WRITE(IPR,3503)ALAMBA,N 
      WRITE(IPR,3510)CORR(28) 
      DO4300I=1,NHALF
      IREV=N-I+1
      ARG=PICONS*Z(I)
      YM(I)=-COS(ARG)/SIN(ARG)
      YM(IREV)=-YM(I)
 4300 CONTINUE
      CALL PLOT(Y,YM,N)
      WRITE(IPR,3504)N
      WRITE(IPR,3510)CORR(33) 
C
C      WRITE OUT THE PROBABILITY PLOT CORRELATION COEFFICIENT PAGE
C
      WRITE(IPR,998)
      DO2400IDIS=1,NUMDIS
      IF(IDIS.EQ.20)GOTO2110
      IF(IDIS.EQ.22)GOTO2120
      IF(IDIS.EQ.23)GOTO2130
      IF(IDIS.EQ.33)GOTO2140
      IF(IDIS.LT.20)IDIS2=IDIS
      IF(IDIS.EQ.21)IDIS2=IDIS-1
      IF(23.LT.IDIS.AND.IDIS.LT.33)IDIS2=IDIS-2
      IF(33.LT.IDIS)IDIS2=IDIS-3
      ALAMBA=-(0.1)*FLOAT(IDIS2)+2.1
      WRITE(IPR,2105)N,ALAMBA,CORR(IDIS),IFLAG1(IDIS),IFLAG2(IDIS),
     1IFLAG3(IDIS)
      GOTO2400
 2110 WRITE(IPR,2115)N,CORR(IDIS),IFLAG1(IDIS),IFLAG2(IDIS),IFLAG3(IDIS)
      GOTO2400
 2120 WRITE(IPR,2125)N,CORR(IDIS),IFLAG1(IDIS),IFLAG2(IDIS),IFLAG3(IDIS)
      GOTO2400
 2130 WRITE(IPR,2135)N,CORR(IDIS),IFLAG1(IDIS),IFLAG2(IDIS),IFLAG3(IDIS)
      GOTO2400
 2140 WRITE(IPR,2145)N,CORR(IDIS),IFLAG1(IDIS),IFLAG2(IDIS),IFLAG3(IDIS)
 2400 CONTINUE
C
  810 FORMAT(1H ,48X,20HTAIL LENGTH ANALYSIS)
  821 FORMAT(1H ,46X,21H(THE SAMPLE SIZE N = ,I5,1H))
  822 FORMAT(1H ,40X,19H(THE SAMPLE MEAN = ,E15.8,1H))
  823 FORMAT(1H ,35X,33H(THE SAMPLE STANDARD DEVIATION = ,E15.8,1H))
  830 FORMAT(1H ,35X,63HREFERENCE--SHAPIRO, WILK, AND CHEN, JASA, 1968,
     1PAGES 1343-1372)
  831 FORMAT(1H ,35X,32HREFERENCE--CRAMER, PAGES 386-387)
  832 FORMAT(1H ,35X,49HREFERENCE--GEARY, BIOMETRIKA, 1947, PAGES 209-24
     12)
  833 FORMAT(1H ,35X,76HREFERENCE--BIOMETRIKA TABLES, VOLUME 1, PAGES 67
     1-69, 59-60, 207-208, AND 200)
  834 FORMAT(1H ,35X,60HREFERENCE--SHAPIRO AND WILK, BIOMETRIKA, 1965, P
     1AGES 591-611) 
  850 FORMAT(1H ,49X,22HTAIL LENGTH STATISTICS)
  851 FORMAT(1H ,5X,106HTHE EXPECTED VALUE AND STANDARD DEVIATION OF STA
     1TISTICS ON THIS PAGE ARE BASED ON THE NORMALITY ASSUMPTION)
  860 FORMAT(1H ,128H          FORM OF STATISTIC               VALUE OF
     1STAT    EXP(STAT)    SD(STAT)    (STAT-EXP(STAT))/SD(STAT)    TABL
     1E REFERENCE)
  871 FORMAT(1H ,41HSTANDARDIZED THIRD CENTRAL MOMENT        ,    F10.5,
     16X,F10.5,2X,F10.5,9X,F10.5,13X,17HBIOMETRIKA TABLES)
  872 FORMAT(1H ,111X,16HVOL. 1, PAGE 207)
  873 FORMAT(1H ,41HSTANDARDIZED FOURTH CENTRAL MOMENT       ,    F10.5,
     16X,F10.5,2X,F10.5,9X,F10.5,13X,17HBIOMETRIKA TABLES)
  874 FORMAT(1H ,111X,16HVOL. 1, PAGE 208)
  875 FORMAT(1H ,41HGEARY STATISTIC (MEAN DEVIATION/S)       ,    F10.5,
     16X,F10.5,2X,F10.5,9X,F10.5,13X,17HBIOMETRIKA TABLES)
  876 FORMAT(1H ,111X,16HVOL. 1, PAGE 207)
  877 FORMAT(1H ,41HRANGE/S                                  ,    F10.5,
     16X,F10.5,2X,F10.5,9X,F10.5,13X,17HBIOMETRIKA TABLES)
  878 FORMAT(1H ,111X,16HVOL. 1, PAGE 200)
  879 FORMAT(1H ,41HWILK-SHAPIRO STATISTIC (BLUE FOR SCALE/S),    F10.5,
     16X,F10.5,2X,F10.5,9X,F10.5,13X,17HBIOMETRIKA (1965))
  880 FORMAT(1H ,111X,8HPAGE 605)
  881 FORMAT(1H ,41HPROBABILITY PLOT CORRELATION COEFFICIENT ,    F10.5,
     16X,F10.5,2X,F10.5,9X,F10.5,13X,15HUNPUBLISHED JJF)
  882 FORMAT(1H ,111X,10HMANUSCRIPT)
 2105 FORMAT(1H ,28HTHE CORRELATION BETWEEN THE ,I6,60H ORDERED OBS. AND
     1 THE ORDER STAT. MEDIANS FROM THE LAMBDA = ,F4.1,10H DIST. IS ,F8.
     15,1X,3A1)
 2115 FORMAT(1H ,28HTHE CORRELATION BETWEEN THE ,I6,74H ORDERED OBS. AND
     1 THE ORDER STAT. MEDIANS FROM THE NORMAL DISTRIBUTION IS ,F8.5,1X,
     13A1)
 2125 FORMAT(1H ,28HTHE CORRELATION BETWEEN THE ,I6,74H ORDERED OBS. AND
     1 THE ORDER STAT. MEDIANS FROM THE LOGISTIC DIST.      IS ,F8.5,1X,
     13A1)
 2135 FORMAT(1H ,28HTHE CORRELATION BETWEEN THE ,I6,74H ORDERED OBS. AND
     1 THE ORDER STAT. MEDIANS FROM THE DOUBLE EXP. DIST.   IS ,F8.5,1X,
     13A1)
 2145 FORMAT(1H ,28HTHE CORRELATION BETWEEN THE ,I6,74H ORDERED OBS. AND
     1 THE ORDER STAT. MEDIANS FROM THE CAUCHY DISTRIBUTION IS ,F8.5,1X,
     13A1)
 3310 FORMAT(1H ,131HLINE PLOT SHOWING THE DISTRIBUTION OF THE OBSERVATI
     1ONS ABOUT THE SAMPLE MEAN IN TERMS OF MULTIPLES OF THE SAMPLE STAN
     1DARD DEVIATION)
 3321 FORMAT(1H ,130A1)
 3323 FORMAT(1H ,   127H     -6        -5        -4        -3        -2
     1       -1         0         1         2         3         4
     1  5         6)
 3324 FORMAT(1H ,10X,I5,105H OBSERVATIONS WERE IN EXCESS OF 6 SAMPLE STA
     1NDARD DEVIATIONS FROM THE SAMPLE MEAN AND SO WERE NOT PLOTTED)
 3326 FORMAT(1H ,13F10.4)
 3501 FORMAT(1H ,35X,47HUNIFORM PROBABILITY PLOT  (THE SAMPLE SIZE N = ,
     1I5,1H))
 3502 FORMAT(1H ,35X,46HNORMAL PROBABILITY PLOT  (THE SAMPLE SIZE N = ,I
     15,1H))
 3503 FORMAT(1H ,35X,9HLAMBDA = ,F4.1,40H PROBABILITY PLOT  (THE SAMPLE
     1SIZE N = ,I5,1H))
 3504 FORMAT(1H ,35X,46HCAUCHY PROBABILITY PLOT  (THE SAMPLE SIZE N = ,I
     15,1H))
 3510 FORMAT(1H , 34X,44H(PROBABILITY PLOT CORRELATION COEFFICIENT = ,F8
     1.5,1H))
  998 FORMAT(1H1)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE TCDF(X,NU,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT TCDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE FOR STUDENT'S T 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 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 STUDENT'S T 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--NORCDF. 
C     FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DATAN.
C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--NATIONAL BUREAU OF STANDARDS APPLIED MATHMATICS
C                 SERIES 55, 1964, PAGE 948, FORMULAE 26.7.3 AND 26.7.4.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--2, 1970, PAGES 94-129.
C               --FEDERIGHI, EXTENDED TABLES OF THE
C                 PERCENTAGE POINTS OF STUDENT'S
C                 T-DISTRIBUTION, JOURNAL OF THE
C                 AMERICAN STATISTICAL ASSOCIATION,
C                 1959, PAGES 683-688.
C               --OWEN, HANDBOOK OF STATISTICAL TABLES,
C                 1962, PAGES 27-30.
C               --PEARSON AND HARTLEY, BIOMETRIKA TABLES
C                 FOR STATISTICIANS, VOLUME 1, 1954,
C                 PAGES 132-134.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --MAY       1974. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --OCTOBER   1976. 
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DX,DNU,PI,C,CSQ,S,SUM,TERM,AI
      DOUBLE PRECISION DSQRT,DATAN
      DOUBLE PRECISION DCONST 
      DOUBLE PRECISION TERM1,TERM2,TERM3
      DOUBLE PRECISION DCDFN
      DOUBLE PRECISION DCDF
      DOUBLE PRECISION B11
      DOUBLE PRECISION B21,B22,B23,B24,B25
      DOUBLE PRECISION B31,B32,B33,B34,B35,B36,B37
      DOUBLE PRECISION D1,D3,D5,D7,D9,D11
      DATA NUCUT/1000/
      DATA PI/3.14159265358979D0/
      DATA DCONST/0.3989422804D0/
      DATA B11/0.25D0/
      DATA B21/0.01041666666667D0/
      DATA B22,B23,B24,B25/3.0D0,-7.0D0,-5.0D0,-3.0D0/
      DATA B31/0.00260416666667D0/
      DATA B32,B33,B34,B35,B36,B37/1.0D0,-11.0D0,14.0D0,6.0D0,
     1                            -3.0D0,-15.0D0/ 
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(NU.LE.0)GOTO50
      GOTO90
   50 WRITE(IPR,15) 
      WRITE(IPR,47)NU
      CDF=0.0
      RETURN
   90 CONTINUE
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 TCDF   SUBROUTINE IS NON-POSITIVE *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      DX=X
      ANU=NU
      DNU=NU
C
C     IF NU IS 3 THROUGH 9 AND X IS MORE THAN 3000
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 150
C     STANDARD DEVIATIONS BELOW THE MEAN,
C     SET CDF = 0.0 AND RETURN.
C     IF NU IS 3 THROUGH 9 AND X IS MORE THAN 3000
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 150
C     STANDARD DEVIATIONS ABOVE THE MEAN,
C     SET CDF = 1.0 AND RETURN.
C
      IF(NU.LE.2)GOTO109
      SD=SQRT(ANU/(ANU-2.0))
      Z=X/SD
      IF(NU.LT.10.AND.Z.LT.-3000.0)GOTO107
      IF(NU.GE.10.AND.Z.LT.-150.0)GOTO107
      IF(NU.LT.10.AND.Z.GT.3000.0)GOTO108
      IF(NU.GE.10.AND.Z.GT.150.0)GOTO108
      GOTO109
  107 CDF=0.0
      RETURN
  108 CDF=1.0
      RETURN
  109 CONTINUE
C
C     DISTINGUISH BETWEEN THE SMALL AND MODERATE
C     DEGREES OF FREEDOM CASE VERSUS THE
C     LARGE DEGREES OF FREEDOM CASE
C
      IF(NU.LT.NUCUT)GOTO110
      GOTO250
C
C     TREAT THE SMALL AND MODERATE DEGREES OF FREEDOM CASE
C     METHOD UTILIZED--EXACT FINITE SUM 
C     (SEE AMS 55, PAGE 948, FORMULAE 26.7.3 AND 26.7.4).
C
  110 CONTINUE
      C=DSQRT(DNU/(DX*DX+DNU))
      CSQ=DNU/(DX*DX+DNU)
      S=DX/DSQRT(DX*DX+DNU)
      IMAX=NU-2
      IEVODD=NU-2*(NU/2)
      IF(IEVODD.EQ.0)GOTO120
C
      SUM=C
      IF(NU.EQ.1)SUM=0.0D0
      TERM=C
      IMIN=3
      GOTO130
C
  120 SUM=1.0D0
      TERM=1.0D0
      IMIN=2
C
  130 IF(IMIN.GT.IMAX)GOTO160 
      DO100I=IMIN,IMAX,2
      AI=I
      TERM=TERM*((AI-1.0D0)/AI)*CSQ
      SUM=SUM+TERM
  100 CONTINUE
C
  160 SUM=SUM*S
      IF(IEVODD.EQ.0)GOTO170
      SUM=(2.0D0/PI)*(DATAN(DX/DSQRT(DNU))+SUM)
  170 CDF=0.5D0+SUM/2.0D0
      RETURN
C
C     TREAT THE LARGE DEGREES OF FREEDOM CASE.
C     METHOD UTILIZED--TRUNCATED ASYMPTOTIC EXPANSION
C     (SEE JOHNSON AND KOTZ, VOLUME 2, PAGE 102, FORMULA 10;
C     SEE FEDERIGHI, PAGE 687).
C
  250 CONTINUE
      CALL NORCDF(X,CDFN)
      DCDFN=CDFN
      D1=DX
      D3=DX**3
      D5=DX**5
      D7=DX**7
      D9=DX**9
      D11=DX**11
      TERM1=B11*(D3+D1)/DNU
      TERM2=B21*(B22*D7+B23*D5+B24*D3+B25*D1)/(DNU**2)
      TERM3=B31*(B32*D11+B33*D9+B34*D7+B35*D5+B36*D3+B37*D1)/(DNU**3) 
      DCDF=TERM1+TERM2+TERM3
      DCDF=DCDFN-(DCONST*(DEXP(-DX*DX/2.0D0)))*DCDF
      CDF=DCDF
      RETURN
C
      END 
      SUBROUTINE TIME(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT TIME
C
C     PURPOSE--THIS SUBROUTINE PERFORMS A TIME SERIES ANALYSIS
C              ON THE DATA IN THE INPUT VECTOR X. 
C              THE ANALYSIS CONSISTS OF THE FOLLOWING--
C              1) A PLOT OF AUTOCORRELATION VERSUS LAG NUMBER;
C              2) A TEST FOR WHITE NOISE (ASSUMING NORMALITY);
C              3) A 'PILOT' SPECTRUM; AND
C              4) 4 OTHER ESTIMATED SPECTRA--EACH BASED
C                 ON A DIFFERING BANDWIDTH.
C
C              IN ORDER THAT THE RESULTS OF THE TIME SERIES ANALYSIS
C              BE VALID AND PROPERLY INTERPRETED, THE INPUT DATA
C              IN X SHOULD BE EQUI-SPACED IN TIME 
C              (OR WHATEVER VARIABLE CORRESPONDS TO TIME).
C
C              THE HORIZONTAL AXIS OF THE SPECTRA PRODUCED
C              BY THIS SUBROUTINE IS FREQUENCY.
C              THIS FREQUENCY IS MEASURED IN UNITS OF
C              CYCLES PER 'DATA POINT' OR, MORE PRECISELY, IN
C              CYCLES PER UNIT TIME WHERE
C              'UNIT TIME' IS DEFINED AS THE
C              ELAPSED TIME BETWEEN ADJACENT OBSERVATIONS.
C              THE RANGE OF THE FREQUENCY AXIS IS 0.0 TO 0.5.
C
C     INPUT ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED) OBSERVATIONS.
C                      N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR X.
C     OUTPUT--7 TO 11 PAGES (DEPENDING ON
C             THE INPUT SAMPLE SIZE) OF 
C             AUTOMATIC PRINTOUT--
C             1) A PLOT OF AUTOCORRELATION VERSUS LAG NUMBER;
C                THIS PLOT MAY TAKE AS LITTLE AS 1
C                OR AS MANY AS 5 PAGES
C                (THE EXACT NUMBER DEPENDING ON
C                THE INPUT SAMPLE SIZE N);
C             2) A TEST FOR WHITE NOISE (ASSUMING NORMALITY);
C             3) A 'PILOT' SPECTRUM; AND
C             4) AN ESTIMATED SPECTRUM BASED ON A 
C                BANDWIDTH DERIVED FROM THE DATA SET;
C             5) AN ESTIMATED SPECTRUM BASED ON A 
C                BANDWIDTH ONLY 1/2 AS WIDE AS IN 4;
C             6) AN ESTIMATED SPECTRUM BASED ON A 
C                BANDWIDTH ONLY 1/4 AS WIDE AS IN 4;
C             7) AN ESTIMATED SPECTRUM BASED ON A 
C                BANDWIDTH ONLY 1/8 AS WIDE AS IN 4;
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C                 --THE SAMPLE SIZE N MUST BE GREATER
C                   THAN OR EQUAL TO 3. 
C     OTHER DATAPAC   SUBROUTINES NEEDED--PLOTC0, PLOTSP, AND CHSPPF. 
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--THE 'FAST FOURIER TRANSFORM' IS NOT USED
C              IN THIS VERSION OF TIME, BUT WILL BE
C              IMPLEMENTED IN A FUTURE VERSION.
C            --THE USUAL MAXIMUM NUMBER OF LAGS
C              FOR WHICH THE AUTOCORRELATION IS
C              COMPUTED IS N/4 WHERE N IS
C              THE SAMPLE SIZE (LENGTH OF THE
C              DATA RECORD IN THE VECTOR X).
C              THIS RULE IS OVERRIDDEN IN
C              LARGE DATA SETS AND IS REPLACED
C              BY THE RULE THAT THE MAXIMUM
C              NUMBER OF LAGS = 500
C              (WHICH CORRESPONDS TO AN 
C              AUTOCORRELATION PLOT COVERING
C              5 COMPUTER PAGES).
C              IF MORE LAGS ARE DESIRED,
C              CHANGE THE VALUE OF THE
C              VARIABLE     MAXLAG
C              WITHIN THIS SUBROUTINE
C              FROM 500 TO WHATEVER DESIRED,
C              AND ALSO CHANGE THE DIMENSION OF
C              THE VECTOR R FROM ITS PRESENT 500 TO HOWEVER 
C              MANY LAGS ARE DESIRED.
C            --IF THE INPUT OBSERVATIONS IN X ARE CONSIDERED
C              TO HAVE BEEN COLLECTED 1 SECOND APART IN TIME,
C              THEN THE FREQUENCY AXIS OF THE RESULTING
C              SPECTRA WOULD BE IN UNITS OF HERTZ 
C              (= CYCLES PER SECOND).
C            --THE FREQUENCY OF 0.0 CORRESPONDS TO A CYCLE
C              IN THE DATA OF INFINITE (= 1/(0.0))
C              LENGTH OR PERIOD.
C              THE FREQUENCY OF 0.5 CORRESPONDS TO A CYCLE
C              IN THE DATA OF LENGTH = 1/(0.5) = 2 DATA POINTS.
C            --ANY EQUI-SPACED TIME SERIES ANALYSIS IS
C              INTRINSICALLY LIMITED TO DETECTING FREQUENCIES
C              NO LARGER THAN 0.5 CYCLES PER DATA POINT;
C              THIS CORRESPONDS TO THE FACT THAT THE
C              SMALLEST DETECTABLE CYCLE IN THE DATA
C              IS 2 DATA POINTS PER CYCLE.
C     REFERENCES--JENKINS AND WATTS, ESPECIALLY PAGE 290.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1977. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION R(500)
      DIMENSION S(125)
      DIMENSION PSSQ(6),PMSQ(6),PS(6),P(5),L(4)
      DATA PI/3.14159265358979/
C
      IPR=6
      ILOWER=3
      MAXLAG=500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.ILOWER)GOTO50
      HOLD=X(1)
      DO65I=2,N
      IF(X(I).NE.HOLD)GOTO90
   65 CONTINUE
      WRITE(IPR, 9)HOLD
      RETURN
   50 WRITE(IPR,17)ILOWER
      WRITE(IPR,47)N
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE TIME   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 96H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 TIME   SUBROUTINE IS OUTSIDE THE ALLOWABLE (,I6,11H,INFINITY) ,
     1 14HINTERVAL *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     COMPUTE THE SAMPLE MEAN 
C
      SUM=0.0
      DO100I=1,N
      SUM=SUM+X(I)
  100 CONTINUE
      XBAR=SUM/AN
C
C     COMPUTE THE SAMPLE VARIANCE AND THE SUM OF SQUARED DEVIATIONS
C
      SUM=0.0
      DO200I=1,N
      SUM=SUM+(X(I)-XBAR)*(X(I)-XBAR)
  200 CONTINUE
      SSQ=SUM
      VARB=SSQ/AN
      VAR=SSQ/(AN-1.0)
      SD=SQRT(VAR)
C
C     COMPUTE THE SAMPLE AUTOCORRELATIONS
C     REFERENCE--JENKINS AND WATTS, PAGES 290 AND 259 (7.1.6)
C
      KMAX=N/4
      IF(N.LE.32)KMAX=N/2
      IF(N.LE.16)KMAX=N
      IF(KMAX.GT.MAXLAG)KMAX=MAXLAG
      DO300K=1,KMAX 
      SUM=0.0
      NMK=N-K
      DO400I=1,NMK
      J=I+K
      SUM=SUM+(X(I)-XBAR)*(X(J)-XBAR)
  400 CONTINUE
      R(K)=SUM/SSQ
  300 CONTINUE
C
C     PLOT THE SAMPLE AUTOCORRELATIONS
C
      CALL PLOTCO(R,KMAX)
      WRITE(IPR,1705)
      WRITE(IPR,1710)N,KMAX
C
C     DO A WHITE NOISE ANALYSIS
C
      SDR=1.0/SQRT(AN)
      R975=1.96*SDR 
      IF(R975.GT.1.0)R975=1.0 
      R025=-R975
      NUMOUT=0
      DO410K=1,KMAX 
      ABSR=R(K)
      IF(ABSR.LT.0.0)ABSR=-ABSR
      IF(ABSR.GT.R975)NUMOUT=NUMOUT+1
  410 CONTINUE
      PEROUT=FLOAT(NUMOUT)/FLOAT(KMAX)
      PEROUT=100.0*PEROUT
      WRITE(IPR,999)
      WRITE(IPR,420)R025,R975 
      WRITE(IPR,430)
      WRITE(IPR,440)NUMOUT,KMAX,PEROUT
      DO415I=1,5
      WRITE(IPR,999)
  415 CONTINUE
      WRITE(IPR,1715)N
      WRITE(IPR,1720)XBAR
      WRITE(IPR,1725)VAR
      WRITE(IPR,1730)SD
      WRITE(IPR,1735)VARB
C
C     COMPUTE THE PILOT SPECTRUM FOR THE REDUCED (2**J) SAMPLE
C     REFERENCE--JENKINS AND WATTS, PAGE 288
C
      DO450I=1,20
      NDIV=N/(2**I) 
      IF(NDIV.EQ.0)I2=I-1
      IF(NDIV.EQ.0)GOTO460
  450 CONTINUE
  460 IF(7.LT.I2)I2=7
      N2=2**I2
      AN2=N2
      DO500K=1,I2
      SUM=0.0
      IMIN=2**K
      JMAX=IMIN/2
      DO600I=IMIN,N2,IMIN
      SUM1=0.0
      SUM2=0.0
      DO700J=1,JMAX 
      IARG1=I+J-JMAX
      IARG2=IARG1-JMAX
      SUM1=SUM1+X(IARG1)
      SUM2=SUM2+X(IARG2)
  700 CONTINUE
      SUM=SUM+(SUM1-SUM2)*(SUM1-SUM2)
  600 CONTINUE
      PSSQ(K)=SUM/FLOAT(IMIN) 
      PMSQ(K)=PSSQ(K)/AN2
      PS(K)=FLOAT(2*IMIN)*PMSQ(K)
      PS(K)=PS(K)/VARB
  500 CONTINUE
C
C     FORM THE PILOT SPECTRUM PLOT
C
      DO900I=1,I2
      IREV=I2-I+1
      JMIN=(120/(2**I))+1
      IF(I.EQ.I2)JMIN=1
      JMAX=120/(2**(I-1))
      DO1000J=JMIN,JMAX
      S(J)=PS(I)
 1000 CONTINUE
  900 CONTINUE
      CALL PLOTSP(S,120,0)
      WRITE(IPR,999)
      WRITE(IPR,1750)
C
C     DEFINE 4 LAG WINDOW TRUNCATION POINTS
C     REFERENCE--JENKINS AND WATTS, PAGES 290 AND 260
C
      P(1)=.2
      P(2)=.1
      P(3)=.05
      P(4)=.025
      P(5)=.01
      LMAX=0
      DO1100I=1,5
      DO1200K=1,KMAX
      KREV=KMAX-K+1 
      RK=R(KREV)
      IF(RK.LT.0.0)RK=-RK
      IF(RK.GE.P(I))LMAX=KREV 
      IF(RK.GE.P(I))GOTO1350
 1200 CONTINUE
 1100 CONTINUE
      IF(LMAX.NE.0)GOTO1350
      RMAX=ABS(R(1))
      DO1300K=1,KMAX
      RK=R(K)
      IF(RK.LT.0.0)RK=-RK
      IF(RK.GE.RMAX)LMAX=K
      IF(RK.GE.RMAX)RMAX=RK
 1300 CONTINUE
 1350 ALMAX=LMAX
      L(1)=(3.0/2.0)*ALMAX
      IF(L(1).LE.32)LMAX=32
      IF(L(1).LE.32)ALMAX=32.0
      IF(L(1).LE.32)L(1)=32
      IF(L(1).GE.KMAX)LMAX=KMAX
      IF(L(1).GE.KMAX)ALMAX=KMAX
      IF(L(1).GE.KMAX)L(1)=KMAX
      L(2)=(ALMAX/2.0)+0.1
      L(3)=(ALMAX/4.0)+0.1
      L(4)=(ALMAX/8.0)+0.1
      IF(L(4).GE.3)NUMSP=4
      IF(L(4).GE.3)GOTO1380
      IF(L(3).GE.3)NUMSP=3
      IF(L(3).GE.3)GOTO1380
      IF(L(2).GE.3)NUMSP=2
      IF(L(2).GE.3)GOTO1380
      IF(L(1).GE.3)NUMSP=1
      IF(L(1).GE.3)GOTO1380
      WRITE(IPR,1390)N
      RETURN
 1380 CONTINUE
C
C     COMPUTE THE 4 SPECTRUM ESTIMATES
C     REFERENCE--JENKINS AND WATTS, PAGES 260 AND 244
C
C     COMPUTE BANDWIDTHS
C     REFERENCE--JENKINS AND WATTS, PAGES 257 AND 252
C
C     COMPUTE DEGREES OF FREEDOM FOR THE SPECTAL DENSITY ESTIMATE AT INDIVIDUAL 
C     FREQUENCIES
C     REFERENCE--JENKINS AND WATTS, PAGES 254 AND 252
C
C     COMPUTE 95 PERCENT CONFIDENCE INTERVAL LENGTHS FOR THE LOG SPECTRAL
C     DENSITY ESTIMATES
C     REFERENCE--JENKINS AND WATTS, PAGES 255 AND 252
C
C     WRITE OUT THE 4 SPECTRUM PLOTS
C
      DO1400I=1,NUMSP
      AL=L(I)
      LM1=L(I)-1
      DO1500LLP1=1,121
      LL=LLP1-1
      ALL=LL
      SUM=0.0
      DO1600K=1,LM1 
      AK=K
      ARG1=PI*AK/AL 
      ARG2=PI*AK*ALL/120.0
      WK=0.0
      IF(K.LE.L(I))WK=0.5*(1.0+COS(ARG1))
      SUM=SUM+R(K)*WK*COS(ARG2)
 1600 CONTINUE
      SUM=2.0+4.0*SUM
      S(LLP1)=SUM
 1500 CONTINUE
      BW=(4.0/3.0)/FLOAT(L(I))
      DF=(8.0/3.0)*AN/FLOAT(L(I))
      IDF=DF+0.5
      CALL PLOTSP(S,121,IDF)
      DFROUN=IDF
      WRITE(IPR,999)
      WRITE(IPR,1760)L(I),BW,DFROUN
 1400 CONTINUE
C
  420 FORMAT(1H ,103HUNDER THE NULL HYPOTHESIS OF WHITE NOISE (AND NORMA
     1LITY), A 2-SIDED 95 PERCENT ACCEPTANCE INTERVAL IS (,F6.4,1H,,F6.4
     1,1H))
  430 FORMAT(1H ,125HUNDER THE NULL HYPOTHESIS, ONLY 5 PERCENT (ON THE A
     1VERAGE) OF THE OBSERVED AUTOCORRELATIONS SHOULD FALL OUTSIDE THIS
     1INTERVAL)
  440 FORMAT(1H ,20HIT IS OBSERVED THAT ,I5,12H OUT OF THE ,I5,11H (THAT
     1 IS, ,F5.1,72H PERCENT) OF THE COMPUTED AUTOCORRELATIONS FALL OUTS
     1IDE OF THIS INTERVAL)
 1390 FORMAT(1H ,45HDUE TO THE SMALL NUMBER OF OBSERVATIONS (N = ,I6,59H
     1), THERE ARE NOT ENOUGH LAGS TO PRODUCE A RELIABLE SPECTRUM)
 1705 FORMAT(1H ,30X, 63HAUTOCORRELATION PLOT--PLOT OF SAMPLE AUTOCORREL
     1ATION VERSUS LAG)
 1710 FORMAT(1H ,10X,29HTHE NUMBER OF OBSERVATIONS = ,I6,10X,56HTHE NUMB
     1ER OF COMPUTED (AND PLOTTED) AUTOCORRELATIONS = ,I6)
 1715 FORMAT(1H ,18HTHE SAMPLE SIZE = ,I6)
 1720 FORMAT(1H ,18HTHE SAMPLE MEAN = ,E15.8)
 1725 FORMAT(1H ,22HTHE SAMPLE VARIANCE = ,E15.8) 
 1730 FORMAT(1H ,32HTHE SAMPLE STANDARD DEVIATION = ,E15.8) 
 1735 FORMAT(1H ,29HTHE BIASED SAMPLE VARIANCE = ,E15.8)
 1750 FORMAT(1H ,50X,14HPILOT SPECTRUM) 
 1760 FORMAT(1H ,17HNUMBER OF LAGS = ,I5,10X,11HBANDWIDTH =,F10.3,10X,21
     1HDEGREES OF FREEDOM = ,F10.3)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE TOL(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT TOL
C
C     PURPOSE--THIS SUBROUTINE COMPUTES NORMAL AND
C              DISTRIBUTION-FREE TOLERANCE LIMITS 
C              FOR THE DATA IN THE INPUT VECTOR X.
C              15 NORMAL TOLERANCE LIMITS ARE COMPUTED; AND 
C              30 DISTRIBUTION-FREE TOLERANCE LIMITS ARE COMPUTED.
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--2 PAGES OF AUTOMATIC PRINTOUT--
C             1 PAGE GIVING NORMAL TOLERANCE LIMITS; AND
C             1 PAGE GIVING DISTRIBUTION-FREE TOLERANCE LIMITS.
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--GARDINER AND HULL, TECHNOMETRICS, 1966, PAGES 115-122
C               --WILKS, ANNALS OF MATHEMATICAL STATISTICS, 1941, PAGE 92
C               --MOOD AND GRABLE, PAGES 416-417
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION PA(6),PC(6),Z1(3),A(6),B(6),C(6),RSMALL(5,6),USMALL(6,6)
      DIMENSION TMIN(3,6),TMAX(3,6)
      DIMENSION P(10),C1(10),C2(10),C3(10)
C
      DATA PA(1),PA(2),PA(3),PA(4),PA(5),PA(6)/50.,75.,90.,95.,99.,99.9/
      DATA PC(1),PC(2),PC(3)/90.,95.,99./
      DATA Z1(1),Z1(2),Z1(3)/-1.28155157,-1.64485363,-2.32634787/
      DATA A(1),A(2),A(3),A(4),A(5),A(6)/.6745,1.1504,1.6449,1.9600,2.57
     158,3.2905/
      DATA B(1),B(2),B(3),B(4),B(5),B(6)/.33734,.57335,.82140,.97910,1.2
     1889,1.64038/
      DATA C(1),C(2),C(3),C(4),C(5),C(6)/-0.15460,-0.02991,.22044,.40675
     1,.85514,1.42601/
      DATA RSMALL(1,1),RSMALL(1,2),RSMALL(1,3),RSMALL(1,4),RSMALL(1,5),
     1RSMALL(1,6)            /1.0505,1.6859,2.2844,2.6463,3.3266,4.0903/
      DATA RSMALL(2,1),RSMALL(2,2),RSMALL(2,3),RSMALL(2,4),RSMALL(2,5),
     1RSMALL(2,6)            /0.8557,1.4333,2.0078,2.3624,3.0368,3.7983/
      DATA RSMALL(3,1),RSMALL(3,2),RSMALL(3,3),RSMALL(3,4),RSMALL(3,5),
     1RSMALL(3,6)            /0.7929,1.3412,1.8979,2.2457,2.9128,3.6708/
      DATA RSMALL(4,1),RSMALL(4,2),RSMALL(4,3),RSMALL(4,4),RSMALL(4,5),
     1RSMALL(4,6)            /0.7622,1.2940,1.8388,2.1815,2.8422,3.5965/
      DATA RSMALL(5,1),RSMALL(5,2),RSMALL(5,3),RSMALL(5,4),RSMALL(5,5),
     1RSMALL(5,6)            /0.7442,1.2654,1.8019,2.1408,2.7963,3.5472/
      DATA USMALL(1,1),USMALL(1,2),USMALL(1,3)/0.,0.,0./
      DATA USMALL(2,1),USMALL(2,2),USMALL(2,3)/7.9579,15.9472,79.7863/
      DATA USMALL(3,1),USMALL(3,2),USMALL(3,3)/3.0808,4.4154,9.9749/
      DATA USMALL(4,1),USMALL(4,2),USMALL(4,3)/2.2658,2.9200,5.1113/
      DATA USMALL(5,1),USMALL(5,2),USMALL(5,3)/1.9393,2.3724,3.6692/
      DATA USMALL(6,1),USMALL(6,2),USMALL(6,3)/1.7621,2.0893,3.0034/
      DATA P(1),P(2),P(3),P(4),P(5),P(6),P(7),P(8),P(9),P(10)
     1/50.,75.,90.,95.,97.5,99.,99.5,99.9,99.95,99.99/
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      RETURN
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE TOL    SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 TOL    SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE TOL    SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     COMPUTE NORMAL TOLERANCE LIMITS
C
C     COMPUTE THE SAMPLE MEAN 
C
      XBAR=0.0
      DO100I=1,N
      XBAR=XBAR+X(I)
  100 CONTINUE
      XBAR=XBAR/AN
C
C     COMPUTE THE SAMPLE STANDARD DEVIATION
C
      VAR=0.0
      DO200I=1,N
      VAR=VAR+(X(I)-XBAR)**2
  200 CONTINUE
      VAR=VAR/(AN-1.0)
      SD=SQRT(VAR)
C
C     COMPUTE THE NORMAL TOLERANCE LIMITS
C
      DO 300 I=1,3
      Z=Z1(I)
      F=N-1
      IF(N.LE.6)U=USMALL(N,I) 
      IF(N.LE.6)GOTO390
      D1=1.0+Z*SQRT(2.0)/SQRT(F)
      D2=2.0*(Z**2-1.0)/(3.0*F)
      D3=(Z**3-7.0*Z)/(9.0*SQRT(2.0)*F**1.5)
      D4=(6.0*Z**4+14.0*Z**2-32.0)/(405.0*F**2.0) 
      D5=(9.0*Z**5+256.0*Z**3-433.0*Z)/(4860.0*SQRT(2.0)*F**2.5)
      D6=(12.0*Z**6-243.0*Z**4-923.0*Z**2+1472.0)/(25515.0*F**3.0)
      D7=(3753.0*Z**7+4353.0*Z**5-289517.0*Z**3-289717.0*Z)/(9185400.0*S
     1QRT(2.0)*F**3.5)
      UNIV=D1+D2+D3-D4+D5+D6-D7
      U=1.0/UNIV
      U=SQRT(U)
  390 DO 400 J=1,6
      R=A(J)+(B(J)/(C(J)+AN)) 
      IF(N.LE.5)R=RSMALL(N,J) 
      AK=R*U
      TMIN(I,J)=XBAR-AK*SD
      TMAX(I,J)=XBAR+AK*SD
  400 CONTINUE
  300 CONTINUE
C
C     WRITE OUT THE NORMAL TOLERANCE LIMITS
C
      WRITE(IPR,998)
      WRITE(IPR,605)N
      WRITE(IPR,999)
      WRITE(IPR,609)
      WRITE(IPR,610)
      WRITE(IPR,999)
      WRITE(IPR,615)XBAR,SD
      WRITE(IPR,999)
      WRITE(IPR,999)
      DO 600 I=1,3
      DO 700 J=1,6
      WRITE(IPR,620)PC(I),PA(J),TMIN(I,J),TMAX(I,J)
  700 CONTINUE
      WRITE(IPR,999)
  600 CONTINUE
C
C
C
C
C     COMPUTE DISTRIBUTION-FREE TOLERANCE LIMITS
C
      K=N/2
      NUMSEC=3
      IF(K.LT.NUMSEC)NUMSEC=K 
C
C     DETERMINE THE SMALLEST 3 AND LARGEST 3 OBSERVATIONS
C
      LOCMIN=1
      XMIN=X(1)
      DO800I=1,N
      IF(X(I).LE.XMIN)LOCMIN=I
      IF(X(I).LE.XMIN)XMIN=X(I)
  800 CONTINUE
      LOCMAX=1
      XMAX=X(1)
      DO850I=1,N
      IF(X(I).GE.XMAX)LOCMAX=I
      IF(X(I).GE.XMAX)XMAX=X(I)
  850 CONTINUE
      DO900I=1,N
      IF(I.NE.LOCMIN)GOTO910
  900 CONTINUE
  910 LOCMN2=I
      XMIN2=X(I)
      DO950I=1,N
      IF(I.EQ.LOCMIN)GOTO950
      IF(X(I).LE.XMIN2)LOCMN2=I
      IF(X(I).LE.XMIN2)XMIN2=X(I)
  950 CONTINUE
      DO1000I=1,N
      IF(I.NE.LOCMAX)GOTO1010 
 1000 CONTINUE
 1010 LOCMX2=I
      XMAX2=X(I)
      DO1050I=1,N
      IF(I.EQ.LOCMAX)GOTO1050 
      IF(X(I).GE.XMAX2)LOCMX2=I
      IF(X(I).GE.XMAX2)XMAX2=X(I)
 1050 CONTINUE
      DO1100I=1,N
      IF(I.NE.LOCMIN.AND.I.NE.LOCMN2)GOTO1110
 1100 CONTINUE
 1110 LOCMN3=I
      XMIN3=X(I)
      DO1150I=1,N
      IF(I.EQ.LOCMIN.OR.I.EQ.LOCMN2)GOTO1150
      IF(X(I).LE.XMIN3)LOCMN3=I
      IF(X(I).LE.XMIN3)XMIN3=X(I)
 1150 CONTINUE
      DO1200I=1,N
      IF(I.NE.LOCMAX.AND.I.NE.LOCMX2)GOTO1210
 1200 CONTINUE
 1210 LOCMX3=I
      XMAX3=X(I)
      DO1250I=1,N
      IF(I.EQ.LOCMAX.OR.I.EQ.LOCMX2)GOTO1250
      IF(X(I).GE.XMAX3)LOCMX3=I
      IF(X(I).GE.XMAX3)XMAX3=X(I)
 1250 CONTINUE
      AN1=AN-1.0
      AN2=AN-2.0
      AN3=AN-3.0
      AN4=AN-4.0
      AN5=AN-5.0
      AN6=AN-6.0
      DO1600I=1,10
      D=P(I)/100.0
      C1(I)=(D**AN1)*(-AN   +AN1*D)
      C1(I)=1.0-C1(I)
      Q=1.0-D
      T=Q*AN
      C1(I)=1.0+AN1*Q
      C1(I)=1.0-(D**AN1)*C1(I)
      C1(I)=C1(I)*100.0
      IF(NUMSEC.EQ.1)GOTO1600 
      A0=6.0*D*D*D
      A1=2.0-7.0*D+11.0*D*D
      A2=-3.0+6.0*D 
      A3=1.0
      C2(I)=A0+A1*T+A2*T*T+A3*T*T*T
      C2(I)=1.0-(D**AN3)*C2(I)/6.0
      C2(I)=C2(I)*100.0
      IF(NUMSEC.EQ.2)GOTO1600 
      A0=120.0*D*D*D*D*D
      A1=24.0-126.0*D+274.0*D*D-326.0*D*D*D+274.0*D*D*D*D
      A2=-50.0+205.0*D-320.0*D*D+225.0*D*D*D
      A3=35.0-100.0*D+85.0*D*D
      A4=-10.0+15.0*D
      A5=1.0D0
      C3(I)=A0+A1*T+A2*T*T+A3*T*T*T+A4*T*T*T*T+A5*T*T*T*T*T 
      C3(I)=1.0-(D**AN5)*C3(I)/120.0
      C3(I)=C3(I)*100.0
 1600 CONTINUE
C
C     WRITE OUT THE DISTRIBUTION-FREE TOLERANCE LIMITS
C
      WRITE(IPR,998)
      WRITE(IPR,205)N
      WRITE(IPR,999)
      WRITE(IPR,209)
      WRITE(IPR,210)
      WRITE(IPR,999)
      WRITE(IPR,999)
      IF(NUMSEC.EQ.1)GOTO1850 
      IF(NUMSEC.EQ.2)GOTO1750 
      DO1700I=1,10
      WRITE(IPR,217)C3(I),P(I),XMIN3,XMAX3
 1700 CONTINUE
      WRITE(IPR,999)
 1750 DO1800I=1,10
      WRITE(IPR,216)C2(I),P(I),XMIN2,XMAX2
 1800 CONTINUE
      WRITE(IPR,999)
 1850 DO1900I=1,10
      WRITE(IPR,215)C1(I),P(I),XMIN,XMAX
 1900 CONTINUE
C
  605 FORMAT(1H ,45H             NORMAL TOLERANCE LIMITS FOR THE ,I6,13H
     1 OBSERVATIONS)
  609 FORMAT(1H ,49H             REFERENCE--CRC HANDBOOK, PAGES 32-35)
  610 FORMAT(1H ,77H             REFERENCE--GARDINER AND HULL, TECHNOMET
     1RICS, 1966, PAGES 115-122)
  615 FORMAT(1H ,27H             SAMPLE MEAN = ,E15.8 ,37H         SAMPL
     1E STANDARD DEVIATION = ,E15.8 )
  620 FORMAT(1H ,7HWE ARE ,F6.2,24H PERCENT CONFIDENT THAT ,F5.2,49H PER
     1CENT OF THE POPULATION IS BETWEEN XBAR-K*S = ,E12.5,16H AND XBAR+K
     1*S = ,E12.5)
  205 FORMAT(1H ,55H            DISTRIBUTION-FREE TOLERANCE LIMITS FOR T
     1HE ,I6,13H OBSERVATIONS)
  209 FORMAT(1H ,51H            REFERENCE--WILKS, ANNALS, 1941, PAGE 92)
  210 FORMAT(1H ,53H            REFERENCE--MOOD AND GRABLE, PAGES 416-41
     17)
  215 FORMAT(1H ,7HWE ARE ,F6.2,24H PERCENT CONFIDENT THAT ,F5.2,45H PER
     1CENT OF THE POPULATION IS BETWEEN XMIN = ,F8.3,14H AND XMAX   = ,F
     18.3)
  216 FORMAT(1H ,7HWE ARE ,F6.2,24H PERCENT CONFIDENT THAT ,F5.2,45H PER
     1CENT OF THE POPULATION IS BETWEEN X2   = ,F8.3,14H AND X(N-1) = ,F
     18.3)
  217 FORMAT(1H ,7HWE ARE ,F6.2,24H PERCENT CONFIDENT THAT ,F5.2,45H PER
     1CENT OF THE POPULATION IS BETWEEN X3   = ,F8.3,14H AND X(N-2) = ,F
     18.3)
  998 FORMAT(1H1)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE TPLT(X,N,NU) 
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT TPLT
C
C     PURPOSE--THIS SUBROUTINE GENERATES A STUDENT'S T
C              PROBABILITY PLOT (WITH INTEGER
C              DEGREES OF FREEDOM PARAMETER VALUE = NU).
C              THE PROTOTYPE STUDENT'S T DISTRIBUTION USED
C              HEREIN IS DEFINED FOR ALL X,
C              AND ITS PROBABILITY DENSITY FUNCTION IS GIVEN
C              IN THE REFERENCES BELOW. 
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 STUDENT'S T 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  STUDENT'S T DISTRIBUTION
C              WITH DEGREES OF FREEDOM PARAMETER VALUE = NU.
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                     --NU     = THE INTEGER NUMBER OF DEGREES
C                                OF FREEDOM.
C                                NU SHOULD BE POSITIVE.
C     OUTPUT--A ONE-PAGE STUDENT'S T PROBABILITY PLOT.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C                 --NU SHOULD BE POSITIVE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, TPPF, NORPPF, 
C                                         PLOT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
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               --NATIONAL BUREAU OF STANDARDS APPLIED MATHMATICS
C                 SERIES 55, 1964, PAGE 949, FORMULA 26.7.5.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--2, 1970, PAGE 102,
C                 FORMULA 11. 
C               --FEDERIGHI, 'EXTENDED TABLES OF THE
C                 PERCENTAGE POINTS OF STUDENT'S T
C                 DISTRIBUTION, JOURNAL OF THE
C                 AMERICAN STATISTICAL ASSOCIATION,
C                 1969, PAGES 683-688.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGES 120-123.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C     UPDATED         --FEBRUARY  1977. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(7500),W(7500)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501))
C
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      IF(NU.LE.0)GOTO60
      HOLD=X(1)
      DO65I=2,N
      IF(X(I).NE.HOLD)GOTO90
   65 CONTINUE
      WRITE(IPR, 9)HOLD
      RETURN
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   60 WRITE(IPR,25) 
      WRITE(IPR,47)NU
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE TPLT   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 TPLT   SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE TPLT   SUBROUTINE HAS THE VALUE 1 *****)
   25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 TPLT   SUBROUTINE IS NON-POSITIVE *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     SORT THE DATA 
C
      CALL SORT(X,N,Y)
C
C     GENERATE UNIFORM ORDER STATISTIC MEDIANS
C
      CALL UNIMED(N,W)
C
C     COMPUTE STUDENT'S T DISTRIBUTION ORDER STATISTIC MEDIANS
C
      DO100I=1,N
      CALL TPPF(W(I),NU,W(I)) 
  100 CONTINUE
C
C     PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS.
C     COMPUTE THE TAIL LENGTH MEASURE OF THE DISTRIBUTION.
C     WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION 
C     AND THE SAMPLE SIZE.
C
      CALL PLOT(Y,W,N)
      Q=.9975
      CALL TPPF(Q,NU,PP9975)
      Q=.0025
      CALL TPPF(Q,NU,PP0025)
      Q=.975
      CALL TPPF(Q,NU,PP975)
      Q=.025
      CALL TPPF(Q,NU,PP025)
      TAU=(PP9975-PP0025)/(PP975-PP025) 
      WRITE(IPR,105)NU,TAU,N
C
C     COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. 
C     COMPUTE LOCATION AND SCALE ESTIMATES
C     FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. 
C     THEN WRITE THEM OUT.
C
      SUM1=0.0
      SUM2=0.0
      DO200I=1,N
      SUM1=SUM1+Y(I)
      SUM2=SUM2+W(I)
  200 CONTINUE
      YBAR=SUM1/AN
      WBAR=SUM2/AN
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO300I=1,N
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) 
      SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) 
      SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 
  300 CONTINUE
      CC=SUM2/SQRT(SUM3*SUM1) 
      YSLOPE=SUM2/SUM3
      YINT=YBAR-YSLOPE*WBAR
      WRITE(IPR,305)CC,YINT,YSLOPE
C
  105 FORMAT(1H ,55HSTUDENT'S T PROBABILITY PLOT WITH DEGREES OF FREEDOM
     1 = ,I8,1X,7H(TAU = ,E15.8,1H),11X,20HTHE SAMPLE SIZE N = ,I7)
  305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X,
     122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) 
C
      RETURN
      END 
      SUBROUTINE TPPF(P,NU,PPF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT TPPF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE FOR THE STUDENT'S T DISTRIBUTION
C              WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU.
C              THE STUDENT'S T DISTRIBUTION USED
C              HEREIN IS DEFINED FOR ALL X,
C              AND ITS PROBABILITY DENSITY FUNCTION IS GIVEN
C              IN THE REFERENCES 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 (EXCLUSIVELY) 
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 STUDENT'S T 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 (EXCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C     OTHER DATAPAC   SUBROUTINES NEEDED--NORPPF. 
C     FORTRAN LIBRARY SUBROUTINES NEEDED--DSIN, DCOS, DSQRT, DATAN.
C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--FOR NU = 1 AND NU = 2, THE PERCENT POINT FUNCTION
C              FOR THE T DISTRIBUTION EXISTS IN SIMPLE CLOSED FORM
C              AND SO THE COMPUTED PERCENT POINTS ARE EXACT.
C            --FOR OTHER SMALL VALUES OF NU (NU BETWEEN 3 AND 6,
C              INCLUSIVELY), THE APPROXIMATION
C              OF THE T PERCENT POINT BY THE FORMULA
C              GIVEN IN THE REFERENCE BELOW IS AUGMENTED
C              BY 3 ITERATIONS OF NEWTON'S METHOD FOR
C              ROOT DETERMINATION.
C              THIS IMPROVES THE ACCURACY--ESPECIALLY FOR
C              VALUES OF P NEAR 0 OR 1. 
C     REFERENCES--NATIONAL BUREAU OF STANDARDS APPLIED MATHMATICS
C                 SERIES 55, 1964, PAGE 949, FORMULA 26.7.5.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--2, 1970, PAGE 102,
C                 FORMULA 11. 
C               --FEDERIGHI, 'EXTENDED TABLES OF THE
C                 PERCENTAGE POINTS OF STUDENT'S T
C                 DISTRIBUTION, JOURNAL OF THE
C                 AMERICAN STATISTICAL ASSOCIATION,
C                 1969, PAGES 683-688.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGES 120-123.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--OCTOBER   1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION PI
      DOUBLE PRECISION SQRT2
      DOUBLE PRECISION DP
      DOUBLE PRECISION DNU
      DOUBLE PRECISION TERM1,TERM2,TERM3,TERM4,TERM5
      DOUBLE PRECISION DPPFN
      DOUBLE PRECISION DPPF,DCON,DARG,Z,S,C
      DOUBLE PRECISION B21
      DOUBLE PRECISION B31,B32,B33,B34
      DOUBLE PRECISION B41,B42,B43,B44,B45
      DOUBLE PRECISION B51,B52,B53,B54,B55,B56
      DOUBLE PRECISION D1,D3,D5,D7,D9
      DATA PI/3.14159265358979D0/
      DATA SQRT2/1.414213562D0/
      DATA B21/0.25D0/
      DATA B31,B32,B33,B34/0.01041666666667D0,5.0D0,16.0D0,3.0D0/
      DATA B41,B42,B43,B44,B45/0.00260416666667D0,3.0D0,19.0D0,17.0D0,
     1                         -15.0D0/ 
      DATA B51,B52,B53,B54,B55,B56/0.00001085069444D0,79.0D0,776.0D0, 
     1                             1482.0D0,-1920.0D0,-945.0D0/
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LE.0.0.OR.P.GE.1.0)GOTO50
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 TPPF   SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      DNU=NU
      DP=P
      MAXIT=5
C
      IF(NU.GE.3)GOTO250
      IF(NU.EQ.1)GOTO100
      IF(NU.EQ.2)GOTO200
      WRITE(IPR,105)
  105 FORMAT(1H ,33HINTERNAL ERROR IN TPPF SUBROUTINE)
      PPF=0.0
      RETURN
C
C     TREAT THE NU = 1 (CAUCHY) CASE
C
  100 DARG=PI*DP
      PPF=-DCOS(DARG)/DSIN(DARG)
      RETURN
C
C     TREAT THE NU = 2 CASE
C
  200 TERM1=SQRT2/2.0D0
      TERM2=2.0D0*DP-1.0D0
      TERM3=DSQRT(DP*(1.0D0-DP))
      PPF=TERM1*TERM2/TERM3
      RETURN
C
C     TREAT THE NU GREATER THAN OR EQUAL TO 3 CASE
C
  250 CALL NORPPF(P,PPFN)
      DPPFN=PPFN
      D1=DPPFN
      D3=DPPFN**3
      D5=DPPFN**5
      D7=DPPFN**7
      D9=DPPFN**9
      TERM1=D1
      TERM2=B21*(D3+D1)/DNU
      TERM3=B31*(B32*D5+B33*D3+B34*D1)/(DNU**2)
      TERM4=B41*(B42*D7+B43*D5+B44*D3+B45*D1)/(DNU**3)
      TERM5=B51*(B52*D9+B53*D7+B54*D5+B55*D3+B56*D1)/(DNU**4)
      DPPF=TERM1+TERM2+TERM3+TERM4+TERM5
      PPF=DPPF
      IF(NU.GE.7)RETURN
      IF(NU.EQ.3)GOTO300
      IF(NU.EQ.4)GOTO400
      IF(NU.EQ.5)GOTO500
      IF(NU.EQ.6)GOTO600
      RETURN
C
C     AUGMENT THE RESULTS FOR THE NU = 3 CASE
C
  300 DCON=PI*(DP-0.5D0)
      DARG=DPPF/DSQRT(DNU)
      Z=DATAN(DARG) 
      DO350IPASS=1,MAXIT
      S=DSIN(Z)
      C=DCOS(Z)
      Z=Z-(Z+S*C-DCON)/(2.0D0*C*C)
  350 CONTINUE
      PPF=DSQRT(DNU)*S/C
      RETURN
C
C     AUGMENT THE RESULTS FOR THE NU = 4 CASE
C
  400 DCON=2.0D0*(DP-0.5D0)
      DARG=DPPF/DSQRT(DNU)
      Z=DATAN(DARG) 
      DO450IPASS=1,MAXIT
      S=DSIN(Z)
      C=DCOS(Z)
      Z=Z-((1.0D0+0.5D0*C*C)*S-DCON)/(1.5D0*C*C*C)
  450 CONTINUE
      PPF=DSQRT(DNU)*S/C
      RETURN
C
C     AUGMENT THE RESULTS FOR THE NU = 5 CASE
C
  500 DCON=PI*(DP-0.5D0)
      DARG=DPPF/DSQRT(DNU)
      Z=DATAN(DARG) 
      DO550IPASS=1,MAXIT
      S=DSIN(Z)
      C=DCOS(Z)
      Z=Z-(Z+(C+(2.0D0/3.0D0)*C*C*C)*S-DCON)/((8.0D0/3.0D0)*C**4)
  550 CONTINUE
      PPF=DSQRT(DNU)*S/C
      RETURN
C
C     AUGMENT THE RESULTS FOR THE NU = 6 CASE
C
  600 DCON=2.0D0*(DP-0.5D0)
      DARG=DPPF/DSQRT(DNU)
      Z=DATAN(DARG) 
      DO650IPASS=1,MAXIT
      S=DSIN(Z)
      C=DCOS(Z)
      Z=Z-((1.0D0+0.5D0*C*C+0.375D0*C**4)*S-DCON)/((15.0D0/8.0D0)*C**5)
  650 CONTINUE
      PPF=DSQRT(DNU)*S/C
      RETURN
C
      END 
      SUBROUTINE TRAN(N,NU,ISEED,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT TRAN
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE STUDENT'S T 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 T
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 STUDENT'S T 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--MOOD AND GRABLE, INTRODUCTION TO THE
C                 THEORY OF STATISTICS, 1963, PAGE 233.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--2, 1970, PAGE 94.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGE 121.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82.6
C     ORIGINAL VERSION--NOVEMBER  1975.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
      DIMENSION Y(2),Z(2)
C
C---------------------------------------------------------------------
C
CCCCC CHARACTER*4 IFEEDB
CCCCC CHARACTER*4 IPRINT
C
CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
CCCCC COMMON /PRINT/IFEEDB,IPRINT
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA PI/3.14159265359/
C
      IPR=6
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(NU.LE.0)GOTO60
      GOTO90
   50 WRITE(IPR,5)
      WRITE(IPR,47)N
      RETURN
   60 WRITE(IPR,15)
      WRITE(IPR,47)NU
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 TRAN   SUBROUTINE IS NON-POSITIVE *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 TRAN   SUBROUTINE IS NON-POSITIVE *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C     GENERATE N STUDENT'S T RANDOM NUMBERS
C     USING THE DEFINITION THAT
C     A STUDENT'S T VARIATE WITH NU DEGREES OF FREEDOM
C     EQUALS A NORMAL VARIATE DIVIDED BY
C     A STANDARDIZED CHI VARIATE
C     (WHERE THE LATTER EQUALS SQRT(CHI-SQUARED/NU).
C     FIRST GENERATE A NORMAL RANDOM NUMBER,
C     THEN GENERATE A STANDARDIZED CHI RANDOM NUMBER,
C     THEN FORM THE RATIO OF THE FIRST DIVIDED BY
C     THE SECOND.
C
      ANU=NU
      DO100I=1,N
C
      CALL UNIRAN(2,ISEED,Y)
      ARG1=-2.0*ALOG(Y(1))
      ARG2=2.0*PI*Y(2)
      ZNORM=(SQRT(ARG1))*(COS(ARG2))
C
      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
C
      X(I)=ZNORM/SQRT(SUM/ANU)
C
  100 CONTINUE
C
      RETURN
      END
      SUBROUTINE TRIM(X,N,P1,P2,IWRITE,XTRIM)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT TRIM
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SAMPLE TRIMMED MEAN
C              OF THE DATA IN THE INPUT VECTOR X. 
C              THE TRIMMING IS SUCH THAT
C              THE LOWER 100*P1 % OF THE DATA IS TRIMMED OFF
C              AND THE UPPER 100*P2 % OF THE DATA IS TRIMMED OFF.
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                     --P1     = THE SINGLE PRECISION VALUE 
C                                (BETWEEN 0.0 AND 1.0)
C                                WHICH DEFINES WHAT FRACTION
C                                OF THE LOWER ORDER STATISTICS
C                                IS TO BE TRIMMED OFF
C                                BEFORE COMPUTING THE TRIMMED MEAN.
C                     --P2     = THE SINGLE PRECISION VALUE 
C                                (BETWEEN 0.0 AND 1.0)
C                                WHICH DEFINES WHAT FRACTION
C                                OF THE UPPER ORDER STATISTICS
C                                IS TO BE TRIMMED OFF
C                                BEFORE COMPUTING THE TRIMMED MEAN.
C                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SAMPLE TRIMMED MEAN
C                                AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SAMPLE TRIMMED MEAN
C                                AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--XTRIM  = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE TRIMMED MEAN
C                                WHERE 100*P1 % OF THE SMALLEST
C                                AND 100*P2 % OF THE LARGEST
C                                ORDERED OBSERVATIONS HAVE BEEN
C                                TRIMMED AWAY BEFORE COMPUTING THE
C                                MEAN OF THE REMAINING OBSERVATIONS
C                                IN THE MIDDLE.
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE TRIMMED MEAN
C             WHERE 100*P1 % OF THE SMALLEST
C             AND   100*P2 % OF THE LARGEST
C             ORDERED OBSERVATIONS HAVE BEEN TRIMMED AWAY.
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 15000. 
C                 --P1 SHOULD BE NON-NEGATIVE.
C                 --P1 SHOULD BE SMALLER THAN 1.0 
C                 --P2 SHOULD BE NON-NEGATIVE.
C                 --P2 SHOULD BE SMALLER THAN 1.0 
C                 --THE SUM OF P1 AND P2 SHOULD BE
C                   SMALLER THAN 1.0.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--DAVID, ORDER STATISTICS, 1970, PAGES 126-130, 136.
C               --CROW AND SIDDIQUI, 'ROBUST ESTIMATION OF LOCATION', 
C                 JOURNAL OF THE AMERICAN STATISTICAL ASSOCIATION,
C                 1967, PAGES 357, 387. 
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).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(15000)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1))
C
      IPR=6
      IUPPER=15000
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      AN=N
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO65
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      XTRIM=X(1)
      GOTO201
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XTRIM=X(1)
      GOTO201
   65 IF(P1.LT.0.0.OR.P1.GE.1.0)GOTO66
      GOTO70
   66 WRITE(IPR,27) 
      WRITE(IPR,48)P1
      XTRIM=0.0
      RETURN
   70 IF(P2.LT.0.0.OR.P2.GE.1.0)GOTO71
      GOTO75
   71 WRITE(IPR,37) 
      WRITE(IPR,48)P2
      XTRIM=0.0
      RETURN
   75 PSUM=P1+P2
      IF(PSUM.LT.0.0.OR.PSUM.GE.1.0)GOTO76
      GOTO90
   76 WRITE(IPR,42) 
      WRITE(IPR,43)P1
      WRITE(IPR,44)P2
      WRITE(IPR,45)PSUM
      XTRIM=0.0
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE TRIM   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 TRIM   SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE TRIM   SUBROUTINE HAS THE VALUE 1 *****)
   27 FORMAT(1H ,121H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 TRIM   SUBROUTINE IS OUTSIDE THE ALLOWABLE (0.0,1.0)   INTERVAL *
     1****)
   37 FORMAT(1H ,121H***** FATAL ERROR--THE FOURTH INPUT ARGUMENT TO THE
     1 TRIM   SUBROUTINE IS OUTSIDE THE ALLOWABLE (0.0,1.0)   INTERVAL *
     1****)
   42 FORMAT(1H , 46H***** FATAL ERROR--THE SUM OF INPUT ARGUMENTS ,
     1 58H3 AND 4 TO THE TRIM   SUBROUTINE IS OUTSIDE THE ALLOWABLE , 
     1 24H(0.0,1.0) INTERVAL *****)
   43 FORMAT(1H ,37H                  INPUT ARGUMENT 3   ,
     1 19H                 = ,E15.8)
   44 FORMAT(1H ,37H                  INPUT ARGUMENT 4   ,
     1 19H                 = ,E15.8)
   45 FORMAT(1H ,37H                  INPUT ARGUMENT 3 + ,
     1 19HINPUT ARGUMENT 4 = ,E15.8)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
   48 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      CALL SORT(X,N,Y)
C
      AN=N
      NP1=P1*AN+0.0001
      ISTART=NP1+1
      NP2=P2*AN+0.0001
      ISTOP=N-NP2
      SUM=0.0
      K=0 
      IF(ISTART.GT.ISTOP)GOTO150
      DO100I=ISTART,ISTOP
      K=K+1
      SUM=SUM+X(I)
  100 CONTINUE
      AK=K
      XTRIM=SUM/AK
      GOTO170
  150 WRITE(IPR,155)
  155 FORMAT(1H ,37HINTERNAL ERROR IN TRIM   SUBROUTINE--,
     1 45HTHE START INDEX IS HIGHER THAN THE STOP INDEX)
      XTRIM=0.0
      RETURN
  170 CONTINUE
C
  201 IF(IWRITE.EQ.0)RETURN
      PERP1=100.0*P1
      PERP2=100.0*P2
      PERP3=100.0-PERP1-PERP2 
      WRITE(IPR,999)
      WRITE(IPR,105)N,XTRIM
      WRITE(IPR,110)PERP1,NP1 
      WRITE(IPR,115)PERP2,NP2 
      WRITE(IPR,120)PERP3,K
  105 FORMAT(1H ,31HTHE SAMPLE TRIMMED MEAN OF THE ,I6,13H OBSERVATIONS,
     1  4H IS ,E15.8)
  110 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) ,
     1 39HOF THE DATA WERE TRIMMED     FROM BELOW)
  115 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) ,
     1 39HOF THE DATA WERE TRIMMED     FROM ABOVE)
  120 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) ,
     1 52H OF THE DATA REMAIN IN THE MIDDLE AFTER THE TRIMMING)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE UNICDF(X,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT UNICDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE FOR THE UNIFORM (RECTANGULAR) 
C              DISTRIBUTION ON THE UNIT INTERVAL (0,1).
C              THIS DISTRIBUTION HAS MEAN = 0.5
C              AND STANDARD DEVIATION = SQRT(1/12) = 0.28867513.
C              THIS DISTRIBUTION HAS THE PROBABILITY
C              DENSITY FUNCTION F(X) = 1.
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 UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--X SHOULD BE BETWEEN 0 AND 1, INCLUSIVELY.
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--2, 1970, PAGES 57-74.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(X.LT.0.0.OR.X.GT.1.0)GOTO50
      GOTO90
   50 WRITE(IPR,2)
      WRITE(IPR,46)X
      IF(X.LT.0.0)CDF=0.0
      IF(X.GT.1.0)CDF=1.0
      RETURN
   90 CONTINUE
    2 FORMAT(1H ,120H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE UNICDF SUBROUTINE IS OUTSIDE THE USUAL (0,1) INTERVAL **
     1***)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      CDF=X
C
      RETURN
      END 
      SUBROUTINE UNIMED(N,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT UNIMED
C
C     PURPOSE--THIS SUBROUTINE GENERATES THE N ORDER STATISTIC MEDIANS
C              FROM THE UNIFORM (RECTANGULAR)
C              DISTRIBUTION ON THE UNIT INTERVAL (0,1).
C              THIS DISTRIBUTION HAS MEAN = 0.5
C              AND STANDARD DEVIATION = SQRT(1/12) = 0.28867513.
C              THIS DISTRIBUTION HAS THE PROBABILITY
C              DENSITY FUNCTION F(X) = 1.
C              THIS SUBROUTINE IS A SUPPORT SUBROUTINE FOR
C              ALL OF THE PROBABILITY PLOT SUBROUTINES
C              IN DATAPAC; IT IS RARELY USED BY THE
C              DATA ANALYST DIRECTLY.
C              A PROBABILITY PLOT FOR A GENERAL DISTRIBUTION
C              IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS 
C              THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION.
C              THE I-TH ORDER STATISTIC MEDIAN FOR A GENERAL
C              DISTRIBUTION IS OBTAINED BY TRANSFORMING
C              THE I-TH UNIFORM ORDER STATISTIC MEDIAN
C              BY THE PERCENT POINT FUNCTION OF THE DESIRED 
C              DISTRIBUTION--HENCE THE IMPORTANCE OF BEING ABLE TO
C              GENERATE UNIFORM ORDER STATISTIC MEDIANS.
C              IT IS OF THEROETICAL INTEREST TO NOTE THAT
C              THE I-TH UNIFORM ORDER STATISTIC MEDIAN
C              IN A SAMPLE OF SIZE N IS IDENTICALLY THE
C              MEDIAN OF THE BETA DISTRIBUTION
C              WITH PARAMETERS I AND N-I+1.
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER 
C                                OF UNIFORM ORDER STATISTIC MEDIANS
C                                TO BE GENERATED. 
C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
C                                (OF DIMENSION AT LEAST N)
C                                INTO WHICH THE GENERATED
C                                UNIFORM ORDER STATISTIC MEDIANS
C                                WILL BE PLACED.
C     OUTPUT--THE N ORDER STATISTIC MEDIANS
C             FROM THE RECTANGULAR DISTRIBUTION ON (0,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--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--FILLIBEN, 'THE PROBABILITY PLOT CORRELATION COEFFICIENT
C                 TEST FOR NORMALITY', TECHNOMETRICS, 1975, PAGES 111-117.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      GOTO90
   50 WRITE(IPR, 5) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR, 8) 
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 UNIMED SUBROUTINE IS NON-POSITIVE *****)
    8 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE UNIMED SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     COMPUTE THE MEDIANS FOR THE FIRST AND LAST ORDER STATISTICS
C
      X(N)=0.5**(1.0/AN)
      X(1)=1.0-X(N) 
C
C     DETERMINE IF AN ODD OR EVEN SAMPLE SIZE
C
      NHALF=(N/2)+1 
      NEVODD=2*(N/2)
      IF(N.NE.NEVODD)X(NHALF)=0.5
      IF(N.LE.3)RETURN
C
C     COMPUTE THE MEDIANS FOR THE OTHER ORDER STATISTICS
C
      GAM=0.3175
      IMAX=N/2
      DO100I=2,IMAX 
      AI=I
      IREV=N-I+1
      X(I)=(AI-GAM)/(AN-2.0*GAM+1.0)
      X(IREV)=1.0-X(I)
  100 CONTINUE
C
      RETURN
      END 
      SUBROUTINE UNIPDF(X,PDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT UNIPDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY
C              FUNCTION VALUE FOR THE UNIFORM (RECTANGULAR) 
C              DISTRIBUTION ON THE UNIT INTERVAL (0,1).
C              THIS DISTRIBUTION HAS MEAN = 0.5
C              AND STANDARD DEVIATION = SQRT(1/12) = 0.28867513.
C              THIS DISTRIBUTION HAS THE PROBABILITY
C              DENSITY FUNCTION F(X) = 1.
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 UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--X SHOULD BE BETWEEN 0 AND 1, INCLUSIVELY.
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--2, 1970, PAGES 57-74.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(X.LT.0.0.OR.X.GT.1.0)GOTO50
      GOTO90
   50 WRITE(IPR,2)
      WRITE(IPR,46)X
      PDF=0.0
      RETURN
   90 CONTINUE
    2 FORMAT(1H ,120H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE UNIPDF SUBROUTINE IS OUTSIDE THE USUAL (0,1) INTERVAL **
     1***)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      PDF=1.0
C
      RETURN
      END 
      SUBROUTINE UNIPLT(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT UNIPLT
C
C     PURPOSE--THIS SUBROUTINE GENERATES A UNIFORM
C              PROBABILITY PLOT.
C              THE PROTOTYPE UNIFORM DISTRIBUTION USED HEREIN
C              IS DEFINED ON THE UNIT INTERVAL (0,1).
C              THIS DISTRIBUTION HAS MEAN = 0.5
C              AND STANDARD DEVIATION = SQRT(1/12) = 0.28867513.
C              THIS DISTRIBUTION HAS
C              THE PROBABILITY DENSITY FUNCTION
C              F(X) = 1.
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 UNIFORM 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 UNIFORM 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--A ONE-PAGE UNIFORM PROBABILITY PLOT.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, PLOT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
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--2, 1970, PAGES 57-74.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(7500),W(7500)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501))
C
      DATA TAU/1.04736842/
C
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      GOTO90
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE UNIPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 UNIPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE UNIPLT SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     SORT THE DATA 
C
      CALL SORT(X,N,Y)
C
C     GENERATE UNIFORM ORDER STATISTIC MEDIANS
C
      CALL UNIMED(N,W)
C
C     PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS.
C     WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION 
C     AND THE SAMPLE SIZE.
C
      CALL PLOT(Y,W,N)
      WRITE(IPR,105)TAU,N
C
C     COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. 
C     COMPUTE LOCATION AND SCALE ESTIMATES
C     FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. 
C     THEN WRITE THEM OUT.
C
      SUM1=0.0
      DO200I=1,N
      SUM1=SUM1+Y(I)
  200 CONTINUE
      YBAR=SUM1/AN
      WBAR=0.5
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO300I=1,N
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) 
      SUM2=SUM2+(W(I)-0.5)*(Y(I)-YBAR)
      SUM3=SUM3+(W(I)-0.5)*(W(I)-0.5)
  300 CONTINUE
      CC=SUM2/SQRT(SUM3*SUM1) 
      YSLOPE=SUM2/SUM3
      YINT=YBAR-YSLOPE*WBAR
      WRITE(IPR,305)CC,YINT,YSLOPE
C
  105 FORMAT(1H ,32HUNIFORM PROBABILITY PLOT (TAU = ,E15.8,1H),55X,20HTH
     1E SAMPLE SIZE N = ,I7)
  305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X,
     122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) 
C
      RETURN
      END 
      SUBROUTINE UNIPPF(P,PPF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT UNIPPF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE FOR THE UNIFORM (RECTANGULAR) 
C              DISTRIBUTION ON THE UNIT INTERVAL (0,1).
C              THIS DISTRIBUTION HAS MEAN = 0.5
C              AND STANDARD DEVIATION = SQRT(1/12) = 0.28867513.
C              THIS DISTRIBUTION HAS THE PROBABILITY
C              DENSITY FUNCTION F(X) = 1.
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, INCLUSIVELY.
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--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--2, 1970, PAGES 57-74.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LT.0.0.OR.P.GT.1.0)GOTO50
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 UNIPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      PPF=P
C
      RETURN
      END 
      SUBROUTINE UNIRAN(N,ISEED,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT UNIRAN
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE UNIFORM (RECTANGULAR)
C              DISTRIBUTION ON THE UNIT INTERVAL (0,1).
C              THIS DISTRIBUTION HAS MEAN = 0.5
C              AND STANDARD DEVIATION = SQRT(1/12) = 0.28867513.
C              THIS DISTRIBUTION HAS THE PROBABILITY
C              DENSITY FUNCTION F(X) = 1.
C
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER 
C                                OF RANDOM NUMBERS TO BE
C                                GENERATED.
C                     --ISEED  = AN INTEGER ISEED VALUE
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 RECTANGULAR DISTRIBUTION ON (0,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           SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C
C     ALGORITHM--FIBONACCI GENERATOR
C                AS DEFINED BY GEORGE MARSAGLIA.
C
C     NOTE--THIS GENERATOR IS TRANSPORTABLE.
C           IT IS NOT MACHINE-INDEPENDENT
C           IN THE SENSE THAT FOR A GIVEN VALUE
C           OF THE INPUT SEED ISEED AND FOR A GIVEN VALUE
C           OF MDIG (TO BE DEFINED BELOW),
C           THE SAME SEQUENCE OF UNIRFORM RANDOM
C           NUMBERS WILL RESULT ON DIFFERENT COMPUTERS
C           (VAX, PRIME, PERKIN-ELMER, IBM, UNIVAC, HONEYWELL, ETC.)
C
C     NOTE--IF MDIG = 32 AND IF ISEED = 305,
C           THEN THE OUTPUT FROM THIS GENERATOR SHOULD BE AS FOLLOWS--
C           THE FIRST      NUMBER TO RESULT IS .4771580...
C           THE SECOND     NUMBER TO RESULT IS .4219293...
C           THE THIRD      NUMBER TO RESULT IS .6646181...
C           ...
C           THE THOUSANDTH NUMBER TO RESULT IS .2036834...
C
C     NOTE--IF MDIG = 16 AND IF ISEED = 305,
C           THEN THE OUTPUT FROM THIS GENERATOR SHOULD BE AS FOLLOWS--
C           THE FIRST      NUMBER TO RESULT IS .027832881...
C           THE SECOND     NUMBER TO RESULT IS .56102176... 
C           THE THIRD      NUMBER TO RESULT IS .41456343... 
C           ...
C           THE THOUSANDTH NUMBER TO RESULT IS .19797357... 
C
C     NOTE--IT IS RECOMMENDED THAT UPON 
C           IMPLEMENTATION OF DATAPLOT, THE OUTPUT
C           FROM UNIRAN BE CHECKED FOR AGREEMENT
C           WITH THE ABOVE SAMPLE OUTPUT.
C           ALSO, THERE ARE MANY ANALYSIS AND DIAGNOSTIC
C           TOOLS IN DATAPLOT THAT WILL ALLOW THE 
C           TESTING OF THE RANDOMNESS AND UNIFORMITY
C           OF THIS GENERATOR.
C           SUCH CHECKING IS ESPECIALLY IMPORTANT 
C           IN LIGHT OF THE FACT THAT OTHER DATAPLOT RANDOM 
C           NUMBER GENERATOR SUBROUTINES (NORRAN--NORMAL,
C           LOGRAN--LOGISTIC, ETC.) ALL MAKE USE OF INTERMEDIATE
C           OUTPUT FROM UNIRAN.
C
C     NOTE--THE OUTPUT FROM THIS SUBROUTINE DEPENDS
C           ON THE INPUT SEED (ISEED) AND ON THE
C           VALUE OF MDIG.
C           MDIG MAY NOT BE SMALLER THAN 16.
C           MDIG MAY NOT BE LARGER THAN MAX INTEGER ON YOUR COMPUTER. 
C
C     NOTE--BECAUSE OF THE PREPONDERANCE OF MAINFRAMES
C           WHICH HAVE WORDS OF 32 BITS AND LARGER
C           (E.G, VAX (= 32 BITS), UNIVAC (= 36 BITS), CDC (= 60 BITS), ETC.)
C           MDIG HAS BEEN SET TO 32.
C           THUS THE SAME SEQUENCE OF RANDOM NUMBERS SHOULD RESULT
C           ON ALL OF THESE COMPUTERS.
C
C     NOTE--FOR SMALLER WORD SIZE COMPUTERS (E.G., 24-BIT AND 16-BIT),
C           THE VALUE OF MDIG SHOULD BE CHANGED TO 24 OR 16.
C           IN SUCH CASE, THE OUTPUT WILL NOT BE IDENTICAL TO
C           THE OUTPUT WHEN MDIG = 32.
C
C     NOTE--THE CYCLE OF THE RANDOM NUMBERS DEPENDS ON MDIG.
C           THE CYCLE FROM MDIG = 32 IS LONG ENOUGH FOR MOST
C           PRACTICAL APPLICATIONS.
C           IF A LONGER CYCLE IS DESIRED, THEN INCREASE MDIG.
C
C     NOTE--THE SEED MAY BE ANY POSITIVE INTEGER. 
C           NO APPRECIABLE DIFFERENCE IN THE QUALITY
C           OF THE RANDOM NUMBERS HAS BEEN NOTED
C           BY THE CHOICE OF THE SEED.  THERE IS NO
C           NEED TO USE PRIMES, NOR TO USE EXCEPTIONALLY
C           LARGE NUMBERS, ETC.
C
C     REFERENCES--MARSAGLIA G., "COMMENTS ON THE PERFECT UNIFORM RANDOM
C                 NUMBER GENERATOR", UNPUBLISHED NOTES, WASH S. U.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--2, 1970, PAGES 57-74.
C     WRITTEN BY--JAMES BLUE
C                 SCIENTIFIC COMPUTING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C               --DAVID KAHANER
C                 SCIENTIFIC COMPUTING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C               --GEORGE MARSAGLIA
C                 COMPUTER SCIENCE DEPARTMENT
C                 WASHINGTON STATE UNIVERSITY
C               --JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C
C     LANGUAGE--ANSI FORTRAN (1977)
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --AUGUST    1974. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --NOVEMBER  1981. 
C     UPDATED         --MAY       1982. 
C     UPDATED         --MARCH     1984. 
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
C
      DIMENSION M(17)
C
C---------------------------------------------------------------------
C
CCCCC CHARACTER*4 IFEEDB
CCCCC CHARACTER*4 IPRINT
C
CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
CCCCC COMMON /PRINT/IFEEDB,IPRINT
C
C-----SAVE STATEMENTS-------------------------------------------------
C
      SAVE I,J,M,M1,M2
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA M(1),M(2),M(3),M(4),M(5),M(6),M(7),M(8),M(9),M(10),M(11),
     1     M(12),M(13),M(14),M(15),M(16),M(17)
     1/    30788,23052,2053,19346,10646,19427,23975,
     1     19049,10949,19693,29746,26748,2796,23890,
     1     29168,31924,16499/ 
      DATA M1,M2,I,J / 32767,256,5,17 / 
C
      IPR=6
C
C-----START POINT-----------------------------------------------------
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.1)GOTO90
      WRITE(IPR,999)
  999 FORMAT(1H )
      WRITE(IPR,51) 
   51 FORMAT(1H ,'***** ERROR IN UNIRAN--')
      WRITE(IPR,52) 
   52 FORMAT(1H ,'      THE INPUT NUMBER OF OBSERVATIONS IS ',
     1'NON-POSITIVE.')
      WRITE(IPR,53)N
   53 FORMAT(1H ,'      N = ',I8)
      GOTO9000
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  IF A POSITIVE INPUT SEED HAS BEEN GIVEN,         **
C               **  THEN THIS INDICATES THAT THE GENERATOR           **
C               **  SHOULD HAVE ITS INTERNAL M(.) ARRAY REDEFINED--  **
C               **  DO SO IN THIS SECTION.                           **
C               **  IF A NON-POSITIVE INPUT SEED HAS BEEN GIVEN,     **
C               **  THEN THIS INDICATES THAT THE GENERATOR           **
C               **  SHOULD CONTINUE ON FROM WHERE IT LEFT OFF,       **
C               **  AND THEREFORE THIS SECTION IS SKIPPED.           **
C               *******************************************************
C
      IF(ISEED.LE.0)GOTO290
C
CCCCC MDIG=16
      MDIG=32
C
      M1=2**(MDIG-2)+(2**(MDIG-2)-1)
      M2=2**(MDIG/2)
CCCCC ISEED3=MIN0(IABS(ISEED),M1)
      ISEED3=IABS(ISEED)
      IF(M1.LT.IABS(ISEED))ISEED3=M1
      IF(MOD(ISEED3,2).EQ.0)ISEED3=ISEED3-1
      K0=MOD(9069,M2)
      K1=9069/M2
      J0=MOD(ISEED3,M2)
      J1=ISEED3/M2
C
      DO200I=1,17
      ISEED3=J0*K0
      J1=MOD(ISEED3/M2+J0*K1+J1*K0,M2/2)
      J0=MOD(ISEED3,M2)
      M(I)=J0+M2*J1 
  200 CONTINUE
C
      I=5 
      J=17
C
  290 CONTINUE
C
C               *************************************
C               **  STEP 3--                       **
C               **  GENERATE THE N RANDOM NUMBERS  **
C               *************************************
C
      DO300L=1,N
      K=M(I)-M(J)
      IF(K.LT.0)K=K+M1
      M(J)=K
      I=I-1
      IF(I.EQ.0)I=17
      J=J-1
      IF(J.EQ.0)J=17
      AK=K
      AM1=M1
      X(L)=AK/AM1
  300 CONTINUE
C
C               ***************************************************** 
C               **  STEP 4--                                       ** 
C               **  REGARDLESS OF THE VALUE OF THE INPUT SEED,     ** 
C               **  REDEFINE THE VALUE OF ISEED UPON EXIT HERE     ** 
C               **  TO -1 WITH THE NET EFFECT THAT                 ** 
C               **  IF THE USER DOES NOT REDEFINE THE SEED         ** 
C               **  VALUE BEFORE THE NEXT CALL TO THIS GENERATOR,  ** 
C               **  THEN THIS GENERATOR WILL PICK UP               ** 
C               **  WHERE IT LEFT OFF.                             ** 
C               ***************************************************** 
C
      ISEED=(-1)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      RETURN
CCCCC DEBUG TRACE,INIT
CCCCC AT 90
CCCCC TRACE ON
      END 
      SUBROUTINE UNISF(P,SF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT UNISF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE SPARSITY
C              FUNCTION VALUE FOR THE UNIFORM (RECTANGULAR) 
C              DISTRIBUTION ON THE UNIT INTERVAL (0,1).
C              THIS DISTRIBUTION HAS MEAN = 0.5
C              AND STANDARD DEVIATION = SQRT(1/12) = 0.28867513.
C              THIS DISTRIBUTION HAS THE PROBABILITY
C              DENSITY FUNCTION F(X) = 1.
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 SPARSITY
C                                FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION
C             SPARSITY FUNCTION VALUE SF.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--P SHOULD BE BETWEEN 0.0 AND 1.0, INCLUSIVELY.
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--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--2, 1970, PAGES 57-74.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LT.0.0.OR.P.GT.1.0)GOTO50
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 UNISF  SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      SF=1.0
C
      RETURN
      END 
      SUBROUTINE VAR(X,N,IWRITE,XVAR)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT VAR
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SAMPLE VARIANCE (WITH DENOMINATOR N-1)
C              OF THE DATA IN THE INPUT VECTOR X. 
C              THE SAMPLE VARIANCE = (THE SUM OF THE
C              SQUARED DEVIATIONS ABOUT THE SAMPLE MEAN)/(N-1).
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                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SAMPLE VARIANCE
C                                AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SAMPLE VARIANCE
C                                AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--XVAR   = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE VARIANCE.
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE VARIANCE (WITH DENOMINATOR N-1).
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--SNEDECOR AND COCHRAN, STATISTICAL METHODS,
C                 EDITION 6, 1967, PAGE 44.
C               --DIXON AND MASSEY, INTRODUCTION TO STATISTICAL
C                 ANALYSIS, EDITION 2, 1957, PAGE 38.
C               --MOOD AND GRABLE, 'INTRODUCTION TO THE THEORY
C                 OF STATISTICS, EDITION 2, 1963, PAGE 171. 
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      AN=N
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      XVAR=0.0
      GOTO201
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XVAR=0.0
      GOTO201
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE VAR    SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 VAR    SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE VAR    SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      SUM=0.0
      DO100I=1,N
      SUM=SUM+X(I)
  100 CONTINUE
      XMEAN=SUM/AN
      SUM=0.0
      DO200I=1,N
      SUM=SUM+(X(I)-XMEAN)**2 
  200 CONTINUE
      XVAR=SUM/(AN-1.0)
C
  201 IF(IWRITE.EQ.0)RETURN
      WRITE(IPR,999)
      WRITE(IPR,205)N,XVAR
  205 FORMAT(1H ,27HTHE SAMPLE VARIANCE OF THE ,I6,17H OBSERVATIONS IS ,
     1E15.8)
  999 FORMAT(1H )
      RETURN
      END 
      SUBROUTINE WEIB(X,N)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT WEIB
C
C     PURPOSE--THIS SUBROUTINE PERFOMS A WEIBULL DISTRIBUTION ANALYSIS
C              ON THE DATA IN THE INPUT VECTOR X. 
C              THIS ANALYSIS CONSISTS OF DETERMINING THAT PARTICULAR
C              WEIBULL DISTRIBUTION
C              WHICH BEST FITS THE DATA SET.
C              THE GOODNESS OF FIT CRITERION IS THE MAXIMUM PROBABILITY
C              PLOT CORRELATION COEFFICIENT CRITERION.
C              AFTER THE BEST-FIT DISTRIBUTION IS DETERMINED,
C              ESTIMATES ARE COMPUTED AND PRINTED OUT FOR THE
C              LOCATION AND SCALE PARAMETERS.
C              TWO PROBABILITY PLOTS ARE ALSO PRINTED OUT-- 
C              THE BEST-FIT WEIBULL PROBABILITY PLOT
C              AND AN EXTREME VALUE TYPE 1 PROBABILITY PLOT 
C              (THIS IS DUE TO THE FACT THAT AS THE WEIBULL PARAMETER 
C              GAMMA APPROACHES INFINITY, THE WEIBULL DISTRIBUTION
C              APPROACHES THE EXTREME VALUE TYPE 1 DISTRIBUTION).
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--4 PAGES OF AUTOMATIC PRINTOUT.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, WEIPLT,
C                                         EV1PLT, PLOT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT AND ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCE--FILLIBEN (1972), 'TECHNIQUES FOR TAIL LENGTH
C                ANALYSIS', PROCEEDINGS OF THE EIGHTEENTH
C                CONFERENCE ON THE DESIGN OF EXPERIMENTS IN 
C                ARMY RESEARCH AND TESTING, PAGES 425-450.
C              --FILLIBEN, 'THE PERCENT POINT FUNCTION',
C                UNPUBLISHED MANUSCRIPT.
C              --JOHNSON AND KOTZ (1970), CONTINUOUS UNIVARIATE
C                DISTRIBUTIONS-1, PAGES 250-271.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --AUGUST    1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --MAY       1976. 
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFLAG1
      CHARACTER*4 IFLAG2
      CHARACTER*4 IFLAG3
C
      CHARACTER*4 BLANK
      CHARACTER*4 ALPHAM
      CHARACTER*4 ALPHAA
      CHARACTER*4 ALPHAX
      CHARACTER*4 ALPHAI
      CHARACTER*4 ALPHAN
      CHARACTER*4 ALPHAF
      CHARACTER*4 ALPHAT
      CHARACTER*4 ALPHAY
      CHARACTER*4 ALPHAG
      CHARACTER*4 EQUAL
C
      DIMENSION W(3000)
      DIMENSION X(1)
      DIMENSION Y(7500),Z(7500)
      DIMENSION GAMTAB(50),CORR(50)
      DIMENSION YI(50),YS(50),T(50)
      DIMENSION IFLAG1(50),IFLAG2(50),IFLAG3(50)
      DIMENSION AINDEX(50)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(Z(1),WS(7501))
      DATA BLANK,ALPHAM,ALPHAA,ALPHAX/' ','M','A','X'/
      DATA ALPHAI,ALPHAN,ALPHAF,ALPHAT,ALPHAY/'I','N','F','T','Y'/
      DATA ALPHAG,EQUAL/'G','='/
      DATA GAMTAB(1),GAMTAB(2),GAMTAB(3),GAMTAB(4),GAMTAB(5),
     1GAMTAB(6),GAMTAB(7),GAMTAB(8),GAMTAB(9),GAMTAB(10),
     1GAMTAB(11),GAMTAB(12),GAMTAB(13),GAMTAB(14),GAMTAB(15),
     1GAMTAB(16),GAMTAB(17),GAMTAB(18),GAMTAB(19),GAMTAB(20),
     1GAMTAB(21),GAMTAB(22),GAMTAB(23),GAMTAB(24),GAMTAB(25)
     1/1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.,
     113.,14.,15.,16.,17.,18.,19.,20.,21.,22.,23.,24.,25./
      DATA GAMTAB(26),GAMTAB(27),GAMTAB(28),GAMTAB(29),GAMTAB(30),
     1GAMTAB(31),GAMTAB(32),GAMTAB(33),GAMTAB(34),GAMTAB(35),
     1GAMTAB(36),GAMTAB(37),GAMTAB(38),GAMTAB(39),GAMTAB(40),
     1GAMTAB(41),GAMTAB(42)
     1/30.,35.,40.,45.,50.,60.,70.,80.,90.,100.,150.,200.,250.,
     1350.,500.,750.,1000./
      DATA T(1),T(2),T(3),T(4),T(5),T(6),T(7),T(8),T(9),T(10),
     1T(11),T(12),T(13),T(14),T(15),T(16),T(17),T(18),T(19),T(20)
     1/1.63474,1.36116,1.34278,1.35854,1.37836,1.39657,1.41225,1.42557,
     1 1.43690,1.44660,
     1 1.45496,1.46223,1.46860,1.47422,1.47921,1.48368,1.48769,1.49132,
     1 1.49461,1.49761/
      DATA T(21),T(22),T(23),T(24),T(25),T(26),T(27),T(28),T(29),T(30),
     1T(31),T(32),T(33),T(34),T(35),T(36),T(37),T(38),T(39),T(40),
     1T(41),T(42),T(43)
     1/1.50036,1.50288,1.50521,1.50736,1.50935,1.51748,1.52344,1.52798,
     1 1.53157,1.53447,
     1 1.53888,1.54206,1.54447,1.54636,1.54788,1.55248,1.55480,1.55620,
     1 1.55781,1.55902,
     1 1.55997,1.56044,1.62391/
      DATA AINDEX(1),AINDEX(2),AINDEX(3),AINDEX(4),AINDEX(5),
     1AINDEX(6),AINDEX(7),AINDEX(8),AINDEX(9),AINDEX(10),
     1AINDEX(11),AINDEX(12),AINDEX(13),AINDEX(14),AINDEX(15),
     1AINDEX(16),AINDEX(17),AINDEX(18),AINDEX(19),AINDEX(20),
     1AINDEX(21),AINDEX(22),AINDEX(23),AINDEX(24),AINDEX(25)
     1/1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12.,
     113.,14.,15.,16.,17.,18.,19.,20.,21.,22.,23.,24.,25./
      DATA AINDEX(26),AINDEX(27),AINDEX(28),AINDEX(29),AINDEX(30),
     1AINDEX(31),AINDEX(32),AINDEX(33),AINDEX(34),AINDEX(35),
     1AINDEX(36),AINDEX(37),AINDEX(38),AINDEX(39),AINDEX(40),
     1AINDEX(41),AINDEX(42),AINDEX(43),AINDEX(44),AINDEX(45),
     1AINDEX(46),AINDEX(47),AINDEX(48),AINDEX(49),AINDEX(50)
     1/26.,27.,28.,29.,30.,31.,32.,33.,34.,35.,36.,37.,38., 
     139.,40.,41.,42.,43.,44.,45.,46.,47.,48.,49.,50./
C
      IPR=6
      IUPPER=7500
      NUMDIS=43
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      RETURN
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE WEIB   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 WEIB   SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE WEIB   SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     COMPUTE THE SAMPLE MINIMUM AND SAMPLE MAXIMUM
C
      XMIN=X(1)
      XMAX=X(1)
      DO140I=2,N
      IF(X(I).LT.XMIN)XMIN=X(I)
      IF(X(I).GT.XMAX)XMAX=X(I)
  140 CONTINUE
C
C     COMPUTE THE PROB PLOT CORRELATION COEFFICIENTS FOR THE VARIOUS VALUES
C     OF GAMMA
C
      CALL SORT(X,N,Y)
      CALL UNIMED(N,Z)
C
      DO100IDIS=1,NUMDIS
      IF(IDIS.EQ.NUMDIS)GOTO150
      A=GAMTAB(IDIS)
      DO110I=1,N
      W(I)=(-ALOG(1.0-Z(I)))**(1.0/A)
  110 CONTINUE
      GOTO170
  150 DO160I=1,N
      W(I)=-ALOG(ALOG(1.0/Z(I)))
  160 CONTINUE
C
  170 SUM1=0.0
      SUM2=0.0
      DO200I=1,N
      SUM1=SUM1+Y(I)
      SUM2=SUM2+W(I)
  200 CONTINUE
      YBAR=SUM1/AN
      WBAR=SUM2/AN
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO300I=1,N
      SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) 
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) 
      SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 
  300 CONTINUE
      SY=SQRT(SUM1/(AN-1.0))
      CC=SUM2/SQRT(SUM3*SUM1) 
      YSLOPE=SUM2/SUM3
      YINT=YBAR-YSLOPE*WBAR
      CORR(IDIS)=CC 
      YI(IDIS)=YINT 
      YS(IDIS)=YSLOPE
  100 CONTINUE
C
C     DETERMINE THAT DISTRIBUTION WITH THE MAX PROB PLOT CORR COEFFICIENT
C
      IDISMX=1
      CORRMX=CORR(1)
      DO400IDIS=1,NUMDIS
      IF(CORR(IDIS).GT.CORRMX)IDISMX=IDIS
      IF(CORR(IDIS).GT.CORRMX)CORRMX=CORR(IDIS)
  400 CONTINUE
      DO500IDIS=1,NUMDIS
      IFLAG1(IDIS)=BLANK
      IFLAG2(IDIS)=BLANK
      IFLAG3(IDIS)=BLANK
      IF(IDIS.EQ.IDISMX)GOTO550
      GOTO500
  550 IFLAG1(IDIS)=ALPHAM
      IFLAG2(IDIS)=ALPHAA
      IFLAG3(IDIS)=ALPHAX
  500 CONTINUE
C
C     WRITE OUT THE TABLE OF PROB PLOT CORR COEFFICIENTS FOR VARIOUS GAMMA
C
      WRITE(IPR,998)
      WRITE(IPR,305)
      WRITE(IPR,999)
      WRITE(IPR,310)N
      WRITE(IPR,311)YBAR
      WRITE(IPR,312)SY
      WRITE(IPR,313)XMIN
      WRITE(IPR,314)XMAX
      WRITE(IPR,999)
      WRITE(IPR,323)
      WRITE(IPR,324)
      WRITE(IPR,325)
      WRITE(IPR,999)
C
      NUMDM1=NUMDIS-1
      IF(NUMDM1.LT.1)GOTO850
      DO800I=1,NUMDM1
      WRITE(IPR,805)GAMTAB(I),CORR(I),IFLAG1(I),IFLAG2(I),IFLAG3(I),
     1YI(I),YS(I),T(I)
  800 CONTINUE
  850 I=NUMDIS
      WRITE(IPR,806)ALPHAI,ALPHAN,ALPHAF,ALPHAI,ALPHAN,ALPHAI,
     1ALPHAT,ALPHAY,CORR(I),IFLAG1(I),IFLAG2(I),IFLAG3(I),
     1YI(I),YS(I),T(I)
C
C     PLOT THE PROB PLOT CORR COEFFICIENT VERSUS GAMMA VALUE INDEX
C
      CALL PLOT(CORR,AINDEX,NUMDIS)
      WRITE(IPR,810)ALPHAG,ALPHAA,ALPHAM,ALPHAM,ALPHAA,EQUAL,
     1GAMTAB(1),GAMTAB(12),GAMTAB(23),GAMTAB(34), 
     1ALPHAI,ALPHAN,ALPHAF,ALPHAI,ALPHAN,ALPHAI,ALPHAT,ALPHAY
      WRITE(IPR,999)
      WRITE(IPR,812)
      WRITE(IPR,813)
C
C     IF THE OPTIMAL GAMMA IS FINITE, PLOT OUT THE WEIBULL
C     PROBABILITY PLOT FOR THE OPTIMAL VALUE
C     OF GAMMA.
C
      IF(IDISMX.LT.NUMDIS)CALL WEIPLT(X,N,GAMTAB(IDISMX))
C
C     PLOT OUT AN EXTREM VALUE TYPE 1 PROBABILITY PLOT
C     (WHICH IS IDENTICALLY A WEIBULL PROBABILITY 
C     WITH GAMMA = INFINITY)
C
      CALL EV1PLT(X,N)
C
  998 FORMAT(1H1)
  999 FORMAT(1H )
  305 FORMAT(1H ,40X,16HWEIBULL ANALYSIS)
  310 FORMAT(1H ,37X,20HTHE SAMPLE SIZE N = ,I7)
  311 FORMAT(1H ,34X,18HTHE SAMPLE MEAN = ,F14.7) 
  312 FORMAT(1H ,28X,32HTHE SAMPLE STANDARD DEVIATION = ,F14.7)
  313 FORMAT(1H ,32X,21HTHE SAMPLE MINIMUM = ,F14.7)
  314 FORMAT(1H ,32X,21HTHE SAMPLE MAXIMUM = ,F14.7)
  323 FORMAT(1H ,85H       WEIBULL          PROBABILITY PLOT     LOCATIO
     1N         SCALE       TAIL LENGTH)
  324 FORMAT(1H ,83H     TAIL LENGTH          CORRELATION        ESTIMAT
     1E        ESTIMATE       MEASURE)
  325 FORMAT(1H ,37H   PARAMETER (GAMMA)      COEFFICIENT)
  805 FORMAT(1H ,3X,F10.2,13X,F8.5,1X,3A1,2X,F14.7,2X,F14.7,3X,F10.5) 
  806 FORMAT(1H ,5X,8A1,13X,F8.5,1X,3A1,2X,F14.7,2X,F14.7,3X,F10.5)
  810 FORMAT(1H ,12X,5A1,1X,A1,F14.7,11X,F14.7,11X,F14.7,11X,F14.7,
     115X,8A1)
  812 FORMAT(1H ,96HTHE ABOVE IS A PLOT OF THE 46 PROBABILITY PLOT CORRE
     1LATION COEFFICIENTS (FROM THE PREVIOUS PAGE))
  813 FORMAT(1H ,16X,35HVERSUS THE 46 WEIBULL DISTRIBUTIONS)
C
      RETURN
      END 
      SUBROUTINE WEICDF(X,GAMMA,CDF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT WEICDF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE FOR THE WEIBULL
C              DISTRIBUTION WITH SINGLE PRECISION 
C              TAIL LENGTH PARAMETER = GAMMA.
C              THE WEIBULL DISTRIBUTION USED
C              HEREIN IS DEFINED FOR ALL POSITIVE X,
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = GAMMA * (X**(GAMMA-1)) * EXP(-(X**GAMMA)).
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE 
C                                AT WHICH THE CUMULATIVE DISTRIBUTION 
C                                FUNCTION IS TO BE EVALUATED.
C                                X SHOULD BE POSITIVE.
C                     --GAMMA  = THE SINGLE PRECISION VALUE 
C                                OF THE TAIL LENGTH PARAMETER.
C                                GAMMA 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 WEIBULL DISTRIBUTION
C             WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--GAMMA SHOULD BE POSITIVE.
C                 --X SHOULD BE POSITIVE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 250-271.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGE 124.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(X.LE.0.0)GOTO50
      IF(GAMMA.LE.0.0)GOTO55
      GOTO90
   50 WRITE(IPR,4)
      WRITE(IPR,46)X
      CDF=0.0
      RETURN
   55 WRITE(IPR,15) 
      WRITE(IPR,46)GAMMA
      CDF=0.0
      RETURN
   90 CONTINUE
    4 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT TO THE WEICDF SUBROUTINE IS NON-POSITIVE *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 WEICDF SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      CDF=1.0-(EXP(-(X**GAMMA)))
C
      RETURN
      END 
      SUBROUTINE WEIPLT(X,N,GAMMA)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT WEIPLT
C
C     PURPOSE--THIS SUBROUTINE GENERATES A WEIBULL
C              PROBABILITY PLOT
C              (WITH TAIL LENGTH PARAMETER VALUE = GAMMA).
C              THE PROTOTYPE WEIBULL DISTRIBUTION USED
C              HEREIN IS DEFINED FOR ALL POSITIVE X,
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = GAMMA * (X**(GAMMA-1)) * EXP(-(X**GAMMA)).
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 WEIBULL 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  WEIBULL DISTRIBUTION
C              WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
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                     --GAMMA  = THE SINGLE PRECISION VALUE OF THE
C                                TAIL LENGTH PARAMETER.
C                                GAMMA SHOULD BE POSITIVE.
C     OUTPUT--A ONE-PAGE WEIBULL PROBABILITY PLOT.
C     PRINTING--YES.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C                 --GAMMA SHOULD BE POSITIVE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT, UNIMED, PLOT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
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 250-271.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--DECEMBER  1972. 
C     UPDATED         --MARCH     1975. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(7500),W(7500)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501))
C
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      IF(GAMMA.LE.0.0)GOTO60
      HOLD=X(1)
      DO65I=2,N
      IF(X(I).NE.HOLD)GOTO90
   65 CONTINUE
      WRITE(IPR, 9)HOLD
      RETURN
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      RETURN
   60 WRITE(IPR,25) 
      WRITE(IPR,46)GAMMA
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE WEIPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 WEIPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE WEIPLT SUBROUTINE HAS THE VALUE 1 *****)
   25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 WEIPLT SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      AN=N
C
C     SORT THE DATA 
C
      CALL SORT(X,N,Y)
C
C     GENERATE UNIFORM ORDER STATISTIC MEDIANS
C
      CALL UNIMED(N,W)
C
C     COMPUTE WEIBULL DISTRIBUTION ORDER STATISTIC MEDIANS
C
      DO100I=1,N
      W(I)=(-ALOG(1.0-W(I)))**(1.0/GAMMA)
  100 CONTINUE
C
C     PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS.
C     COMPUTE THE TAIL LENGTH MEASURE OF THE DISTRIBUTION.
C     WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION 
C     AND THE SAMPLE SIZE.
C
      CALL PLOT(Y,W,N)
      Q=.9975
      PP9975=(-ALOG(1.0-Q))**(1.0/GAMMA)
      Q=.0025
      PP0025=(-ALOG(1.0-Q))**(1.0/GAMMA)
      Q=.975
      PP975 =(-ALOG(1.0-Q))**(1.0/GAMMA)
      Q=.025
      PP025 =(-ALOG(1.0-Q))**(1.0/GAMMA)
      TAU=(PP9975-PP0025)/(PP975-PP025) 
      WRITE(IPR,105)GAMMA,TAU,N
C
C     COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. 
C     COMPUTE LOCATION AND SCALE ESTIMATES
C     FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. 
C     THEN WRITE THEM OUT.
C
      SUM1=0.0
      SUM2=0.0
      DO200I=1,N
      SUM1=SUM1+Y(I)
      SUM2=SUM2+W(I)
  200 CONTINUE
      YBAR=SUM1/AN
      WBAR=SUM2/AN
      SUM1=0.0
      SUM2=0.0
      SUM3=0.0
      DO300I=1,N
      SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) 
      SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) 
      SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 
  300 CONTINUE
      CC=SUM2/SQRT(SUM3*SUM1) 
      YSLOPE=SUM2/SUM3
      YINT=YBAR-YSLOPE*WBAR
      WRITE(IPR,305)CC,YINT,YSLOPE
C
  105 FORMAT(1H ,51HWEIBULL PROBABILITY PLOT WITH EXPONENT PARAMETER = ,
     1E17.10,1X,7H(TAU = ,E15.8,1H),11X,20HTHE SAMPLE SIZE N = ,I7)
  305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X,
     122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) 
C
      RETURN
      END 
      SUBROUTINE WEIPPF(P,GAMMA,PPF)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT WEIPPF
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE FOR THE WEIBULL
C              DISTRIBUTION WITH SINGLE PRECISION 
C              TAIL LENGTH PARAMETER = GAMMA.
C              THE WEIBULL DISTRIBUTION USED
C              HEREIN IS DEFINED FOR ALL POSITIVE X,
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = GAMMA * (X**(GAMMA-1)) * EXP(-(X**GAMMA)).
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                     --GAMMA  = THE SINGLE PRECISION VALUE 
C                                OF THE TAIL LENGTH PARAMETER.
C                                GAMMA 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 WEIBULL DISTRIBUTION
C             WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--GAMMA SHOULD BE POSITIVE.
C                 --P SHOULD BE BETWEEN 0.0 (INCLUSIVELY)
C                   AND 1.0 (EXCLUSIVELY).
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 250-271.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGE 124.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LT.0.0.OR.P.GE.1.0)GOTO50
      IF(GAMMA.LE.0.0)GOTO55
      GOTO90
   50 WRITE(IPR,1)
      WRITE(IPR,46)P
      PPF=0.0
      RETURN
   55 WRITE(IPR,15) 
      WRITE(IPR,46)GAMMA
      PPF=0.0
      RETURN
   90 CONTINUE
    1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 WEIPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 WEIPPF SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      PPF=(-ALOG(1.0-P))**(1.0/GAMMA)
C
      RETURN
      END 
      SUBROUTINE WEIRAN(N,GAMMA,ISEED,X)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT WEIRAN
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE WEIBULL DISTRIBUTION
C              WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
C              THE PROTOTYPE WEIBULL DISTRIBUTION USED
C              HEREIN IS DEFINED FOR ALL POSITIVE X,
C              AND HAS THE PROBABILITY DENSITY FUNCTION
C              F(X) = GAMMA * (X**(GAMMA-1)) * EXP(-(X**GAMMA)).
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
C                                OF RANDOM NUMBERS TO BE
C                                GENERATED.
C                     --GAMMA  = THE SINGLE PRECISION VALUE OF THE
C                                TAIL LENGTH PARAMETER.
C                                GAMMA SHOULD BE POSITIVE.
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 WEIBULL DISTRIBUTION
C             WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
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                 --GAMMA SHOULD BE POSITIVE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--TOCHER, THE ART OF SIMULATION,
C                 1963, PAGES 14-15.
C               --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS,
C                 1964, PAGE 36.
C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
C                 DISTRIBUTIONS--1, 1970, PAGES 250-271.
C               --HASTINGS AND PEACOCK, STATISTICAL
C                 DISTRIBUTIONS--A HANDBOOK FOR
C                 STUDENTS AND PRACTITIONERS, 1975,
C                 PAGE 128.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82.6
C     ORIGINAL VERSION--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
CCCCC CHARACTER*4 IFEEDB
CCCCC CHARACTER*4 IPRINT
C
CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
CCCCC COMMON /PRINT/IFEEDB,IPRINT
C
      IPR=6
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(GAMMA.LE.0.0)GOTO60
      GOTO90
   50 WRITE(IPR, 5)
      WRITE(IPR,47)N
      RETURN
   60 WRITE(IPR,15)
      WRITE(IPR,46)GAMMA
      RETURN
   90 CONTINUE
    5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST  INPUT ARGUMENT TO THE
     1 WEIRAN SUBROUTINE IS NON-POSITIVE *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 WEIRAN SUBROUTINE IS NON-POSITIVE *****)
   46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
C
      CALL UNIRAN(N,ISEED,X)
C
C     GENERATE N WEIBULL DISTRIBUTION RANDOM NUMBERS
C     USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD.
C
      DO100I=1,N
      X(I)=(-ALOG(1.0-X(I)))**(1.0/GAMMA)
  100 CONTINUE
C
      RETURN
      END
      SUBROUTINE WIND(X,N,P1,P2,IWRITE,XWIND)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT WIND
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SAMPLE WINDSORIZED MEAN
C              OF THE DATA IN THE INPUT VECTOR X. 
C              THE WINDSORIZING IS SUCH THAT
C              THE LOWER 100*P1 % OF THE DATA IS
C              REPLACED BY THE SMALLEST NON-WINDSORIZED VALUE,
C              AND THE UPPER 100*P2 % OF THE DATA IS WINDSORIZED.
C              REPLACED BY THE LARGEST NON-WINDSORIZED VALUE.
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                     --P1     = THE SINGLE PRECISION VALUE 
C                                (BETWEEN 0.0 AND 1.0)
C                                WHICH DEFINES WHAT FRACTION
C                                OF THE LOWER ORDER STATISTICS
C                                IS TO BE WINDSORIZED
C                                BEFORE COMPUTING THE WINDSORIZED MEAN.
C                     --P2     = THE SINGLE PRECISION VALUE 
C                                (BETWEEN 0.0 AND 1.0)
C                                WHICH DEFINES WHAT FRACTION
C                                OF THE UPPER ORDER STATISTICS
C                                IS TO BE WINDSORIZED
C                                BEFORE COMPUTING THE WINDSORIZED MEAN.
C                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SAMPLE WINDSORIZED MEAN
C                                AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SAMPLE WINDSORIZED MEAN
C                                AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--XWIND  = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE WINDSORIZED MEAN
C                                WHERE 100*P1 % OF THE SMALLEST
C                                AND 100*P2 % OF THE LARGEST
C                                ORDERED OBSERVATIONS HAVE BEEN
C                                WINSORIZED BEFORE COMPUTING THE
C                                MEAN.
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE WINDSORIZED MEAN
C             WHERE 100*P1 % OF THE SMALLEST
C             AND   100*P2 % OF THE LARGEST
C             ORDERED OBSERVATIONS HAVE BEEN WINDSORIZED.
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 15000. 
C                 --P1 SHOULD BE NON-NEGATIVE.
C                 --P1 SHOULD BE SMALLER THAN 1.0 
C                 --P2 SHOULD BE NON-NEGATIVE.
C                 --P2 SHOULD BE SMALLER THAN 1.0 
C                 --THE SUM OF P1 AND P2 SHOULD BE
C                   SMALLER THAN 1.0.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--DAVID, ORDER STATISTICS, 1970, PAGES 126-130, 136.
C               --CROW AND SIDDIQUI, 'ROBUST ESTIMATION OF LOCATION', 
C                 JOURNAL OF THE AMERICAN STATISTICAL ASSOCIATION,
C                 1967, PAGES 357, 387. 
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).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(15000)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1))
C
      IPR=6
      IUPPER=15000
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      AN=N
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO65
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      XWIND=X(1)
      GOTO201
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XWIND=X(1)
      GOTO201
   65 IF(P1.LT.0.0.OR.P1.GE.1.0)GOTO66
      GOTO70
   66 WRITE(IPR,27) 
      WRITE(IPR,48)P1
      XWIND=0.0
      RETURN
   70 IF(P2.LT.0.0.OR.P2.GE.1.0)GOTO71
      GOTO75
   71 WRITE(IPR,37) 
      WRITE(IPR,48)P2
      XWIND=0.0
      RETURN
   75 PSUM=P1+P2
      IF(PSUM.LT.0.0.OR.PSUM.GE.1.0)GOTO76
      GOTO90
   76 WRITE(IPR,42) 
      WRITE(IPR,43)P1
      WRITE(IPR,44)P2
      WRITE(IPR,45)PSUM
      XWIND=0.0
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE WIND   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 WIND   SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE WIND   SUBROUTINE HAS THE VALUE 1 *****)
   27 FORMAT(1H ,121H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 WIND   SUBROUTINE IS OUTSIDE THE ALLOWABLE (0.0,1.0)   INTERVAL *
     1****)
   37 FORMAT(1H ,121H***** FATAL ERROR--THE FOURTH INPUT ARGUMENT TO THE
     1 WIND   SUBROUTINE IS OUTSIDE THE ALLOWABLE (0.0,1.0)   INTERVAL *
     1****)
   42 FORMAT(1H , 46H***** FATAL ERROR--THE SUM OF INPUT ARGUMENTS ,
     1 58H3 AND 4 TO THE WIND   SUBROUTINE IS OUTSIDE THE ALLOWABLE , 
     1 24H(0.0,1.0) INTERVAL *****)
   43 FORMAT(1H ,37H                  INPUT ARGUMENT 3   ,
     1 19H                 = ,E15.8)
   44 FORMAT(1H ,37H                  INPUT ARGUMENT 4   ,
     1 19H                 = ,E15.8)
   45 FORMAT(1H ,37H                  INPUT ARGUMENT 3 + ,
     1 19HINPUT ARGUMENT 4 = ,E15.8)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
   48 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      CALL SORT(X,N,Y)
C
      AN=N
      NP1=P1*AN+0.0001
      ISTART=NP1+1
      NP2=P2*AN+0.0001
      ISTOP=N-NP2
      SUM=0.0
      K=0 
      IF(ISTART.GT.ISTOP)GOTO150
      DO100I=ISTART,ISTOP
      K=K+1
      SUM=SUM+X(I)
  100 CONTINUE
      AK=K
      ANP1=NP1
      ANP2=NP2
      SUM=SUM+ANP1*X(ISTART)
      SUM=SUM+ANP2*X(ISTOP)
      XWIND=SUM/AN
      GOTO170
  150 WRITE(IPR,155)
  155 FORMAT(1H ,37HINTERNAL ERROR IN WIND   SUBROUTINE--,
     1 45HTHE START INDEX IS HIGHER THAN THE STOP INDEX)
      XWIND=0.0
      RETURN
  170 CONTINUE
C
  201 IF(IWRITE.EQ.0)RETURN
      PERP1=100.0*P1
      PERP2=100.0*P2
      PERP3=100.0-PERP1-PERP2 
      WRITE(IPR,999)
      WRITE(IPR,105)N,XWIND
      WRITE(IPR,110)PERP1,NP1 
      WRITE(IPR,115)PERP2,NP2 
      WRITE(IPR,120)PERP3,K
  105 FORMAT(1H ,35HTHE SAMPLE WINDSORIZED MEAN OF THE ,I6, 
     1 17H OBSERVATIONS IS ,E15.8)
  110 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) ,
     1 34HOF THE DATA WERE WINDSORIZED BELOW)
  115 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) ,
     1 34HOF THE DATA WERE WINDSORIZED ABOVE)
  120 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) ,
     1 45H OF THE DATA WERE UNWINDSORIZED IN THE MIDDLE)
  999 FORMAT(1H )
C
      RETURN
      END 
      SUBROUTINE WRITE(X,N,NNLINE,IWIDTH,IDEC)
CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL.
      DLL_EXPORT WRITE
C
C     PURPOSE--THIS SUBROUTINE WRITES OUT THE CONTENTS
C              OF THE SINGLE PRECISION VECTOR X IN AN ORDERLY
C              AND NEAT FASHION.
C              THIS SUBROUTINE GIVES THE DATA ANALYST THE ABILITY
C              TO GET DATA OUT OF THE MACHINE WITHOUT HAVING
C              TO WORRY ABOUT AND SPECIFY FORMATS.
C     INPUT ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                               OBSERVATIONS TO BE PRINTED OUT.
C                    --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR X.
C                    --NNLINE = THE INTEGER VALUE 
C                               OF THE DESIRED NUMBER OF
C                               OBSERVATIONS IN X TO APPEAR PER LINE. 
C                    --IWIDTH = THE INTEGER VALUE 
C                               OF THE LARGEST NUMBER OF
C                               CHARACTERS THAT A VALUE IN X MAY TAKE UP
C                               = THE DESIRED NUMBER OF INTEGER DIGITS
C                               + THE DESIRED NUMBER OF DECIMAL DIGITS
C                               + 1 DIGIT FOR THE SIGN
C                               + 1 DIGIT FOR THE DECIMAL POINT.
C                               (NO PROVISION NEED BE MADE FOR LEADING
C                               OR TRAILING SEPARATION BLANKS--THIS IS
C                               DONE AUTOMATICALLY BY THE SUBROUTINE.)
C                    --IDEC   = THE INTEGER VALUE 
C                               OF THE DESIRED NUMBER OF
C                               DECIMAL DIGITS TO BE PRINTED OUT.
C     OUTPUT--A LISTING OF THE N VALUES OF THE DATA VECTOR X
C             WITH NNLINE VALUES PRINTED PER LINE, AND WITH 
C             BLANKS AUTOMATICALLY INSERTED BETWEEN ADJACENT VALUES.
C             A BLANK LINE WILL APPEAR AFTER EVERY TENTH LINE.
C             50 LINES OF DATA WILL APPEAR PER PRINTER PAGE.
C     PRINTING--YES.
C     RESTRICTIONS--NNLINE MUST BE 1 OR LARGER;
C                 --IWIDTH MUST BE 2 OR LARGER;
C                 --IWIDTH MUST BE 12 OR SMALLER; 
C                 --IDEC MUST BE 0 OR LARGER;
C                 --IDEC MUST BE (IWIDTH-2) OR SMALLER;
C                 --THE PRODUCT OF NNLINE AND (IWIDTH+1) MUST
C                   BE 131 OR SMALLER.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--THE LISTED VALUES ARE TO BE READ ROW BY ROW--
C              THAT IS, THE FIRST VALUE IN X APPEARS
C              ON ROW 1, COLUMN 1 OF THE OUTPUT,
C              THE SECOND VALUE IN X APPEARS ON ROW 1, COLUMN 2,
C              ETC. 
C     REFERENCES--NONE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
C
      IPR=6
      MAXWID=12
      MAXCHA=131
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(NNLINE.LT.1)GOTO55
      IF(IWIDTH.LT.2.OR.MAXWID.LT.IWIDTH)GOTO60
      IWIDM2=IWIDTH-2
      IF(IDEC.LT.0.OR.IWIDM2.LT.IDEC)GOTO65
      IWIDP1=IWIDTH+1
      NUMCHA=NNLINE*IWIDP1
      IF(NUMCHA.GT.MAXCHA)GOTO70
      GOTO90
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,25) 
      WRITE(IPR,47)NNLINE
      RETURN
   60 WRITE(IPR,38)MAXWID
      WRITE(IPR,47)IWIDTH
      RETURN
   65 WRITE(IPR,48)IWIDTH,IWIDM2
      WRITE(IPR,47)IDEC
      RETURN
   70 WRITE(IPR,71)MAXCHA
      WRITE(IPR,72)NNLINE,IWIDTH,NNLINE,IWIDP1,NUMCHA
      RETURN
   90 CONTINUE
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 WRITE  SUBROUTINE IS NON-POSITIVE *****)
   25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 WRITE  SUBROUTINE IS NON-POSITIVE *****)
   38 FORMAT(1H , 98H***** FATAL ERROR--THE FOURTH INPUT ARGUMENT TO THE
     1 WRITE  SUBROUTINE IS OUTSIDE THE ALLOWABLE (2,,I4,16H) INTERVAL *
     1****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
   48 FORMAT(1H ,105H***** FATAL ERROR--THE FIFTH  INPUT ARGUMENT TO THE
     1 WRITE  SUBROUTINE IS NEGATIVE OR EXCEEDS IWIDTH-2 (= ,I6,5H-2 = ,
     1I6,7H) *****) 
   71 FORMAT(1H ,122H***** FATAL ERROR--THE PRODUCT OF THE 3RD INPUT ARG
     1UMENT TO THE WRITE SUBROUTINE AND THE (4TH INPUT ARGUMENT + 1) EXC
     1EEDS ,I3,5H ****)
   72 FORMAT(1H , 33H***** THE VALUE OF THE PRODUCT = ,I8,4H X (,I8,8H +
     1 1) = ,I8,3H X ,I8,3H = ,I8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      NLINES=((N-1)/NNLINE)+1 
      WRITE(IPR,998)
      WRITE(IPR,905)N
      WRITE(IPR,910)NLINES,NNLINE
      WRITE(IPR,999)
      DO300I=1,NLINES
      JMAX=NNLINE*I 
      JMIN=JMAX-NNLINE+1
      IF(JMAX.GT.N)JMAX=N
      IDECP1=IDEC+1 
      GOTO(101,102,103,104,105,106,107,108,109,110,111,112),IWIDTH
  101 RETURN
  102 GOTO120
  103 GOTO(130,131),IDECP1
  104 GOTO(140,141,142),IDECP1
  105 GOTO(150,151,152,153),IDECP1
  106 GOTO(160,161,162,163,164),IDECP1
  107 GOTO(170,171,172,173,174,175),IDECP1
  108 GOTO(180,181,182,183,184,185,186),IDECP1
  109 GOTO(190,191,192,193,194,195,196,197),IDECP1
  110 GOTO(200,201,202,203,204,205,206,207,208),IDECP1
  111 GOTO(210,211,212,213,214,215,216,217,218,219),IDECP1
  112 GOTO(220,221,222,223,224,225,226,227,228,229,230),IDECP1
C
  120 WRITE(IPR,620)(X(J),J=JMIN,JMAX)
      GOTO100
  130 WRITE(IPR,630)(X(J),J=JMIN,JMAX)
      GOTO100
  131 WRITE(IPR,631)(X(J),J=JMIN,JMAX)
      GOTO100
  140 WRITE(IPR,640)(X(J),J=JMIN,JMAX)
      GOTO100
  141 WRITE(IPR,641)(X(J),J=JMIN,JMAX)
      GOTO100
  142 WRITE(IPR,642)(X(J),J=JMIN,JMAX)
      GOTO100
  150 WRITE(IPR,650)(X(J),J=JMIN,JMAX)
      GOTO100
  151 WRITE(IPR,651)(X(J),J=JMIN,JMAX)
      GOTO100
  152 WRITE(IPR,652)(X(J),J=JMIN,JMAX)
      GOTO100
  153 WRITE(IPR,653)(X(J),J=JMIN,JMAX)
      GOTO100
  160 WRITE(IPR,660)(X(J),J=JMIN,JMAX)
      GOTO100
  161 WRITE(IPR,661)(X(J),J=JMIN,JMAX)
      GOTO100
  162 WRITE(IPR,662)(X(J),J=JMIN,JMAX)
      GOTO100
  163 WRITE(IPR,663)(X(J),J=JMIN,JMAX)
      GOTO100
  164 WRITE(IPR,664)(X(J),J=JMIN,JMAX)
      GOTO100
  170 WRITE(IPR,670)(X(J),J=JMIN,JMAX)
      GOTO100
  171 WRITE(IPR,671)(X(J),J=JMIN,JMAX)
      GOTO100
  172 WRITE(IPR,672)(X(J),J=JMIN,JMAX)
      GOTO100
  173 WRITE(IPR,673)(X(J),J=JMIN,JMAX)
      GOTO100
  174 WRITE(IPR,674)(X(J),J=JMIN,JMAX)
      GOTO100
  175 WRITE(IPR,675)(X(J),J=JMIN,JMAX)
      GOTO100
  180 WRITE(IPR,680)(X(J),J=JMIN,JMAX)
      GOTO100
  181 WRITE(IPR,681)(X(J),J=JMIN,JMAX)
      GOTO100
  182 WRITE(IPR,682)(X(J),J=JMIN,JMAX)
      GOTO100
  183 WRITE(IPR,683)(X(J),J=JMIN,JMAX)
      GOTO100
  184 WRITE(IPR,684)(X(J),J=JMIN,JMAX)
      GOTO100
  185 WRITE(IPR,685)(X(J),J=JMIN,JMAX)
      GOTO100
  186 WRITE(IPR,686)(X(J),J=JMIN,JMAX)
      GOTO100
  190 WRITE(IPR,690)(X(J),J=JMIN,JMAX)
      GOTO100
  191 WRITE(IPR,691)(X(J),J=JMIN,JMAX)
      GOTO100
  192 WRITE(IPR,692)(X(J),J=JMIN,JMAX)
      GOTO100
  193 WRITE(IPR,693)(X(J),J=JMIN,JMAX)
      GOTO100
  194 WRITE(IPR,694)(X(J),J=JMIN,JMAX)
      GOTO100
  195 WRITE(IPR,695)(X(J),J=JMIN,JMAX)
      GOTO100
  196 WRITE(IPR,696)(X(J),J=JMIN,JMAX)
      GOTO100
  197 WRITE(IPR,697)(X(J),J=JMIN,JMAX)
      GOTO100
  200 WRITE(IPR,700)(X(J),J=JMIN,JMAX)
      GOTO100
  201 WRITE(IPR,701)(X(J),J=JMIN,JMAX)
      GOTO100
  202 WRITE(IPR,702)(X(J),J=JMIN,JMAX)
      GOTO100
  203 WRITE(IPR,703)(X(J),J=JMIN,JMAX)
      GOTO100
  204 WRITE(IPR,704)(X(J),J=JMIN,JMAX)
      GOTO100
  205 WRITE(IPR,705)(X(J),J=JMIN,JMAX)
      GOTO100
  206 WRITE(IPR,706)(X(J),J=JMIN,JMAX)
      GOTO100
  207 WRITE(IPR,707)(X(J),J=JMIN,JMAX)
      GOTO100
  208 WRITE(IPR,708)(X(J),J=JMIN,JMAX)
      GOTO100
  210 WRITE(IPR,710)(X(J),J=JMIN,JMAX)
      GOTO100
  211 WRITE(IPR,711)(X(J),J=JMIN,JMAX)
      GOTO100
  212 WRITE(IPR,712)(X(J),J=JMIN,JMAX)
      GOTO100
  213 WRITE(IPR,713)(X(J),J=JMIN,JMAX)
      GOTO100
  214 WRITE(IPR,714)(X(J),J=JMIN,JMAX)
      GOTO100
  215 WRITE(IPR,715)(X(J),J=JMIN,JMAX)
      GOTO100
  216 WRITE(IPR,716)(X(J),J=JMIN,JMAX)
      GOTO100
  217 WRITE(IPR,717)(X(J),J=JMIN,JMAX)
      GOTO100
  218 WRITE(IPR,718)(X(J),J=JMIN,JMAX)
      GOTO100
  219 WRITE(IPR,719)(X(J),J=JMIN,JMAX)
      GOTO100
  220 WRITE(IPR,720)(X(J),J=JMIN,JMAX)
      GOTO100
  221 WRITE(IPR,721)(X(J),J=JMIN,JMAX)
      GOTO100
  222 WRITE(IPR,722)(X(J),J=JMIN,JMAX)
      GOTO100
  223 WRITE(IPR,723)(X(J),J=JMIN,JMAX)
      GOTO100
  224 WRITE(IPR,724)(X(J),J=JMIN,JMAX)
      GOTO100
  225 WRITE(IPR,725)(X(J),J=JMIN,JMAX)
      GOTO100
  226 WRITE(IPR,726)(X(J),J=JMIN,JMAX)
      GOTO100
  227 WRITE(IPR,727)(X(J),J=JMIN,JMAX)
      GOTO100
  228 WRITE(IPR,728)(X(J),J=JMIN,JMAX)
      GOTO100
  229 WRITE(IPR,729)(X(J),J=JMIN,JMAX)
      GOTO100
  230 WRITE(IPR,730)(X(J),J=JMIN,JMAX)
C
  100 I50=I-50*(I/50)
      IF(I50.EQ.0)WRITE(IPR,998)
      IF(I50.EQ.0)GOTO300
      I10=I-10*(I/10)
      IF(I10.EQ.0)WRITE(IPR,999)
  300 CONTINUE
C
C
  620 FORMAT(1H ,43(F2.0,1X)) 
  630 FORMAT(1H ,32(F3.0,1X)) 
  631 FORMAT(1H ,32(F3.1,1X)) 
  640 FORMAT(1H ,26(F4.0,1X)) 
  641 FORMAT(1H ,26(F4.1,1X)) 
  642 FORMAT(1H ,26(F4.2,1X)) 
  650 FORMAT(1H ,21(F5.0,1X)) 
  651 FORMAT(1H ,21(F5.1,1X)) 
  652 FORMAT(1H ,21(F5.2,1X)) 
  653 FORMAT(1H ,21(F5.3,1X)) 
  660 FORMAT(1H ,18(F6.0,1X)) 
  661 FORMAT(1H ,18(F6.1,1X)) 
  662 FORMAT(1H ,18(F6.2,1X)) 
  663 FORMAT(1H ,18(F6.3,1X)) 
  664 FORMAT(1H ,18(F6.4,1X)) 
  670 FORMAT(1H ,16(F7.0,1X)) 
  671 FORMAT(1H ,16(F7.1,1X)) 
  672 FORMAT(1H ,16(F7.2,1X)) 
  673 FORMAT(1H ,16(F7.3,1X)) 
  674 FORMAT(1H ,16(F7.4,1X)) 
  675 FORMAT(1H ,16(F7.5,1X)) 
  680 FORMAT(1H ,14(F8.0,1X)) 
  681 FORMAT(1H ,14(F8.1,1X)) 
  682 FORMAT(1H ,14(F8.2,1X)) 
  683 FORMAT(1H ,14(F8.3,1X)) 
  684 FORMAT(1H ,14(F8.4,1X)) 
  685 FORMAT(1H ,14(F8.5,1X)) 
  686 FORMAT(1H ,14(F8.6,1X)) 
  690 FORMAT(1H ,13(F9.0,1X)) 
  691 FORMAT(1H ,13(F9.1,1X)) 
  692 FORMAT(1H ,13(F9.2,1X)) 
  693 FORMAT(1H ,13(F9.3,1X)) 
  694 FORMAT(1H ,13(F9.4,1X)) 
  695 FORMAT(1H ,13(F9.5,1X)) 
  696 FORMAT(1H ,13(F9.6,1X)) 
  697 FORMAT(1H ,13(F9.7,1X)) 
  700 FORMAT(1H ,11(F10.0,1X))
  701 FORMAT(1H ,11(F10.1,1X))
  702 FORMAT(1H ,11(F10.2,1X))
  703 FORMAT(1H ,11(F10.3,1X))
  704 FORMAT(1H ,11(F10.4,1X))
  705 FORMAT(1H ,11(F10.5,1X))
  706 FORMAT(1H ,11(F10.6,1X))
  707 FORMAT(1H ,11(F10.7,1X))
  708 FORMAT(1H ,11(F10.8,1X))
  710 FORMAT(1H ,10(F11.0,1X))
  711 FORMAT(1H ,10(F11.1,1X))
  712 FORMAT(1H ,10(F11.2,1X))
  713 FORMAT(1H ,10(F11.3,1X))
  714 FORMAT(1H ,10(F11.4,1X))
  715 FORMAT(1H ,10(F11.5,1X))
  716 FORMAT(1H ,10(F11.6,1X))
  717 FORMAT(1H ,10(F11.7,1X))
  718 FORMAT(1H ,10(F11.8,1X))
  719 FORMAT(1H ,10(F11.9,1X))
  720 FORMAT(1H ,10(F12.0,1X))
  721 FORMAT(1H ,10(F12.1,1X))
  722 FORMAT(1H ,10(F12.2,1X))
  723 FORMAT(1H ,10(F12.3,1X))
  724 FORMAT(1H ,10(F12.4,1X))
  725 FORMAT(1H ,10(F12.5,1X))
  726 FORMAT(1H ,10(F12.6,1X))
  727 FORMAT(1H ,10(F12.7,1X))
  728 FORMAT(1H ,10(F12.8,1X))
  729 FORMAT(1H ,10(F12.9,1X))
  730 FORMAT(1H ,10(F12.10,1X))
  905 FORMAT(1H ,50HTHE TOTAL NUMBER OF OBSERVATIONS PRINTED BELOW IS ,I
     17)
  910 FORMAT(1H ,10HTHERE ARE ,I7,10H ROWS AND ,I7,8H COLUMNS)
  998 FORMAT(1H1)
  999 FORMAT(1H )
      RETURN
      END 
