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 ARG