SUBROUTINE AUTOCO(X,N,IWRITE,XAUTOC) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT AUTOCO C C PURPOSE--THIS SUBROUTINE COMPUTES THE C SAMPLE AUTOCORRELATION COEFFICIENT C OF THE DATA IN THE INPUT VECTOR X. C THE SAMPLE AUTOCORRELATION COEFFICIENT = THE CORRELATION C BETWEEN X(I) AND X(I+1) OVER THE ENTIRE SAMPLE. C THE AUTOCORRELATION COEFFICIENT COEFFICIENT WILL BE A C SINGLE PRECISION VALUE BETWEEN -1.0 AND 1.0 C (INCLUSIVELY). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --IWRITE = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL SUPPRESS C THE PRINTING OF THE C SAMPLE AUTOCORRELATION COEFFICIENT C AS IT IS COMPUTED; C OR (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0), C LIKE, SAY, 1) WILL CAUSE C THE PRINTING OF THE C SAMPLE AUTOCORRELATION COEFFICIENT C AT THE TIME IT IS COMPUTED. C OUTPUT ARGUMENTS--XAUTOC = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE AUTOCORRELATION C COEFFICIENT. C THIS SINGLE PRECISION VALUE C WILL BE BETWEEN -1.0 AND 1.0 C (INCLUSIVELY). C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SAMPLE AUTOCORRELATION COEFFICIENT. C PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO C INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR C CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JENKINS AND WATTS, SPECTRAL ANALYSIS AND C ITS APPLICATIONS, 1968, PAGES 5, 182. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION (714) C NATIONAL BUREAU OF STANDARDS C GAITHERSBURG, MD 20899 C PHONE: 301-921-3651 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C AN=N IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD XAUTOC=0.0 GOTO201 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XAUTOC=0.0 GOTO201 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE AUTOCO SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 AUTOCO SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE AUTOCO SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C XBAR=0.0 DO100I=1,N XBAR=XBAR+X(I) 100 CONTINUE XBAR1=XBAR-X(N) XBAR1=XBAR1/(AN-1.0) XBAR2=XBAR-X(1) XBAR2=XBAR2/(AN-1.0) SUM1=0.0 SUM2=0.0 SUM3=0.0 NM1=N-1 DO200I=1,NM1 IP1=I+1 SUM1=SUM1+(X(I)-XBAR1)*(X(IP1)-XBAR2) SUM2=SUM2+(X(I)-XBAR1)**2 SUM3=SUM3+(X(IP1)-XBAR2)**2 200 CONTINUE XAUTOC=SUM1/(SQRT(SUM2*SUM3)) C 201 IF(IWRITE.EQ.0)RETURN WRITE(IPR,999) WRITE(IPR,205)N,XAUTOC 205 FORMAT(1H ,53HTHE LINEAR AUTOCORRELATION COEFFICIENT OF THE SET OF 1 ,I6,17H OBSERVATIONS IS ,F14.6) 999 FORMAT(1H ) RETURN END SUBROUTINE BETRAN(N,ALPHA,BETA,ISEED,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT BETRAN C ***** STILL NEEDS ALGORITHM WORK ****** C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE BETA DISTRIBUTION C WITH SINGLE PRECISION SHAPE C PARAMETERS = ALPHA AND BETA. C THE PROTOTYPE BETA DISTRIBUTION USED C HEREIN HAS MEAN = ALPHA/(ALPHA+BETA) C AND STANDARD DEVIATION = C SQRT((ALPHA*BETA) / ((ALPHA+BETA)**2)*(ALPHA+BETA+1)) C THIS DISTRIBUTION IS DEFINED FOR ALL X C BETWEEN 0.0 (INCLUSIVELY) AND 1.0 (INCLUSIVELY). C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = (1/CONSTANT) * X**(ALPHA-1) * (1.0-X)**(BETA-1) C WHERE THE CONSTANT = THE BETA FUNCTION EVALUATED C AT THE VALUES ALPHA AND BETA. C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C --ALPHA = THE SINGLE PRECISION VALUE OF THE C FIRST SHAPE PARAMETER. C ALPHA SHOULD BE GREATER THAN C OR EQUAL TO 1.0. C --BETA = THE SINGLE PRECISION VALUE OF THE C SECOND SHAPE PARAMETER. C BETA SHOULD BE GREATER THAN C OR EQUAL TO 1.0. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE BETA DISTRIBUTION C WITH SHAPE PARAMETER VALUES = ALPHA AND BETA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C --ALPHA SHOULD BE GREATER THAN C OR EQUAL TO 1.0. C --BETA SHOULD BE GREATER THAN C OR EQUAL TO 1.0. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN, NORRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, EXP. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--GREENWOOD, 'A FAST GENERATOR FOR C BETA-DISTRIBUTED RANDOM VARIABLES', C COMPSTAT 1974, PROCEEDINGS IN C COMPUTATIONAL STATISTICS, VIENNA, C SEPTEMBER, 1974, PAGES 19-27. C --TOCHER, THE ART OF SIMULATION, C 1963, PAGES 24-27. C --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS, C 1964, PAGES 36-37. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 37-56. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGES 30-35. C --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 952. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLARITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82.3 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C UPDATED --JUNE 1978. C UPDATED --DECEMBER 1981. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) C DIMENSION U(10) C C--------------------------------------------------------------------- C CCCCC CHARACTER*4 IFEEDB CCCCC CHARACTER*4 IPRINT C CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW CCCCC COMMON /PRINT/IFEEDB,IPRINT C C-----DATA STATEMENTS------------------------------------------------- C DATA ATHIRD/0.33333333/ DATA SQRT3 /1.73205081/ C IPR=6 C C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(ALPHA.LT.1.0)GOTO60 IF(BETA.LT.1.0)GOTO65 GOTO90 50 WRITE(IPR, 5) WRITE(IPR,47)N RETURN 60 WRITE(IPR,16) WRITE(IPR,46)ALPHA RETURN 65 WRITE(IPR,26) WRITE(IPR,46)BETA RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 BETRAN SUBROUTINE IS NON-POSITIVE *****) 16 FORMAT(1H , 95H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 BETRAN SUBROUTINE IS SMALLER THAN 1.0 *****) 26 FORMAT(1H , 95H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 BETRAN SUBROUTINE IS SMALLER THAN 1.0 *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C GENERATE N BETA RANDOM NUMBERS C BY USING THE FACT THAT C IF X1 IS A GAMMA VARIATE WITH PARAMETER ALPHA C AND IF X2 IS A GAMMA VARIATE WITH PARAMETER BETA, C THEN THE RATIO X1/(X1+X2) IS A BETA VARIATE C WITH PARAMETERS ALPHA AND BETA. C C TO GENERATE N GAMMA DISTRIBUTION RANDOM NUMBERS, C USE GREENWOOD'S REJECTION ALGORITHM-- C 1) GENERATE A NORMAL RANDOM NUMBER; C 2) TRANSFORM THE NORMAL VARIATE TO AN APPROXIMATE C GAMMA VARIATE USING THE WILSON-HILFERTY C APPROXIMATION (SEE THE JOHNSON AND KOTZ C REFERENCE, PAGE 176); C 3) FORM THE REJECTION FUNCTION VALUE, BASED C ON THE PROBABILITY DENSITY FUNCTION VALUE C OF THE ACTUAL DISTRIBUTION OF THE PSEUDO-GAMMA C VARIATE, AND THE PROBABILITY DENSITY FUNCTION VALUE C OF A TRUE GAMMA VARIATE. C 4) GENERATE A UNIFORM RANDOM NUMBER; C 5) IF THE UNIFORM RANDOM NUMBER IS LESS THAN C THE REJECTION FUNCTION VALUE, THEN ACCEPT C THE PSEUDO-RANDOM NUMBER AS A GAMMA VARIATE; C IF THE UNIFORM RANDOM NUMBER IS LARGER THAN C THE REJECTION FUNCTION VALUE, THEN REJECT C THE PSEUDO-RANDOM NUMBER AS A GAMMA VARIATE. C A1=1.0/(9.0*ALPHA) B1=SQRT(A1) XN01=-SQRT3+B1 XG01=ALPHA*(1.0-A1+B1*XN01)**3 A2=1.0/(9.0*BETA) B2=SQRT(A2) XN02=-SQRT3+B2 XG02=BETA*(1.0-A2+B2*XN02)**3 C DO100I=1,N C 150 CALL NORRAN(1,ISEED,XN) XG=ALPHA*(1.0-A1+B1*XN)**3 IF(XG.LT.0.0)GOTO150 TERM=(XG/XG01)**(ALPHA-ATHIRD) ARG=0.5*XN*XN-XG-0.5*XN01*XN01+XG01 FUNCT=TERM*EXP(ARG) CALL UNIRAN(1,ISEED,U) IF(U(1).LE.FUNCT)GOTO170 GOTO150 170 XG1=XG C 250 CALL NORRAN(1,ISEED,XN) XG=BETA*(1.0-A2+B2*XN)**3 IF(XG.LT.0.0)GOTO250 TERM=(XG/XG02)**(BETA-ATHIRD) ARG=0.5*XN*XN-XG-0.5*XN02*XN02+XG02 FUNCT=TERM*EXP(ARG) CALL UNIRAN(1,ISEED,U) IF(U(1).LE.FUNCT)GOTO270 GOTO250 270 XG2=XG C X(I)=XG1/(XG1+XG2) C 100 CONTINUE C RETURN END SUBROUTINE BINCDF(X,P,N,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT BINCDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE AT THE SINGLE PRECISION VALUE X C FOR THE BINOMIAL DISTRIBUTION C WITH SINGLE PRECISION 'BERNOULLI PROBABILITY' C PARAMETER = P, C AND INTEGER 'NUMBER OF BERNOULLI TRIALS' C PARAMETER = N. C THE BINOMIAL DISTRIBUTION USED C HEREIN HAS MEAN = N*P C AND STANDARD DEVIATION = SQRT(N*P*(1-P)). C THIS DISTRIBUTION IS DEFINED FOR ALL C DISCRETE INTEGER X BETWEEN 0 (INCLUSIVELY) C AND N (INCLUSIVELY). C THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION C F(X) = C(N,X) * P**X * (1-P)**(N-X). C WHERE C(N,X) IS THE COMBINATORIAL FUNCTION C EQUALING THE NUMBER OF COMBINATIONS OF N ITEMS C TAKEN X AT A TIME. C THE BINOMIAL DISTRIBUTION IS THE C DISTRIBUTION OF THE NUMBER OF C SUCCESSES IN N BERNOULLI (0,1) C TRIALS WHERE THE PROBABILITY OF SUCCESS C IN A SINGLE TRIAL = P. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE C AT WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C X SHOULD BE INTEGRAL-VALUED, C AND BETWEEN 0.0 (INCLUSIVELY) C AND N (INCLUSIVELY). C --P = THE SINGLE PRECISION VALUE C OF THE 'BERNOULLI PROBABILITY' C PARAMETER FOR THE BINOMIAL C DISTRIBUTION. C P SHOULD BE BETWEEN C 0.0 (EXCLUSIVELY) AND C 1.0 (EXCLUSIVELY). C --N = THE INTEGER VALUE C OF THE 'NUMBER OF BERNOULLI TRIALS' C PARAMETER. C N SHOULD BE A POSITIVE INTEGER. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF C FOR THE BINOMIAL DISTRIBUTION C WITH 'BERNOULLI PROBABILITY' PARAMETER = P C AND 'NUMBER OF BERNOULLI TRIALS' PARAMETER = N. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--X SHOULD BE INTEGRAL-VALUED, C AND BETWEEN 0.0 (INCLUSIVELY) C AND N (INCLUSIVELY). C --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C --N SHOULD BE A POSITIVE INTEGER. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DATAN. C MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--NOTE THAT EVEN THOUGH THE INPUT C TO THIS CUMULATIVE C DISTRIBUTION FUNCTION SUBROUTINE C FOR THIS DISCRETE DISTRIBUTION C SHOULD (UNDER NORMAL CIRCUMSTANCES) BE A C DISCRETE INTEGER VALUE, C THE INPUT VARIABLE X IS SINGLE C PRECISION IN MODE. C X HAS BEEN SPECIFIED AS SINGLE C PRECISION SO AS TO CONFORM WITH THE DATAPAC C CONVENTION THAT ALL INPUT ****DATA**** C (AS OPPOSED TO SAMPLE SIZE, FOR EXAMPLE) C VARIABLES TO ALL C DATAPAC SUBROUTINES ARE SINGLE PRECISION. C THIS CONVENTION IS BASED ON THE BELIEF THAT C 1) A MIXTURE OF MODES (FLOATING POINT C VERSUS INTEGER) IS INCONSISTENT AND C AN UNNECESSARY COMPLICATION C IN A DATA ANALYSIS; AND C 2) FLOATING POINT MACHINE ARITHMETIC C (AS OPPOSED TO INTEGER ARITHMETIC) C IS THE MORE NATURAL MODE FOR DOING C DATA ANALYSIS. C REFERENCES--HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGE 38. C --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 945, FORMULAE 26.5.24 AND C 26.5.28, AND PAGE 929. C --JOHNSON AND KOTZ, DISCRETE C DISTRIBUTIONS, 1969, PAGES 50-86, C ESPECIALLY PAGES 63-64. C --FELLER, AN INTRODUCTION TO PROBABILITY C THEORY AND ITS APPLICATIONS, VOLUME 1, C EDITION 2, 1957, PAGES 135-142. C --KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 120-125. C --MOOD AND GRABLE, INTRODUCTION TO THE THEORY C OF STATISTICS, EDITION 2, 1963, PAGES 64-69. C --OWEN, HANDBOOK OF STATISTICAL C TABLES, 1962, PAGES 264-272. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --MAY 1977. C C--------------------------------------------------------------------- C DOUBLE PRECISION DX,PI,ANU1,ANU2,Z,SUM,TERM,AI,COEF1,COEF2,ARG DOUBLE PRECISION COEF DOUBLE PRECISION THETA,SINTH,COSTH,A,B DOUBLE PRECISION DSQRT,DATAN DATA PI/3.14159265358979D0/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C AN=N IF(P.LT.0.0.OR.P.GT.1.0)GOTO50 IF(N.LT.1)GOTO55 IF(X.LT.0.0.OR.X.GT.AN)GOTO60 INTX=X+0.0001 FINTX=INTX DEL=X-FINTX IF(DEL.LT.0.0)DEL=-DEL IF(DEL.GT.0.001)GOTO65 GOTO90 50 WRITE(IPR,11) WRITE(IPR,46)P CDF=0.0 RETURN 55 WRITE(IPR,25) WRITE(IPR,47)N CDF=0.0 RETURN 60 WRITE(IPR,4)N WRITE(IPR,46)X IF(X.LT.0.0)CDF=0.0 IF(X.GT.AN)CDF=1.0 RETURN 65 WRITE(IPR,5) WRITE(IPR,46)X 90 CONTINUE 4 FORMAT(1H ,111H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE BINCDF SUBROUTINE IS OUTSIDE THE USUAL (0,N) = (0,,I7, 1 11H,INTERVAL *) 5 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE BINCDF SUBROUTINE IS NON-INTEGRAL *****) 11 FORMAT(1H ,115H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 BINCDF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 BINCDF SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C C TREAT IMMEDIATELY THE SPECIAL CASE OF X = N, C IN WHICH CASE CDF = 1.0. C ALSO TREAT IMMEDIATELY THE SPECIAL CASE OF P = 0.0 C IN WHICH CASE CDF = 1.0 FOR ALL X. C THIRDLY, TREAT THE SPECIAL CASE IN WHICH P = 1.0 C IN WHICH CASE CDF = 0.0 FOR ALL X SMALLER THAN N C AND CDF = 1.0 FOR ALL X EQUAL TO OR LARGER C THAN N. C INTX=X+0.0001 CDF=1.0 IF(INTX.EQ.N)RETURN IF(P.EQ.0.0)RETURN IF(P.EQ.1.0.AND.INTX.GE.N)RETURN IF(P.EQ.1.0.AND.INTX.LT.N)CDF=0.0 IF(P.EQ.1.0.AND.INTX.LT.N)RETURN C C EXPRESS THE BINOMIAL CUMULATIVE DISTRIBUTION C FUNCTION IN TERMS OF THE EQUIVALENT F C CUMULATIVE DISTRIBUTION FUNCTION, C AND THEN EVALUATE THE LATTER. C AN=N DX=(P/(1.0-P))*((AN-X)/(X+1.0)) NU1=2.0*(X+1.0)+0.1 NU2=2.0*(AN-X)+0.1 ANU1=NU1 ANU2=NU2 Z=ANU2/(ANU2+ANU1*DX) C C DETERMINE IF NU1 AND NU2 ARE EVEN OR ODD C IFLAG1=NU1-2*(NU1/2) IFLAG2=NU2-2*(NU2/2) IF(IFLAG1.EQ.0)GOTO120 IF(IFLAG2.EQ.0)GOTO150 GOTO250 C C DO THE NU1 EVEN AND NU2 EVEN OR ODD CASE C 120 SUM=0.0D0 TERM=1.0D0 IMAX=(NU1-2)/2 IF(IMAX.LE.0)GOTO110 DO100I=1,IMAX AI=I COEF1=2.0D0*(AI-1.0D0) COEF2=2.0D0*AI TERM=TERM*((ANU2+COEF1)/COEF2)*(1.0D0-Z) SUM=SUM+TERM 100 CONTINUE C 110 SUM=SUM+1.0D0 SUM=(Z**(ANU2/2.0D0))*SUM CDF=SUM RETURN C C DO THE NU1 ODD AND NU2 EVEN CASE C 150 SUM=0.0D0 TERM=1.0D0 IMAX=(NU2-2)/2 IF(IMAX.LE.0)GOTO210 DO200I=1,IMAX AI=I COEF1=2.0D0*(AI-1.0D0) COEF2=2.0D0*AI TERM=TERM*((ANU1+COEF1)/COEF2)*Z SUM=SUM+TERM 200 CONTINUE C 210 SUM=SUM+1.0D0 CDF=1.0D0-((1.0D0-Z)**(ANU1/2.0D0))*SUM RETURN C C DO THE NU1 ODD AND NU2 ODD CASE C 250 SUM=0.0D0 TERM=1.0D0 ARG=DSQRT((ANU1/ANU2)*DX) THETA=DATAN(ARG) SINTH=ARG/DSQRT(1.0D0+ARG*ARG) COSTH=1.0D0/DSQRT(1.0D0+ARG*ARG) IF(NU2.EQ.1)GOTO320 IF(NU2.EQ.3)GOTO310 IMAX=NU2-2 DO300I=3,IMAX,2 AI=I COEF1=AI-1.0D0 COEF2=AI TERM=TERM*(COEF1/COEF2)*(COSTH*COSTH) SUM=SUM+TERM 300 CONTINUE C 310 SUM=SUM+1.0D0 SUM=SUM*SINTH*COSTH C 320 A=(2.0D0/PI)*(THETA+SUM) SUM=0.0D0 TERM=1.0D0 IF(NU1.EQ.1)B=0.0D0 IF(NU1.EQ.1)GOTO450 IF(NU1.EQ.3)GOTO410 IMAX=NU1-3 DO400I=1,IMAX,2 AI=I COEF1=AI COEF2=AI+2.0D0 TERM=TERM*((ANU2+COEF1)/COEF2)*(SINTH*SINTH) SUM=SUM+TERM 400 CONTINUE C 410 SUM=SUM+1.0D0 SUM=SUM*SINTH*(COSTH**N) COEF=1.0D0 IEVODD=NU2-2*(NU2/2) IMIN=3 IF(IEVODD.EQ.0)IMIN=2 IF(IMIN.GT.NU2)GOTO420 DO430I=IMIN,NU2,2 AI=I COEF=((AI-1.0D0)/AI)*COEF 430 CONTINUE C 420 COEF=COEF*ANU2 IF(IEVODD.EQ.0)GOTO440 COEF=COEF*(2.0D0/PI) C 440 B=COEF*SUM C 450 CDF=1.0D0-(A-B) RETURN C END SUBROUTINE BINPPF(P,PPAR,N,PPF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT BINPPF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE AT THE SINGLE PRECISION VALUE P C FOR THE BINOMIAL DISTRIBUTION C WITH SINGLE PRECISION 'BERNOULLI PROBABILITY' C PARAMETER = PPAR, C AND INTEGER 'NUMBER OF BERNOULLI TRIALS' C PARAMETER = N. C THE BINOMIAL DISTRIBUTION USED C HEREIN HAS MEAN = N*PPAR C AND STANDARD DEVIATION = SQRT(N*PPAR*(1-PPAR)). C THIS DISTRIBUTION IS DEFINED FOR ALL C DISCRETE INTEGER X BETWEEN 0 (INCLUSIVELY) C AND N (INCLUSIVELY). C THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION C F(X) = C(N,X) * PPAR**X * (1-PPAR)**(N-X). C WHERE C(N,X) IS THE COMBINATORIAL FUNCTION C EQUALING THE NUMBER OF COMBINATIONS OF N ITEMS C TAKEN X AT A TIME. C THE BINOMIAL DISTRIBUTION IS THE C DISTRIBUTION OF THE NUMBER OF C SUCCESSES IN N BERNOULLI (0,1) C TRIALS WHERE THE PROBABILITY OF SUCCESS C IN A SINGLE TRIAL = PPAR. C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 (INCLUSIVELY) C AND 1.0 (INCLUSIVELY)) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C --PPAR = THE SINGLE PRECISION VALUE C OF THE 'BERNOULLI PROBABILITY' C PARAMETER FOR THE BINOMIAL C DISTRIBUTION. C PPAR SHOULD BE BETWEEN C 0.0 (EXCLUSIVELY) AND C 1.0 (EXCLUSIVELY). C --N = THE INTEGER VALUE C OF THE 'NUMBER OF BERNOULLI TRIALS' C PARAMETER. C N SHOULD BE A POSITIVE INTEGER. C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT . C FUNCTION VALUE PPF C FOR THE BINOMIAL DISTRIBUTION C WITH 'BERNOULLI PROBABILITY' PARAMETER = PPAR C AND 'NUMBER OF BERNOULLI TRIALS' PARAMETER = N. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--PPAR SHOULD BE BETWEEN 0.0 (EXCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C --N SHOULD BE A POSITIVE INTEGER. C --P SHOULD BE BETWEEN 0.0 (INCLUSIVELY) C AND 1.0 (INCLUSIVELY). C OTHER DATAPAC SUBROUTINES NEEDED--NORPPF, BINCDF. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION AND DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--NOTE THAT EVEN THOUGH THE OUTPUT C FROM THIS DISCRETE DISTRIBUTION C PERCENT POINT FUNCTION C SUBROUTINE MUST NECESSARILY BE A C DISCRETE INTEGER VALUE, C THE OUTPUT VARIABLE PPF IS SINGLE C PRECISION IN MODE. C PPF HAS BEEN SPECIFIED AS SINGLE C PRECISION SO AS TO CONFORM WITH THE DATAPAC C CONVENTION THAT ALL OUTPUT VARIABLES FROM ALL C DATAPAC SUBROUTINES ARE SINGLE PRECISION. C THIS CONVENTION IS BASED ON THE BELIEF THAT C 1) A MIXTURE OF MODES (FLOATING POINT C VERSUS INTEGER) IS INCONSISTENT AND C AN UNNECESSARY COMPLICATION C IN A DATA ANALYSIS; AND C 2) FLOATING POINT MACHINE ARITHMETIC C (AS OPPOSED TO INTEGER ARITHMETIC) C IS THE MORE NATURAL MODE FOR DOING C DATA ANALYSIS. C REFERENCES--JOHNSON AND KOTZ, DISCRETE C DISTRIBUTIONS, 1969, PAGES 50-86, C ESPECIALLY PAGE 64, FORMULA 36. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGES 36-41. C --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 929. C --FELLER, AN INTRODUCTION TO PROBABILITY C THEORY AND ITS APPLICATIONS, VOLUME 1, C EDITION 2, 1957, PAGES 135-142. C --KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 120-125. C --MOOD AND GRABLE, INTRODUCTION TO THE THEORY C OF STATISTICS, EDITION 2, 1963, PAGES 64-69. C --OWEN, HANDBOOK OF STATISTICAL C TABLES, 1962, PAGES 264-272. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C C--------------------------------------------------------------------- C DOUBLE PRECISION DPPAR C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LT.0.0.OR.P.GT.1.0)GOTO50 IF(PPAR.LE.0.0.OR.PPAR.GE.1.0)GOTO55 IF(N.LT.1)GOTO60 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P PPF=0.0 RETURN 55 WRITE(IPR,11) WRITE(IPR,46)PPAR PPF=0.0 RETURN 60 WRITE(IPR,25) WRITE(IPR,47)N PPF=0.0 RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 BINPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 11 FORMAT(1H ,115H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 BINPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 BINPPF SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N DPPAR=PPAR PPF=0.0 IX0=0 IX1=0 IX2=0 P0=0.0 P1=0.0 P2=0.0 C C TREAT CERTAIN SPECIAL CASES IMMEDIATELY-- C 1) P = 0.0 OR 1.0 C 2) P = 0.5 AND PPAR = 0.5 C 3) PPF = 0 OR N C IF(P.EQ.0.0)GOTO110 IF(P.EQ.1.0)GOTO120 IF(P.EQ.0.5.AND.PPAR.EQ.0.5)GOTO130 PF0=(1.0D0-DPPAR)**N QFN=1.0D0-(DPPAR**N) IF(P.LE.PF0)GOTO110 IF(P.GT.QFN)GOTO120 GOTO190 110 PPF=0.0 RETURN 120 PPF=N RETURN 130 PPF=N/2 RETURN 190 CONTINUE C C DETERMINE AN INITIAL APPROXIMATION TO THE BINOMIAL C PERCENT POINT BY USE OF THE NORMAL APPROXIMATION C TO THE BINOMIAL. C (SEE JOHNSON AND KOTZ, DISCRETE DISTRIBUTIONS, C PAGE 64, FORMULA 36). C AMEAN=AN*PPAR SD=SQRT(AN*PPAR*(1.0-PPAR)) CALL NORPPF(P,ZPPF) X2=AMEAN-0.5+ZPPF*SD IX2=X2 C C CHECK AND MODIFY (IF NECESSARY) THIS INITIAL C ESTIMATE OF THE PERCENT POINT C TO ASSURE THAT IT BE IN THE CLOSED INTERVAL 0 TO N. C IF(IX2.LT.0)IX2=0 IF(IX2.GT.N)IX2=N C C DETERMINE UPPER AND LOWER BOUNDS ON THE DESIRED C PERCENT POINT BY ITERATING OUT (BOTH BELOW AND ABOVE) C FROM THE ORIGINAL APPROXIMATION AT STEPS C OF 1 STANDARD DEVIATION. C THE RESULTING BOUNDS WILL BE AT MOST C 1 STANDARD DEVIATION APART. C IX0=0 IX1=N ISD=SD+1.0 X2=IX2 CALL BINCDF(X2,PPAR,N,P2) C IF(P2.LT.P)GOTO210 GOTO250 C 210 IX0=IX2 DO220I=1,100000 IX2=IX0+ISD IF(IX2.GE.IX1)GOTO275 X2=IX2 CALL BINCDF(X2,PPAR,N,P2) IF(P2.GE.P)GOTO230 IX0=IX2 220 CONTINUE WRITE(IPR,249) WRITE(IPR,222) GOTO950 230 IX1=IX2 GOTO275 C 250 IX1=IX2 DO260I=1,100000 IX2=IX1-ISD IF(IX2.LE.IX0)GOTO275 X2=IX2 CALL BINCDF(X2,PPAR,N,P2) IF(P2.LT.P)GOTO270 IX1=IX2 260 CONTINUE WRITE(IPR,249) WRITE(IPR,262) GOTO950 270 IX0=IX2 C 275 IF(IX0.EQ.IX1)GOTO280 GOTO295 280 IF(IX0.EQ.0)GOTO285 IF(IX0.EQ.N)GOTO290 WRITE(IPR,249) WRITE(IPR,282) GOTO950 285 IX1=IX1+1 GOTO295 290 IX0=IX0-1 295 CONTINUE C C COMPUTE BINOMIAL PROBABILITIES FOR THE C DERIVED LOWER AND UPPER BOUNDS. C X0=IX0 X1=IX1 CALL BINCDF(X0,PPAR,N,P0) CALL BINCDF(X1,PPAR,N,P1) C C CHECK THE PROBABILITIES FOR PROPER ORDERING C IF(P0.LT.P.AND.P.LE.P1)GOTO490 IF(P0.EQ.P)GOTO410 IF(P1.EQ.P)GOTO420 IF(P0.GT.P1)GOTO430 IF(P0.GT.P)GOTO440 IF(P1.LT.P)GOTO450 WRITE(IPR,249) WRITE(IPR,401) GOTO950 410 PPF=IX0 RETURN 420 PPF=IX1 RETURN 430 WRITE(IPR,249) WRITE(IPR,431) GOTO950 440 WRITE(IPR,249) WRITE(IPR,441) GOTO950 450 WRITE(IPR,249) WRITE(IPR,451) GOTO950 490 CONTINUE C C THE STOPPING CRITERION IS THAT THE LOWER BOUND C AND UPPER BOUND ARE EXACTLY 1 UNIT APART. C CHECK TO SEE IF IX1 = IX0 + 1; C IF SO, THE ITERATIONS ARE COMPLETE; C IF NOT, THEN BISECT, COMPUTE PROBABILIIES, C CHECK PROBABILITIES, AND CONTINUE ITERATING C UNTIL IX1 = IX0 + 1. C 300 IX0P1=IX0+1 IF(IX1.EQ.IX0P1)GOTO690 IX2=(IX0+IX1)/2 IF(IX2.EQ.IX0)GOTO610 IF(IX2.EQ.IX1)GOTO620 X2=IX2 CALL BINCDF(X2,PPAR,N,P2) IF(P0.LT.P2.AND.P2.LT.P1)GOTO630 IF(P2.LE.P0)GOTO640 IF(P2.GE.P1)GOTO650 610 WRITE(IPR,249) WRITE(IPR,611) GOTO950 620 WRITE(IPR,249) WRITE(IPR,611) GOTO950 630 IF(P2.LE.P)GOTO635 IX1=IX2 P1=P2 GOTO300 635 IX0=IX2 P0=P2 GOTO300 640 WRITE(IPR,249) WRITE(IPR,641) GOTO950 650 WRITE(IPR,249) WRITE(IPR,651) GOTO950 690 PPF=IX1 IF(P0.EQ.P)PPF=IX0 RETURN C 950 WRITE(IPR,240)IX0,P0 WRITE(IPR,241)IX1,P1 WRITE(IPR,242)IX2,P2 WRITE(IPR,244)P WRITE(IPR,245)PPAR,N RETURN C 222 FORMAT(1H ,43HNO UPPER BOUND FOUND AFTER 10**7 ITERATIONS) 240 FORMAT(1H ,7HIX0 = ,I8,10X,5HP0 = ,F14.7) 241 FORMAT(1H ,7HIX1 = ,I8,10X,5HP1 = ,F14.7) 242 FORMAT(1H ,7HIX2 = ,I8,10X,5HP2 = ,F14.7) 244 FORMAT(1H ,7HP = ,F14.7) 245 FORMAT(1H ,7HPPAR = ,F14.7,10X,5HN = ,I8) 249 FORMAT(1H ,47H***** INTERNAL ERROR IN BINPPF SUBROUTINE *****) 262 FORMAT(1H ,43HNO LOWER BOUND FOUND AFTER 10**7 ITERATIONS) 282 FORMAT(1H ,31HLOWER AND UPPER BOUND IDENTICAL) 401 FORMAT(1H ,39HIMPOSSIBLE BRANCH CONDITION ENCOUNTERED) 431 FORMAT(1H ,42HLOWER BOUND PROBABILITY (P0) GREATER THAN , 1 28HUPPER BOUND PROBABILITY (P1)) 441 FORMAT(1H ,42HLOWER BOUND PROBABILITY (P0) GREATER THAN , 1 21HINPUT PROBABILITY (P)) 451 FORMAT(1H ,42HUPPER BOUND PROBABILITY (P1) LESS THAN , 1 21HINPUT PROBABILITY (P)) 611 FORMAT(1H ,39HBISECTION VALUE (X2) = LOWER BOUND (X0)) 621 FORMAT(1H ,39HBISECTION VALUE (X2) = UPPER BOUND (X1)) 641 FORMAT(1H ,33HBISECTION VALUE PROBABILITY (P2) , 1 38HLESS THAN LOWER BOUND PROBABILITY (P0)) 651 FORMAT(1H ,33HBISECTION VALUE PROBABILITY (P2) , 1 41HGREATER THAN UPPER BOUND PROBABILITY (P1)) C END SUBROUTINE BINRAN(N,P,NPAR,ISEED,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT BINRAN C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE BINOMIAL DISTRIBUTION C WITH SINGLE PRECISION 'BERNOULLI PROBABILITY' C PARAMETER = P, C AND INTEGER 'NUMBER OF BERNOULLI TRIALS' C PARAMETER = NPAR. C THE BINOMIAL DISTRIBUTION USED C HEREIN HAS MEAN = NPAR*P C AND STANDARD DEVIATION = SQRT(NPAR*P*(1-P)). C THIS DISTRIBUTION IS DEFINED FOR ALL C DISCRETE INTEGER X BETWEEN 0 (INCLUSIVELY) C AND NPAR (INCLUSIVELY). C THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION C F(X) = C(NPAR,X) * P**X * (1-P)**(NPAR-X). C WHERE C(NPAR,X) IS THE COMBINATORIAL FUNCTION C EQUALING THE NUMBER OF COMBINATIONS OF NPAR ITEMS C TAKEN X AT A TIME. C THE BINOMIAL DISTRIBUTION IS THE C DISTRIBUTION OF THE NUMBER OF C SUCCESSES IN NPAR BERNOULLI (0,1) C TRIALS WHERE THE PROBABILITY OF SUCCESS C IN A SINGLE TRIAL = P. C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C --P = THE SINGLE PRECISION VALUE C OF THE 'BERNOULLI PROBABILITY' C PARAMETER FOR THE BINOMIAL C DISTRIBUTION. C P SHOULD BE BETWEEN C 0.0 (EXCLUSIVELY) AND C 1.0 (EXCLUSIVELY). C --NPAR = THE INTEGER VALUE C OF THE 'NUMBER OF BERNOULLI TRIALS' C PARAMETER. C NPAR SHOULD BE A POSITIVE INTEGER. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE BINOMIAL DISTRIBUTION C WITH 'BERNOULLI PROBABILITY' PARAMETER = P C AND 'NUMBER OF BERNOULLI TRIALS' PARAMETER = NPAR. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C --NPAR SHOULD BE A POSITIVE INTEGER. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN, GEORAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C COMMENT--NOTE THAT EVEN THOUGH THE OUTPUT C FROM THIS DISCRETE RANDOM NUMBER C GENERATOR MUST NECESSARILY BE A C SEQUENCE OF ***INTEGER*** VALUES, C THE OUTPUT VECTOR X IS SINGLE C PRECISION IN MODE. C X HAS BEEN SPECIFIED AS SINGLE C PRECISION SO AS TO CONFORM WITH THE DATAPAC C CONVENTION THAT ALL OUTPUT VECTORS FROM ALL C DATAPAC SUBROUTINES ARE SINGLE PRECISION. C THIS CONVENTION IS BASED ON THE BELIEF THAT C 1) A MIXTURE OF MODES (FLOATING POINT C VERSUS INTEGER) IS INCONSISTENT AND C AN UNNECESSARY COMPLICATION C IN A DATA ANALYSIS; AND C 2) FLOATING POINT MACHINE ARITHMETIC C (AS OPPOSED TO INTEGER ARITHMETIC) C IS THE MORE NATURAL MODE FOR DOING C DATA ANALYSIS. C REFERENCES--JOHNSON AND KOTZ, DISCRETE C DISTRIBUTIONS, 1969, PAGES 50-86. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGE 41. C --FELLER, AN INTRODUCTION TO PROBABILITY C THEORY AND ITS APPLICATIONS, VOLUME 1, C EDITION 2, 1957, PAGES 135-142. C --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 929. C --KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 120-125. C --MOOD AND GRABLE, INTRODUCTION TO THE THEORY C OF STATISTICS, EDITION 2, 1963, PAGES 64-69. C --TOCHER, THE ART OF SIMULATION, C 1963, PAGES 39-40. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82/7 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) C C--------------------------------------------------------------------- C CCCCC CHARACTER*4 IFEEDB CCCCC CHARACTER*4 IPRINT C CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW CCCCC COMMON /PRINT/IFEEDB,IPRINT C IPR=6 C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(P.LE.0.0.OR.P.GE.1.0)GOTO55 IF(NPAR.LT.1)GOTO60 GOTO90 50 WRITE(IPR, 5) WRITE(IPR,47)N RETURN 55 WRITE(IPR,11) WRITE(IPR,46)P RETURN 60 WRITE(IPR,25) WRITE(IPR,47)NPAR RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 BINRAN SUBROUTINE IS NON-POSITIVE *****) 11 FORMAT(1H ,115H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 BINRAN SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 BINRAN SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C CHECK ON THE MAGNITUDE OF P, C AND BRANCH TO THE FASTER C GENERATION METHOD ACCORDINGLY. C IF(P.LT.0.1)GOTO450 C C IF P IS MODERATE OR LARGE, C GENERATE N BINOMIAL RANDOM NUMBERS C USING THE REJECTION METHOD. C DO100I=1,N ISUM=0 DO200J=1,NPAR CALL UNIRAN(1,ISEED,U) IF(U.LE.P)ISUM=ISUM+1 200 CONTINUE X(I)=ISUM 100 CONTINUE RETURN C C IF P IS SMALL, C GENERATE N BINOMIAL NUMBERS C USING THE FACT THAT THE C WAITING TIME FOR 1 SUCCESS IN C BERNOULLI TRIALS HAS A C GEOMETRIC DISTRIBUTION. C 450 DO500I=1,N ISUM=0 J=1 550 CALL GEORAN(1,P,ISEED,G) IG=G+0.5 ISUM=ISUM+IG+1 IF(ISUM.GT.NPAR)GOTO650 J=J+1 GOTO550 650 X(I)=J-1 500 CONTINUE RETURN C END SUBROUTINE CAUCDF(X,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT CAUCDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR THE CAUCHY DISTRIBUTION C WITH MEDIAN = 0 AND 75% POINT = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = (1/PI)*(1/(1+X*X)). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF. C PRINTING--NONE. C RESTRICTIONS--NONE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--ATAN. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 154-165. C WRITTEN BY--JAMES F. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DATA PI/3.14159265358979/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS. C NO INPUT ARGUMENT ERRORS POSSIBLE C FOR THIS DISTRIBUTION. C C-----START POINT----------------------------------------------------- C CDF=0.5+((1.0/PI)*ATAN(X)) C RETURN END SUBROUTINE CAUPDF(X,PDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT CAUPDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY C FUNCTION VALUE FOR THE CAUCHY DISTRIBUTION C WITH MEDIAN = 0 AND 75% POINT = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = (1/PI)*(1/(1+X*X)). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE PROBABILITY DENSITY C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--PDF = THE SINGLE PRECISION PROBABILITY C DENSITY FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY C FUNCTION VALUE PDF. C PRINTING--NONE. C RESTRICTIONS--NONE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 154-165. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DATA C/.31830988618379/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS. C NO INPUT ARGUMENT ERRORS POSSIBLE C FOR THIS DISTRIBUTION. C C-----START POINT----------------------------------------------------- C PDF=C*(1.0/(1.0+X*X)) C RETURN END SUBROUTINE CAUPLT(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT CAUPLT C C PURPOSE--THIS SUBROUTINE GENERATES A CAUCHY C PROBABILITY PLOT. C THE PROTOTYPE CAUCHY DISTRIBUTION USED HEREIN C HAS MEDIAN = 0 AND 75% POINT = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = (1/PI) * (1/(1+X*X)). C AS USED HEREIN, A PROBABILITY PLOT FOR A DISTRIBUTION C IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS C THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION. C THE CAUCHY PROBABILITY PLOT IS USEFUL IN C GRAPHICALLY TESTING THE COMPOSITE (THAT IS, C LOCATION AND SCALE PARAMETERS NEED NOT BE SPECIFIED) C HYPOTHESIS THAT THE UNDERLYING DISTRIBUTION C FROM WHICH THE DATA HAVE BEEN RANDOMLY DRAWN C IS THE CAUCHY DISTRIBUTION. C IF THE HYPOTHESIS IS TRUE, THE PROBABILITY PLOT C SHOULD BE NEAR-LINEAR. C A MEASURE OF SUCH LINEARITY IS GIVEN BY THE C CALCULATED PROBABILITY PLOT CORRELATION COEFFICIENT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--A ONE-PAGE CAUCHY PROBABILITY PLOT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, PLOT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, SIN, COS. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, 'TECHNIQUES FOR TAIL LENGTH ANALYSIS', C PROCEEDINGS OF THE EIGHTEENTH CONFERENCE C ON THE DESIGN OF EXPERIMENTS IN ARMY RESEARCH C DEVELOPMENT AND TESTING (ABERDEEN, MARYLAND, C OCTOBER, 1972), PAGES 425-450. C --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING, C 1967, PAGES 260-308. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 154-165. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(7500),W(7500) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501)) C DATA PI/3.14159265358979/ DATA TAU/10.02040649/ C IPR=6 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE CAUPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 CAUPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE CAUPLT SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C SORT THE DATA C CALL SORT(X,N,Y) C C GENERATE UNIFORM ORDER STATISTIC MEDIANS C CALL UNIMED(N,W) C C COMPUTE CAUCHY ORDER STATISTIC MEDIANS C DO100I=1,N ARG=PI*W(I) W(I)=-COS(ARG)/SIN(ARG) 100 CONTINUE C C PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS. C WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION C AND THE SAMPLE SIZE. C CALL PLOT(Y,W,N) WRITE(IPR,105)TAU,N C C COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. C COMPUTE LOCATION AND SCALE ESTIMATES C FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. C THEN WRITE THEM OUT. C SUM1=0.0 DO200I=1,N SUM1=SUM1+Y(I) 200 CONTINUE YBAR=SUM1/AN WBAR=0.0 SUM1=0.0 SUM2=0.0 SUM3=0.0 DO300I=1,N SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM2=SUM2+W(I)*Y(I) SUM3=SUM3+W(I)*W(I) 300 CONTINUE CC=SUM2/SQRT(SUM3*SUM1) YSLOPE=SUM2/SUM3 YINT=YBAR-YSLOPE*WBAR WRITE(IPR,305)CC,YINT,YSLOPE C 105 FORMAT(1H ,31HCAUCHY PROBABILITY PLOT (TAU = ,E15.8,1H),56X,20HTHE 1 SAMPLE SIZE N = ,I7) 305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X, 122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) C RETURN END SUBROUTINE CAUPPF(P,PPF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT CAUPPF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE FOR THE CAUCHY DISTRIBUTION C WITH MEDIAN = 0 AND 75% POINT = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = (1/PI)*(1/(1+X*X)). C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 AND 1.0) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT C FUNCTION VALUE PPF. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--P SHOULD BE BETWEEN 0.0 AND 1.0, EXCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--SIN, COS. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGES 21-44, 229-231. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 154-165. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DATA PI/3.14159265358979/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LE.0.0.OR.P.GE.1.0)GOTO50 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 CAUPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C ARG=PI*P PPF=-COS(ARG)/SIN(ARG) C RETURN END SUBROUTINE CAURAN(N,ISEED,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT CAUPPF C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE CAUCHY DISTRIBUTION C WITH MEDIAN = 0 AND 75% POINT = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = (1/PI)*(1/(1+X*X)). C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FUNCTION VALUE FOR THE CAUCHY DISTRIBUTION C WITH MEDIAN = 0 AND 75% POINT = 1. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--SIN, COS. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--TOCHER, THE ART OF SIMULATION, C 1963, PAGE 15. C --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS, C 1964, PAGE 36. C --FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGE 231. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 154-165. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82/7 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) C C--------------------------------------------------------------------- C CCCCC CHARACTER*4 IFEEDB CCCCC CHARACTER*4 IPRINT C CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW CCCCC COMMON /PRINT/IFEEDB,IPRINT C C-----DATA STATEMENTS------------------------------------------------- C DATA PI/3.14159265359/ C IPR=6 C C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 GOTO90 50 WRITE(IPR, 5) WRITE(IPR,47)N RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 CAURAN SUBROUTINE IS NON-POSITIVE *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C GENERATE N UNIFORM (0,1) RANDOM NUMBERS; C CALL UNIRAN(N,ISEED,X) C C GENERATE N CAUCHY RANDOM NUMBERS C USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD. C DO100I=1,N ARG=PI*X(I) X(I)=-COS(ARG)/SIN(ARG) 100 CONTINUE C RETURN END SUBROUTINE CAUSF(P,SF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT CAUSF C C PURPOSE--THIS SUBROUTINE COMPUTES THE SPARSITY C FUNCTION VALUE FOR THE CAUCHY DISTRIBUTION C WITH MEDIAN = 0 AND 75% POINT = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = (1/PI)*(1/(1+X*X)). C NOTE THAT THE SPARSITY FUNCTION OF A DISTRIBUTION C IS THE DERIVATIVE OF THE PERCENT POINT FUNCTION, C AND ALSO IS THE RECIPROCAL OF THE PROBABILITY C DENSITY FUNCTION (BUT IN UNITS OF P RATHER THAN X). C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 AND 1.0) C AT WHICH THE SPARSITY C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--SF = THE SINGLE PRECISION C SPARSITY FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION SPARSITY C FUNCTION VALUE SF. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--P SHOULD BE BETWEEN 0.0 AND 1.0, EXCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--SIN. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGES 21-44, 229-231. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 154-165. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DATA PI/3.14159265358979/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LE.0.0.OR.P.GE.1.0)GOTO50 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 CAUSF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C ARG=PI*P SF=PI/((SIN(ARG))**2) C RETURN END SUBROUTINE CHSCDF(X,NU,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT CHSCDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR THE CHI-SQUARED DISTRIBUTION C WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU. C THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X. C THE PROBABILITY DENSITY FUNCTION IS GIVEN C IN THE REFERENCES BELOW. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C X SHOULD BE NON-NEGATIVE. C --NU = THE INTEGER NUMBER OF DEGREES C OF FREEDOM. C NU SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF FOR THE CHI-SQUARED DISTRIBUTION C WITH DEGREES OF FREEDOM PARAMETER = NU. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--X SHOULD BE NON-NEGATIVE. C --NU SHOULD BE A POSITIVE INTEGER VARIABLE. C OTHER DATAPAC SUBROUTINES NEEDED--NORCDF. C FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DEXP. C MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 941, FORMULAE 26.4.4 AND 26.4.5. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGE 176, C FORMULA 28, AND PAGE 180, FORMULA 33.1. C --OWEN, HANDBOOK OF STATISTICAL TABLES, C 1962, PAGES 50-55. C --PEARSON AND HARTLEY, BIOMETRIKA TABLES C FOR STATISTICIANS, VOLUME 1, 1954, C PAGES 122-131. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --MAY 1974. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --OCTOBER 1976. C C--------------------------------------------------------------------- C DOUBLE PRECISION DX,PI,CHI,SUM,TERM,AI,DCDFN DOUBLE PRECISION DNU DOUBLE PRECISION DSQRT,DEXP DOUBLE PRECISION DLOG DOUBLE PRECISION DFACT,DPOWER DOUBLE PRECISION DW DOUBLE PRECISION D1,D2,D3 DOUBLE PRECISION TERM0,TERM1,TERM2,TERM3,TERM4 DOUBLE PRECISION B11 DOUBLE PRECISION B21 DOUBLE PRECISION B31,B32 DOUBLE PRECISION B41,B42,B43 DATA NUCUT/1000/ DATA PI/3.14159265358979D0/ DATA DPOWER/0.33333333333333D0/ DATA B11/0.33333333333333D0/ DATA B21/-0.02777777777778D0/ DATA B31/-0.00061728395061D0/ DATA B32/-13.0D0/ DATA B41/0.00018004115226D0/ DATA B42/6.0D0/ DATA B43/17.0D0/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(NU.LE.0)GOTO50 IF(X.LT.0.0)GOTO55 GOTO90 50 WRITE(IPR,15) WRITE(IPR,47)NU CDF=0.0 RETURN 55 WRITE(IPR,4) WRITE(IPR,46)X CDF=0.0 RETURN 90 CONTINUE 4 FORMAT(1H , 96H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE CHSCDF SUBROUTINE IS NEGATIVE *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 CHSCDF SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C DX=X ANU=NU DNU=NU C C IF X IS NON-POSITIVE, SET CDF = 0.0 AND RETURN. C IF NU IS SMALLER THAN 10 AND X IS MORE THAN 200 C STANDARD DEVIATIONS BELOW THE MEAN, C SET CDF = 0.0 AND RETURN. C IF NU IS 10 OR LARGER AND X IS MORE THAN 100 C STANDARD DEVIATIONS BELOW THE MEAN, C SET CDF = 0.0 AND RETURN. C IF NU IS SMALLER THAN 10 AND X IS MORE THAN 200 C STANDARD DEVIATIONS ABOVE THE MEAN, C SET CDF = 1.0 AND RETURN. C IF NU IS 10 OR LARGER AND X IS MORE THAN 100 C STANDARD DEVIATIONS ABOVE THE MEAN, C SET CDF = 1.0 AND RETURN. C IF(X.LE.0.0)GOTO105 AMEAN=ANU SD=SQRT(2.0*ANU) Z=(X-AMEAN)/SD IF(NU.LT.10.AND.Z.LT.-200.0)GOTO105 IF(NU.GE.10.AND.Z.LT.-100.0)GOTO105 IF(NU.LT.10.AND.Z.GT.200.0)GOTO107 IF(NU.GE.10.AND.Z.GT.100.0)GOTO107 GOTO109 105 CDF=0.0 RETURN 107 CDF=1.0 RETURN 109 CONTINUE C C DISTINGUISH BETWEEN 3 SEPARATE REGIONS C OF THE (X,NU) SPACE. C BRANCH TO THE PROPER COMPUTATIONAL METHOD C DEPENDING ON THE REGION. C NUCUT HAS THE VALUE 1000. C IF(NU.LT.NUCUT)GOTO1000 IF(NU.GE.NUCUT.AND.X.LE.ANU)GOTO2000 IF(NU.GE.NUCUT.AND.X.GT.ANU)GOTO3000 IBRAN=1 WRITE(IPR,99)IBRAN 99 FORMAT(1H ,42H*****INTERNAL ERROR IN CHSCDF SUBROUTINE--, 146HIMPOSSIBLE BRANCH CONDITION AT BRANCH POINT = ,I8) RETURN C C TREAT THE SMALL AND MODERATE DEGREES OF FREEDOM CASE C (THAT IS, WHEN NU IS SMALLER THAN 1000). C METHOD UTILIZED--EXACT FINITE SUM C (SEE AMS 55, PAGE 941, FORMULAE 26.4.4 AND 26.4.5). C 1000 CONTINUE CHI=DSQRT(DX) IEVODD=NU-2*(NU/2) IF(IEVODD.EQ.0)GOTO120 C SUM=0.0D0 TERM=1.0/CHI IMIN=1 IMAX=NU-1 GOTO130 C 120 SUM=1.0D0 TERM=1.0D0 IMIN=2 IMAX=NU-2 C 130 IF(IMIN.GT.IMAX)GOTO160 DO100I=IMIN,IMAX,2 AI=I TERM=TERM*(DX/AI) SUM=SUM+TERM 100 CONTINUE 160 CONTINUE C SUM=SUM*DEXP(-DX/2.0D0) IF(IEVODD.EQ.0)GOTO170 SUM=(DSQRT(2.0D0/PI))*SUM SPCHI=CHI CALL NORCDF(SPCHI,CDFN) DCDFN=CDFN SUM=SUM+2.0D0*(1.0D0-DCDFN) 170 CDF=1.0D0-SUM RETURN C C TREAT THE CASE WHEN NU IS LARGE C (THAT IS, WHEN NU IS EQUAL TO OR GREATER THAN 1000) C AND X IS LESS THAN OR EQUAL TO NU. C METHOD UTILIZED--WILSON-HILFERTY APPROXIMATION C (SEE JOHNSON AND KOTZ, VOLUME 1, PAGE 176, FORMULA 28). C 2000 CONTINUE DFACT=4.5D0*DNU U=(((DX/DNU)**DPOWER)-1.0D0+(1.0D0/DFACT))*DSQRT(DFACT) CALL NORCDF(U,CDFN) CDF=CDFN RETURN C C TREAT THE CASE WHEN NU IS LARGE C (THAT IS, WHEN NU IS EQUAL TO OR GREATER THAN 1000) C AND X IS LARGER THAN NU. C METHOD UTILIZED--HILL'S ASYMPTOTIC EXPANSION C (SEE JOHNSON AND KOTZ, VOLUME 1, PAGE 180, FORMULA 33.1). C 3000 CONTINUE DW=DSQRT(DX-DNU-DNU*DLOG(DX/DNU)) DANU=DSQRT(2.0D0/DNU) D1=DW D2=DW**2 D3=DW**3 TERM0=DW TERM1=B11*DANU TERM2=B21*D1*(DANU**2) TERM3=B31*(D2+B32)*(DANU**3) TERM4=B41*(B42*D3+B43*D1)*(DANU**4) U=TERM0+TERM1+TERM2+TERM3+TERM4 CALL NORCDF(U,CDFN) CDF=CDFN RETURN C END SUBROUTINE CHSPLT(X,N,NU) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT CHSPLT C C PURPOSE--THIS SUBROUTINE GENERATES A CHI-SQUARED C PROBABILITY PLOT (WITH INTEGER C DEGREES OF FREEDOM PARAMETER VALUE = NU). C THE PROTOTYPE CHI-SQUARED DISTRIBUTION USED C HEREIN IS DEFINED FOR ALL NON-NEGATIVE X, C AND ITS PROBABILITY DENSITY FUNCTION IS GIVEN C IN THE REFERENCES BELOW. C AS USED HEREIN, A PROBABILITY PLOT FOR A DISTRIBUTION C IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS C THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION. C THE CHI-SQUARED PROBABILITY PLOT IS USEFUL IN C GRAPHICALLY TESTING THE COMPOSITE (THAT IS, C LOCATION AND SCALE PARAMETERS NEED NOT BE SPECIFIED) C HYPOTHESIS THAT THE UNDERLYING DISTRIBUTION C FROM WHICH THE DATA HAVE BEEN RANDOMLY DRAWN C IS THE CHI-SQUARED DISTRIBUTION C WITH DEGREES OF FREEDOM PARAMETER VALUE = NU. C IF THE HYPOTHESIS IS TRUE, THE PROBABILITY PLOT C SHOULD BE NEAR-LINEAR. C A MEASURE OF SUCH LINEARITY IS GIVEN BY THE C CALCULATED PROBABILITY PLOT CORRELATION COEFFICIENT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --NU = THE INTEGER NUMBER OF DEGREES C OF FREEDOM. C NU SHOULD BE POSITIVE. C OUTPUT--A ONE-PAGE CHI-SQUARED PROBABILITY PLOT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C --NU SHOULD BE POSITIVE. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, CHSPPF, PLOT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--WILK, GNANADESIKAN, AND HUYETT, 'PROBABILITY C PLOTS FOR THE GAMMA DISTRIBUTION', C TECHNOMETRICS, 1962, PAGES 1-15. C --FILLIBEN, 'TECHNIQUES FOR TAIL LENGTH ANALYSIS', C PROCEEDINGS OF THE EIGHTEENTH CONFERENCE C ON THE DESIGN OF EXPERIMENTS IN ARMY RESEARCH C DEVELOPMENT AND TESTING (ABERDEEN, MARYLAND, C OCTOBER, 1972), PAGES 425-450. C --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING, C 1967, PAGES 260-308. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 166-206. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGES 46-51. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C UPDATED --FEBRUARY 1977. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(7500),W(7500) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501)) C IPR=6 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 IF(NU.LE.0)GOTO60 HOLD=X(1) DO65I=2,N IF(X(I).NE.HOLD)GOTO90 65 CONTINUE WRITE(IPR, 9)HOLD RETURN 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 60 WRITE(IPR,25) WRITE(IPR,47)NU RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE CHSPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 CHSPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE CHSPLT SUBROUTINE HAS THE VALUE 1 *****) 25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 CHSPLT SUBROUTINE IS NON-POSITIVE *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C SORT THE DATA C CALL SORT(X,N,Y) C C GENERATE UNIFORM ORDER STATISTIC MEDIANS C CALL UNIMED(N,W) C C COMPUTE CHI-SQUARED DISTRIBUTION ORDER STATISTIC MEDIANS C DO100I=1,N CALL CHSPPF(W(I),NU,W(I)) 100 CONTINUE C C PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS. C COMPUTE THE TAIL LENGTH MEASURE OF THE DISTRIBUTION. C WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION C AND THE SAMPLE SIZE. C CALL PLOT(Y,W,N) Q=.9975 CALL CHSPPF(Q,NU,PP9975) Q=.0025 CALL CHSPPF(Q,NU,PP0025) Q=.975 CALL CHSPPF(Q,NU,PP975) Q=.025 CALL CHSPPF(Q,NU,PP025) TAU=(PP9975-PP0025)/(PP975-PP025) WRITE(IPR,105)NU,TAU,N C C COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. C COMPUTE LOCATION AND SCALE ESTIMATES C FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. C THEN WRITE THEM OUT. C SUM1=0.0 SUM2=0.0 DO200I=1,N SUM1=SUM1+Y(I) SUM2=SUM2+W(I) 200 CONTINUE YBAR=SUM1/AN WBAR=SUM2/AN SUM1=0.0 SUM2=0.0 SUM3=0.0 DO300I=1,N SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 300 CONTINUE CC=SUM2/SQRT(SUM3*SUM1) YSLOPE=SUM2/SUM3 YINT=YBAR-YSLOPE*WBAR WRITE(IPR,305)CC,YINT,YSLOPE C 105 FORMAT(1H ,55HCHI-SQUARED PROBABILITY PLOT WITH DEGREES OF FREEDOM 1 = ,I8,1X,7H(TAU = ,E15.8,1H),11X,20HTHE SAMPLE SIZE N = ,I7) 305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X, 122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) C RETURN END SUBROUTINE CHSPPF(P,NU,PPF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT CHSPPF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE FOR THE CHI-SQUARED DISTRIBUTION C WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU. C THE CHI-SQUARED DISTRIBUTION USED C HEREIN IS DEFINED FOR ALL NON-NEGATIVE X, C AND ITS PROBABILITY DENSITY FUNCTION IS GIVEN C IN REFERENCES 2, 3, AND 4 BELOW. C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 (INCLUSIVELY) C AND 1.0 (EXCLUSIVELY)) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C --NU = THE INTEGER NUMBER OF DEGREES C OF FREEDOM. C NU SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT FUNCTION . C VALUE PPF FOR THE CHI-SQUARED DISTRIBUTION C WITH DEGREES OF FREEDOM PARAMETER = NU. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--NU SHOULD BE A POSITIVE INTEGER VARIABLE. C --P SHOULD BE BETWEEN 0.0 (INCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--DEXP, DLOG. C MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN. C ACCURACY--(ON THE UNIVAC 1108, EXEC 8 SYSTEM AT NBS) C COMPARED TO THE KNOWN NU = 2 (EXPONENTIAL) C RESULTS, AGREEMENT WAS HAD OUT TO 6 SIGNIFICANT C DIGITS FOR ALL TESTED P IN THE RANGE P = .001 TO C P = .999. FOR P = .95 AND SMALLER, THE AGREEMENT C WAS EVEN BETTER--7 SIGNIFICANT DIGITS. C (NOTE THAT THE TABULATED VALUES GIVEN IN THE WILK, C GNANADESIKAN, AND HUYETT REFERENCE BELOW, PAGE 20, C ARE IN ERROR FOR AT LEAST THE GAMMA = 1 CASE-- C THE WORST DETECTED ERROR WAS AGREEMENT TO ONLY 3 C SIGNIFICANT DIGITS (IN THEIR 8 SIGNIFICANT DIGIT TABLE) C FOR P = .999.) C REFERENCES--WILK, GNANADESIKAN, AND HUYETT, 'PROBABILITY C PLOTS FOR THE GAMMA DISTRIBUTION', C TECHNOMETRICS, 1962, PAGES 1-15, C ESPECIALLY PAGES 3-5. C --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 257, FORMULA 6.1.41, C AND PAGES 940-943. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 166-206. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGES 46-51. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DOUBLE PRECISION DP,DGAMMA DOUBLE PRECISION Z,Z2,Z3,Z4,Z5,DEN,A,B,C,D,G DOUBLE PRECISION XMIN0,XMIN,AI,XMAX,DX,PCALC,XMID DOUBLE PRECISION XLOWER,XUPPER,XDEL DOUBLE PRECISION SUM,TERM,CUT1,CUT2,AJ,CUTOFF,T DOUBLE PRECISION DEXP,DLOG DIMENSION D(10) DATA C/ .918938533204672741D0/ DATA D(1),D(2),D(3),D(4),D(5) 1 /+.833333333333333333D-1,-.277777777777777778D-2, 1+.793650793650793651D-3,-.595238095238095238D-3,+.8417508417508417 151D-3/ DATA D(6),D(7),D(8),D(9),D(10) 1 /-.191752691752691753D-2,+.641025641025641025D-2,-.2955065359 147712418D-1,+.179644372368830573D0,-.139243221690590111D1/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LT.0.0.OR.P.GE.1.0)GOTO50 IF(NU.LT.1)GOTO55 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P PPF=0.0 RETURN 55 WRITE(IPR,15) WRITE(IPR,47)NU PPF=0.0 RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 CHSPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 CHSPPF SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C C EXPRESS THE CHI-SQUARED DISTRIBUTION PERCENT POINT C FUNCTION IN TERMS OF THE EQUIVALENT GAMMA C DISTRIBUTION PERCENT POINT FUNCTION, C AND THEN EVALUATE THE LATTER. C ANU=NU GAMMA=ANU/2.0 DP=P DNU=NU DGAMMA=DNU/2.0D0 MAXIT=10000 C C COMPUTE THE GAMMA FUNCTION USING THE ALGORITHM IN THE C NBS APPLIED MATHEMATICS SERIES REFERENCE. C THIS GAMMA FUNCTION NEED BE CALCULATED ONLY ONCE. C IT IS USED IN THE CALCULATION OF THE CDF BASED ON C THE TENTATIVE VALUE OF THE PPF IN THE ITERATION. C Z=DGAMMA DEN=1.0D0 150 IF(Z.GE.10.0D0)GOTO160 DEN=DEN*Z Z=Z+1.0D0 GOTO150 160 Z2=Z*Z Z3=Z*Z2 Z4=Z2*Z2 Z5=Z2*Z3 A=(Z-0.5D0)*DLOG(Z)-Z+C B=D(1)/Z+D(2)/Z3+D(3)/Z5+D(4)/(Z2*Z5)+D(5)/(Z4*Z5)+ 1D(6)/(Z*Z5*Z5)+D(7)/(Z3*Z5*Z5)+D(8)/(Z5*Z5*Z5)+D(9)/(Z2*Z5*Z5*Z5) G=DEXP(A+B)/DEN C C DETERMINE LOWER AND UPPER LIMITS ON THE DESIRED 100P C PERCENT POINT. C ILOOP=1 XMIN0=(DP*DGAMMA*G)**(1.0D0/DGAMMA) XMIN=XMIN0 ICOUNT=1 350 AI=ICOUNT XMAX=AI*XMIN0 DX=XMAX GOTO1000 360 IF(PCALC.GE.DP)GOTO370 XMIN=XMAX ICOUNT=ICOUNT+1 IF(ICOUNT.LE.30000)GOTO350 370 XMID=(XMIN+XMAX)/2.0D0 C C NOW ITERATE BY BISECTION UNTIL THE DESIRED ACCURACY IS ACHIEVED. C ILOOP=2 XLOWER=XMIN XUPPER=XMAX ICOUNT=0 550 DX=XMID GOTO1000 560 IF(PCALC.EQ.DP)GOTO570 IF(PCALC.GT.DP)GOTO580 XLOWER=XMID XMID=(XMID+XUPPER)/2.0D0 GOTO590 580 XUPPER=XMID XMID=(XMID+XLOWER)/2.0D0 590 XDEL=XMID-XLOWER IF(XDEL.LT.0.0D0)XDEL=-XDEL ICOUNT=ICOUNT+1 IF(XDEL.LT.0.0000000001D0.OR.ICOUNT.GT.100)GOTO570 GOTO550 570 PPF=2.0D0*XMID RETURN C C******************************************************************** C THIS SECTION BELOW IS LOGICALLY SEPARATE FROM THE ABOVE. C THIS SECTION COMPUTES A CDF VALUE FOR ANY GIVEN TENTATIVE C PERCENT POINT X VALUE AS DEFINED IN EITHER OF THE 2 C ITERATION LOOPS IN THE ABOVE CODE. C C COMPUTE T-SUB-Q AS DEFINED ON PAGE 4 OF THE WILK, GNANADESIKAN, C AND HUYETT REFERENCE C 1000 SUM=1.0D0/DGAMMA TERM=1.0D0/DGAMMA CUT1=DX-DGAMMA CUT2=DX*10000000000.0D0 DO700J=1,MAXIT AJ=J TERM=DX*TERM/(DGAMMA+AJ) SUM=SUM+TERM CUTOFF=CUT1+(CUT2*TERM/SUM) IF(AJ.GT.CUTOFF)GOTO750 700 CONTINUE WRITE(IPR,705)MAXIT WRITE(IPR,706)P WRITE(IPR,707)NU WRITE(IPR,708) PPF=0.0 RETURN C 750 T=SUM PCALC=(DX**DGAMMA)*(DEXP(-DX))*T/G IF(ILOOP.EQ.1)GOTO360 GOTO560 C 705 FORMAT(1H ,48H*****ERROR IN INTERNAL OPERATIONS IN THE CHSPPF , 1 45HSUBROUTINE--THE NUMBER OF ITERATIONS EXCEEDS ,I7) 706 FORMAT(1H ,33H THE INPUT VALUE OF P IS ,E15.8) 707 FORMAT(1H ,33H THE INPUT VALUE OF NU IS ,I8) 708 FORMAT(1H ,48H THE OUTPUT VALUE OF PPF HAS BEEN SET TO 0.0) C END SUBROUTINE CHSRAN(N,NU,ISEED,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT CHSRAN C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE CHI-SQUARED DISTRIBUTION C WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU. C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C --NU = THE INTEGER DEGREES OF FREEDOM C (PARAMETER) FOR THE CHI-SQUARED C DISTRIBUTION. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE CHI-SQUARED DISTRIBUTION C WITH DEGREES OF FREEDOM PARAMETER = NU. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C --NU SHOULD BE A POSITIVE INTEGER VARIABLE. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG, SQRT, SIN, COS. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--TOCHER, THE ART OF SIMULATION, C 1963, PAGES 34-35. C --MOOD AND GRABLE, INTRODUCTION TO THE C THEORY OF STATISTICS, 1963, PAGES 226-227. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGE 171. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGE 48. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82/7 C ORIGINAL VERSION--FEBRUARY 1975. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) DIMENSION Y(2),Z(2) C C--------------------------------------------------------------------- C CCCCC CHARACTER*4 IFEEDB CCCCC CHARACTER*4 IPRINT C CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW CCCCC COMMON /PRINT/IFEEDB,IPRINT C C-----DATA STATEMENTS------------------------------------------------- C DATA PI/3.14159265359/ C IPR=6 C C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(NU.LE.0)GOTO60 GOTO90 50 WRITE(IPR,5) WRITE(IPR,47)N RETURN 60 WRITE(IPR,15) WRITE(IPR,47)NU RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 CHSRAN SUBROUTINE IS NON-POSITIVE *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 CHSRAN SUBROUTINE IS NON-POSITIVE *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C GENERATE N CHI-SQUARED RANDOM NUMBERS C USING THE DEFINITION THAT C A CHI-SQUARED VARIATE WITH NU DEGREES OF FREEDOM C EQUALS THE SUM OF NU SQUARED NORMAL VARIATES. C FIRST GENERATE 2 UNIFORM (0,1) RANDOM NUMBERS, C THEN GENERATE 2 NORMAL RANDOM NUMBERS, C THEN FORM THE SUM OF SQUARED NORMAL RANDOM NUMBERS. C DO100I=1,N SUM=0.0 DO200J=1,NU,2 CALL UNIRAN(2,ISEED,Y) ARG1=-2.0*ALOG(Y(1)) ARG2=2.0*PI*Y(2) Z(1)=(SQRT(ARG1))*(COS(ARG2)) Z(2)=(SQRT(ARG1))*(SIN(ARG2)) SUM=SUM+Z(1)*Z(1) IF(J.EQ.NU)GOTO200 SUM=SUM+Z(2)*Z(2) 200 CONTINUE X(I)=SUM 100 CONTINUE C RETURN END SUBROUTINE CODE(X,N,Y) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT CODE C C PURPOSE--THIS SUBROUTINE CODES THE ELEMENTS C OF THE INPUT VECTOR X C AND PUTS THE CODED VALUES INTO THE OUTPUT VECTOR Y. C THE CODING IS AS FOLLOWS-- C THE MINIMUM IS CODED AS 1.0. C THE NEXT LARGER VALUE AS 2.0, C THE NEXT LARGER VALUE AS 3.0, C ETC. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR C OF OBSERVATIONS TO BE CODED. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR C INTO WHICH THE CODED VALUES C WILL BE PLACED. C OUTPUT--THE SINGLE PRECISION VECTOR Y C WHICH WILL CONTAIN THE CODED VALUES C CORRESPONDING TO THE OBSERVATIONS IN C THE VECTOR X. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 15000. C OTHER DATAPAC SUBROUTINES NEEDED--SORT. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--ALL OCCURRANCES OF THE MINIMUM ARE CODED AS 1.0; C ALL OCCURANCES OF THE NEXT LARGER VALUE C ARE CODED AS 2.0; C ALL OCCURANCES OF THE NEXT LARGER VALUE C ARE CODED AS 3.0, ETC. C COMMENT--THE INPUT VECTOR X REMAINS UNALTERED. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--OCTOBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --JUNE 1977. C C--------------------------------------------------------------------- C DIMENSION X(1),Y(1) DIMENSION DIST(15000) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (DIST(1),WS(1)) C IPR=6 IUPPER=15000 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD DO61I=1,N Y(I)=I 61 CONTINUE RETURN 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) Y(1)=1.0 RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE CODE SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 CODE SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE CODE SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C C PERFORM THE CODING-- C PULL OUT THE DISTINCT VALUES, C THEN SORT (AND ESSENTIALLY RANK) THE DISTINCT VALUES, C THEN APPLY THE RANKS TO ALL THE VALUES. C NUMDIS=1 DIST(NUMDIS)=X(1) DO100I=2,N DO200J=1,NUMDIS IF(X(I).EQ.DIST(J))GOTO100 200 CONTINUE NUMDIS=NUMDIS+1 DIST(NUMDIS)=X(I) 100 CONTINUE C CALL SORT(DIST,NUMDIS,DIST) C DO600I=1,N DO700J=1,NUMDIS IF(X(I).EQ.DIST(J))GOTO750 700 CONTINUE WRITE(IPR,705) WRITE(IPR,710)I,X(I) 705 FORMAT(1H ,'*****INTERNAL ERROR IN CODE SUBROUTINE') 710 FORMAT(1H ,'NO CODE FOUND FOR ELEMENT NUMBER ',I5,' = ',F15.7) RETURN 750 Y(I)=J 600 CONTINUE C C WRITE OUT A FEW LINES OF SUMMARY INFORMATION ABOUT THE CODING. C WRITE(IPR,999) WRITE(IPR,905) WRITE(IPR,906)NUMDIS WRITE(IPR,999) WRITE(IPR,910) DO900I=1,NUMDIS AI=I WRITE(IPR,915)DIST(I),AI 900 CONTINUE 905 FORMAT(1H ,'OUTPUT FROM THE CODE SUBROUTINE') 906 FORMAT(1H ,'NUMBER OF DISTINCT CODE VALUES = ',I8) 999 FORMAT(1H ) 910 FORMAT(1H ,8X,'VALUE CODED VALUE') 915 FORMAT(1H ,F15.7,6X,F6.0) C RETURN END SUBROUTINE COPY(X,N,Y) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT COPY C C PURPOSE--THIS SUBROUTINE COPIES THE CONTENTS C OF THE SINGLE PRECISION VECTOR X INTO THE C SINGLE PRECISION VECTOR Y. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C OBSERVATIONS TO BE COPIED. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR C INTO WHICH THE COPIED DATA VALUES C FROM X WILL BE SEQUENTIALLY PLACED. C OUTPUT--THE SINGLE PRECISION VECTOR Y. C WHICH WILL HAVE ITS C FIRST N ELEMENTS IDENTICAL C TO THE SINGLE PRECISION VECTOR X. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--THE FIRST ELEMENT OF X IS COPIED INTO THE FIRST C ELEMENT OF Y; THE SECOND ELEMENT OF X IS COPIED INTO C THE SECOND ELEMENT OF Y, ETC. C COMMENT--THE INPUT VECTOR X REMAINS UNALTERED. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--NOVEMBER 1972. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1),Y(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) 90 CONTINUE 9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE COPY SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 COPY SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE COPY SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C DO100I=1,N Y(I)=X(I) 100 CONTINUE C RETURN END SUBROUTINE CORR(X,Y,N,IWRITE,C) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT CORR C C PURPOSE--THIS SUBROUTINE COMPUTES THE C SAMPLE CORRELATION COEFFICIENT C BETWEEN THE 2 SETS OF DATA IN THE INPUT VECTORS X AND Y. C THE SAMPLE CORRELATION COEFFICIENT WILL BE A SINGLE C PRECISION VALUE BETWEEN -1.0 AND 1.0 (INCLUSIVELY). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED) OBSERVATIONS C WHICH CONSTITUTE THE FIRST SET C OF DATA. C --Y = THE SINGLE PRECISION VECTOR OF C (UNSORTED) OBSERVATIONS C WHICH CONSTITUTE THE SECOND SET C OF DATA. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X, OR EQUIVALENTLY, C THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR Y. C --IWRITE = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL SUPPRESS C THE PRINTING OF THE C SAMPLE CORRELATION COEFFICIENT C AS IT IS COMPUTED; C OR (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0), C LIKE, SAY, 1) WILL CAUSE C THE PRINTING OF THE C SAMPLE CORRELATION COEFFICIENT C AT THE TIME IT IS COMPUTED. C OUTPUT ARGUMENTS--C = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE CORRELATION COEFFICIENT C BETWEEN THE 2 SETS OF DATA C IN THE INPUT VECTORS X AND Y. C THIS SINGLE PRECISION VALUE C WILL BE BETWEEN -1.0 AND 1.0 C (INCLUSIVELY). C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SAMPLE CORRELATION COEFFICIENT BETWEEN THE 2 SETS C OF DATA IN THE INPUT VECTORS X AND Y. C PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO C INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR C CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 235-236. C --KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 2, EDITION 1, 1961, PAGES 292-293. C --SNEDECOR AND COCHRAN, STATISTICAL METHODS, C EDITION 6, 1967, PAGES 172-198. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1),Y(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C AN=N C=0.0 IFLAG=0 IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO65 60 CONTINUE WRITE(IPR, 9)HOLD IFLAG=1 65 HOLD=Y(1) DO70I=2,N IF(Y(I).NE.HOLD)GOTO80 70 CONTINUE WRITE(IPR,19)HOLD IFLAG=1 80 IF(IFLAG.EQ.1)RETURN GOTO90 50 WRITE(IPR,25) WRITE(IPR,47)N RETURN 55 WRITE(IPR,28) RETURN 90 CONTINUE 9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE CORR SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 19 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT (A VECTOR) TO THE CORR SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 CORR SUBROUTINE IS NON-POSITIVE *****) 28 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE THIRD INPUT ARGUME 1NT TO THE CORR SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C XBAR=0.0 YBAR=0.0 DO100I=1,N XBAR=XBAR+X(I) YBAR=YBAR+Y(I) 100 CONTINUE XBAR=XBAR/AN YBAR=YBAR/AN C SUM1=0.0 SUM2=0.0 SUM3=0.0 DO200I=1,N SUM1=SUM1+(X(I)-XBAR)*(Y(I)-YBAR) SUM2=SUM2+(X(I)-XBAR)**2 SUM3=SUM3+(Y(I)-YBAR)**2 200 CONTINUE SUM2=SQRT(SUM2) SUM3=SQRT(SUM3) C =SUM1/(SUM2*SUM3) C IF(IWRITE.NE.0)WRITE(IPR,205)N,C 205 FORMAT(1H ,59HTHE LINEAR CORRELATION COEFFICIENT OF THE 2 S 1ETS OF ,I6,17H OBSERVATIONS IS ,F14.5) RETURN END SUBROUTINE COUNT(X,N,XMIN,XMAX,IWRITE,XCOUNT) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT COUNT C C PURPOSE--THIS SUBROUTINE COMPUTES C THE NUMBER OF OBSERVATIONS C BETWEEN XMIN AND XMAX (INCLUSIVELY) C IN THE INPUT VECTOR X. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --XMIN = THE SINGLE PRECISION VALUE C WHICH DEFINES THE LOWER LIMIT C (INCLUSIVELY) OF THE REGION C OF INTEREST. C --XMAX = THE SINGLE PRECISION VALUE C WHICH DEFINES THE UPPER LIMIT C (INCLUSIVELY) OF THE REGION C OF INTEREST. C --IWRITE = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL SUPPRESS C THE PRINTING OF THE C SAMPLE COUNT C AS IT IS COMPUTED; C OR (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0), C LIKE, SAY, 1) WILL CAUSE C THE PRINTING OF THE C SAMPLE COUNT C AT THE TIME IT IS COMPUTED. C OUTPUT ARGUMENTS--XCOUNT = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE COUNT. C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SAMPLE COUNT. C PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO C INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR C CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--SNEDECOR AND COCHRAN, STATISTICAL METHODS, C EDITION 6, 1967, PAGES 207-213. C --DIXON AND MASSEY, INTRODUCTION TO STATISTICAL C ANALYSIS, EDITION 2, 1957, PAGES 81-82, 228-231. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 IF(XMIN.EQ.XMAX)GOTO80 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD XCOUNT=0.0 RETURN 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XCOUNT=0.0 RETURN 80 WRITE(IPR,26) WRITE(IPR,49)XMIN XCOUNT=0.0 RETURN 90 CONTINUE 9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE COUNT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 COUNT SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE COUNT SUBROUTINE HAS THE VALUE 1 *****) 26 FORMAT(1H ,46H***** FATAL ERROR--THE THIRD AND FOURTH INPUT , 1 48HARGUMENTS TO THE COUNT SUBROUTINE ARE IDENTICAL) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) 49 FORMAT(1H , 37H***** THE VALUE OF THE ARGUMENTS ARE ,E15.7 ,6H * 1****) C C-----START POINT----------------------------------------------------- C AN=N XCOUNT=0.0 ISUM=0 DO100I=1,N IF(X(I).LT.XMIN.OR.XMAX.LT.X(I))GOTO100 ISUM=ISUM+1 100 CONTINUE XCOUNT=ISUM C 101 IF(IWRITE.EQ.0)RETURN WRITE(IPR,999) WRITE(IPR,105)N,XMIN,XMAX,XCOUNT 105 FORMAT(1H ,23HTHE NUMBER (OUT OF THE ,I6,31H OBSERVATIONS) IN THE 1INTERVAL ,E15.7,4H TO ,E15.7,4H IS ,E15.7) 999 FORMAT(1H ) RETURN END SUBROUTINE DECOMP(N,K,ETA,TOL,IRANK,INSING) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT DECOMP EXTERNAL DOT C C PURPOSE--THIS SUBROUTINE DECOMPOSES THE WEIGHTED DATA C MATRIX Q WHICH ORIGINALLY = THE N BY K DATA MATRIX X C TIMES THE SQUARE ROOT OF THE WEIGHTS (IN W). C THE ORIGINAL Q IS DECOMPOSED INTO A NEW Q TIMES THE C INVERSE OF A DIAGONAL MATRIX D TIMES THE DIAGONAL MATRIX D C TIMES AN UPPER TRIANGULAR MATRIX R. C THE NEW N BY K Q HAS ORTHOGONAL COLUMNS. C A SECOND OUTPUT FROM THIS SUBROUTINE IS THE RANK AND C STATUS (NON-SINGULAR OR SINGULAR) OF THE DATA MATRIX X. C A THIRD OURPUT FROM THIS SUBROUTINE IS THE NUMERICALLY C OPTIMAL PIVOT POINTS FOR THE DECOMPOSITION. C X--NOT USED C Q--USED AND CHANGED C R--DEFINED C D--PERMANENTLY DEFINED C IPIVOT--PERMANENTLY DEFINED C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C LOGICAL FSUM DIMENSION Q(10000),R(2500),D(50),IPIVOT(50) COMMON /BLOCK2/ WS(15000) COMMON /BLOCK3/ DUM1(3000),DUM2(3000) EQUIVALENCE (Q(1),WS(1)) EQUIVALENCE (R(1),WS(10001)) EQUIVALENCE (D(1),WS(12501)) EQUIVALENCE (IPIVOT(1),WS(12551)) C C-----START POINT----------------------------------------------------- C C ZERO-OUT SOME VARIABLES, VECTORS, AND ARRAYS C INSING=0 IRANK=0 DO 5 J=1,K D(J) = 0.0 DO 6 I=1,K IRARG=(I-1)*K+J R(IRARG)=0.0 6 CONTINUE 5 CONTINUE C TOL2=TOL*TOL DO 10 J=1,K 10 IPIVOT(J)=J DO 200 IS=1,K C C BEGIN STEP NUMBER IS IN THE DECOMPOSITION C IF (IS.EQ.1) GO TO 20 GO TO 30 20 FSUM=.TRUE. 30 DIS=0.0 IP=IS C C BEGIN THE PIVOT SEARCH C DO 80 J=IS,K M=IPIVOT(J) IF (FSUM) GO TO 40 GO TO 60 40 DO 50 L=1,N IQARG=(L-1)*K+M DUM1(L)=Q(IQARG) 50 DUM2(L)=Q(IQARG) C CALL DOT(DUM1,DUM2,1,N,0.0,D(J)) C 60 IF (DIS.LT.D(J)) GO TO 70 GO TO 80 70 DIS=D(J) IP=J 80 CONTINUE C C END THE PIVOT SEARCH C M=IPIVOT(IP) IF (FSUM) DN=DIS IF (DIS.LT.ETA*DN) GO TO 90 FSUM=.FALSE. GO TO 100 90 FSUM=.TRUE. 100 IF (FSUM) GO TO 30 IF (IP.NE.IS) GO TO 110 GO TO 130 C C BEGIN COLUMN INTERCHANGES C 110 D(IP)=D(IS) IPIVOT(IP)=IPIVOT(IS) IPIVOT(IS)=M IF (IS.EQ.1) GO TO 130 ISM1=IS-1 DO 120 I=1,ISM1 IRARG1=(I-1)*K+IP IRARG2=(I-1)*K+IS HOLD=R(IRARG1) R(IRARG1)=R(IRARG2) 120 R(IRARG2)=HOLD C C END COLUMN INTERCHANGES C 130 DO 140 L=1,N IQARG=(L-1)*K+M DUM1(L)=Q(IQARG) 140 DUM2(L)=Q(IQARG) C CALL DOT(DUM1,DUM2,1,N,0.0,D(IS)) C DIS=D(IS) IF (DIS.LE.TOL2*D(1)) RETURN IF(DIS.NE.0.0)GOTO150 INSING=0 RETURN 150 ISP1=IS+1 IF (ISP1.GT.K) GO TO 190 C C BEGIN ORTHOGONALIZATION C DO 180 J=ISP1,K IP=IPIVOT(J) DO 160 L=1,N IQARG1=(L-1)*K+M IQARG2=(L-1)*K+IP DUM1(L)=Q(IQARG1) 160 DUM2(L)=Q(IQARG2) C IRARG=(IS-1)*K+J CALL DOT(DUM1,DUM2,1,N,0.0,R(IRARG)) R(IRARG)=R(IRARG)/DIS C RISJ=R(IRARG) DO 170 I=1,N IQARG1=(I-1)*K+IP IQARG2=(I-1)*K+M 170 Q(IQARG1)=Q(IQARG1)-RISJ*Q(IQARG2) 180 D(J)=D(J)-DIS*RISJ*RISJ C C END ORTHOGONALIZATION C 190 IRANK=IS 200 CONTINUE C C END STEP NUMBER IS INTHE DECOMPOSITION C INSING=1 RETURN END SUBROUTINE DEFINE(X,N,XNEW) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT DEFINE C C PURPOSE--THIS SUBROUTINE SETS ALL OF THE ELEMENTS C IN THE SINGLE PRECISION VECTOR X C EQUAL TO XNEW. C THIS SUBROUTINE IS USEFUL IN DEFINING A C VECTOR OF CONSTANTS. C FOR EXAMPLE, IF THE DATA ANALYST WISHES C TO TREAT THE EQUAL WEIGHTS CASE IN DOING C A POLYNOMIAL REGRESSION, THIS COULD C BE DONE BY DEFINING AS, SAY, 1.0 C THE INPUT WEIGHT VECTOR W TO THE C DATAPAC POLY SUBROUTINE; C SUCH DEFINING COULD BE DONE C BY USE OF THE DEFINE SUBROUTINE C WITH XNEW = 1.0. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --XNEW = THE SINGLE PRECISION VALUE C TO WHICH ALL OF THE C OBSERVATIONS IN THE VECTOR X C WILL BE SET. C OUTPUT--THE SINGLE PRECISION VECTOR X C EVERY ELEMENT OF WHICH C WILL BE EQUAL TO XNEW. C ALSO, 3 LINES OF SUMMARY INFORMATION C WILL BE GENERATED INDICATING C 1) WHAT THE SAMPLE SIZE WAS (N); C 2) WHAT THE DEFINING CONSTANT WAS (XNEW); C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED VERSION--JULY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 GOTO90 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) 90 CONTINUE 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 DEFINE SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE DEFINE SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C DO100I=1,N X(I)=XNEW 100 CONTINUE C C WRITE OUT A BRIEF SUMMARY C WRITE(IPR,999) WRITE(IPR,101) WRITE(IPR,110)N WRITE(IPR,111)XNEW 101 FORMAT(1H ,35HOUTPUT FROM THE DEFINE SUBROUTINE--) 110 FORMAT(1H ,7X,38HTHE INPUT NUMBER OF OBSERVATIONS IS ,I6) 111 FORMAT(1H ,7X,25HTHE DEFINING CONSTANT IS ,E15.8) 999 FORMAT(1H ) C RETURN END SUBROUTINE DELETE(X,N,XMIN,XMAX,NEWN) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT DELETE C C PURPOSE--THIS SUBROUTINE DELETES ALL OBSERVATIONS IN THE C SINGLE PRECISION VECTOR X WHICH ARE INSIDE C THE CLOSED (INCLUSIVE) INTERVAL C DEFINED BY XMIN AND XMAX, C WHILE RETAINING ALL OBSERVATIONS OUTSIDE OF C THIS INTERVAL. C THUS ALL OBSERVATIONS IN X WHICH ARE LARGER C THAN OR EQUAL TO XMIN AND SMALLER THAN OR C EQUAL TO XMAX ARE DELETED FROM X. C THIS SUBROUTINE (AND THE C REPLAC AND RETAIN SUBROUTINES) C GIVES THE DATA ANALYST THE ABILITY TO C EASILY 'CLEAN UP' A DATA SET WHICH HAS C MISSING AND/OR OUTLYING OBSERVATIONS C SO THAT A MORE APPROPRIATE SUBSEQUENT C DATA ANALYSIS MAY BE PERFORMED. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --XMIN = THE SINGLE PRECISION VALUE C WHICH DEFINES THE LOWER LIMIT C (INCLUSIVELY) OF THE PARTICULAR C INTERVAL OF INTEREST TO BE DELETED. C --XMAX = THE SINGLE PRECISION VALUE C WHICH DEFINES THE UPPER LIMIT C (INCLUSIVELY) OF THE PARTICULAR C INTERVAL OF INTEREST TO BE DELETED. C OUTPUT ARGUMENTS--NEWN = THE INTEGER NUMBER OF OBSERVATIONS C REMAINING IN X AFTER ALL C OF THE OBSERVATIONS INSIDE C (INCLUSIVELY) THE INTERVAL C OF INTEREST HAVE BEEN DELETED. C OUTPUT--THE SINGLE PRECISION VECTOR X C IN WHICH ALL THOSE VALUES INSIDE C (INCLUSIVELY) THE INTERVAL OF INTEREST C HAVE BEEN DELETED, AND C THE INTEGER VALUE NEWN C WHICH GIVES THE NUMBER OF C OBSERVATIONS REMAINING IN X. C ALSO, 6 LINES OF SUMMARY INFORMATION C WILL BE GENERATED INDICATING C 1) WHAT THE INTERVAL OF INTEREST WAS; C 2) HOW MANY OBSERVATIONS WERE DELETED; C 3) WHAT THE OLD (ORIGINAL) SAMPLE SIZE WAS (N); C 4) WHAT THE NEW SAMPLE SIZE IS (NEWN). C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--IN THE END, AFTER THIS SUBROUTINE HAS C MADE WHATEVER DELETIONS ARE APPROPRIATE, C THE OUTPUT VECTOR X WILL BE 'PACKED'; C THAT IS, NO 'HOLES' WILL EXIST IN THE C VECTOR X--ALL OF THE RETAINED ELEMENTS C OF X WILL BE PACKED INTO THE FIRST AVAILABLE C LOCATIONS IN X, WHILE THE REMAINDER C OF THE N LOCATIONS IN X WILL BE ZERO-FILLED. C COMMENT--IN THE MAIN (CALLING) ROUTINE, IT IS C PERMISSABLE (IF THE ANALYST SO DESIRES) C TO USE THE SAME VARIABLE NAME C IN THE FIFTH ARGUMENT AS USED IN THE SECOND C ARGUMENT IN THE CALLING SEQUENCE TO THIS C DELETE SUBROUTINE--NO CONFLICT WILL RESULT C IN THE INTERNAL OPERATION OF THE DELETE C SUBROUTINE. FOR EXAMPLE, IT IS PERMISSIBLE C TO HAVE CALL DELETE(X,N,-10.0,10.0,N) C IN WHICH THE VARIABLE NAME N IS USED C AS BOTH THE SECOND AND FIFTH ARGUMENTS. C COMMENT--THIS IS ONE OF THE FEW SUBROUTINES IN DATAPAC C IN WHICH THE INPUT VECTOR X IS ALTERED. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--JULY 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) 90 CONTINUE 9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE DELETE SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 DELETE SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE DELETE SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C POINTL=XMIN POINTU=XMAX IF(XMIN.GT.XMAX)POINTL=XMAX IF(XMIN.GT.XMAX)POINTU=XMIN C NOLD=N K=0 DO100I=1,NOLD IF(POINTL.LE.X(I).AND.X(I).LE.POINTU)GOTO100 K=K+1 X(K)=X(I) 100 CONTINUE NEWN=K NDEL=NOLD-NEWN C NEWNP1=NEWN+1 IF(NEWNP1.GT.NOLD)GOTO250 DO200I=NEWNP1,NOLD X(I)=0.0 200 CONTINUE 250 CONTINUE C C WRITE OUT A BRIEF SUMMARY C WRITE(IPR,999) WRITE(IPR,101) WRITE(IPR,105)POINTL,POINTU WRITE(IPR,106) WRITE(IPR,107) WRITE(IPR,108) WRITE(IPR,110)NOLD WRITE(IPR,115)NEWN WRITE(IPR,120)NDEL 101 FORMAT(1H ,35HOUTPUT FROM THE DELETE SUBROUTINE--) 105 FORMAT(1H ,7X,25HALL OBSERVATIONS BETWEEN ,E15.8,5H AND ,E15.8) 106 FORMAT(1H ,7X,30H(INCLUSIVE) HAVE BEEN DELETED.) 107 FORMAT(1H ,7X,41HALL OBSERVATIONS OUTSIDE OF THIS INTERVAL) 108 FORMAT(1H ,7X,19HHAVE BEEN RETAINED.) 110 FORMAT(1H ,7X,44HTHE INPUT NUMBER OF OBSERVATIONS (IN X) IS ,I6) 115 FORMAT(1H ,7X,44HTHE OUTPUT NUMBER OF OBSERVATIONS (IN X) IS ,I6) 120 FORMAT(1H ,7X,44HTHE NUMBER OF OBSERVATIONS DELETED IS ,I6) 999 FORMAT(1H ) C RETURN END SUBROUTINE DEMOD(X,N,F) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT DEMOD C C PURPOSE--THIS SUBROUTINE PERFORMS A COMPLEX DEMODULATION C ON THE DATA IN THE INPUT VECTOR X C AT THE INPUT DEMODULATION FREQUENCY = F. C THE COMPLEX DEMODULATION CONSISTS OF THE FOLLOWING-- C 1) AN AMPLITUDE VERSUS TIME PLOT; C 2) A PHASE VERSUS TIME PLOT; C 3) AN UPDATED DEMODULATION FREQUENCY ESTIMATE C TO ASSIST THE ANALYST IN DETERMINING A C MORE APPROPRIATE FREQUENCY AT WHICH C TO DEMODULATE IN CASE THE SPECIFIED C INPUT DEMODULATION FREQUENCY F C DOES NOT FLATTEN SUFFICIENTLY THE C PHASE PLOT. C C THE ALLOWABLE RANGE OF THE INPUT DEMODULATION C FREQUENCY F IS 0.0 TO 0.5 (EXCLUSIVELY). C THE INPUT DEMODULATION FREQUENCY F IS MEASURED OF C IN UNITS OF CYCLES PER 'DATA POINT' OR, C MORE PRECISELY, IN CYCLES PER UNIT TIME WHERE C 'UNIT TIME' IS DEFINED AS THE C ELAPSED TIME BETWEEN ADJACENT OBSERVATIONS. C C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED) OBSERVATIONS. C N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C F = THE SINGLE PRECISION C DEMODULATION FREQUENCY. C F IS IN UNITS OF CYCLES PER DATA POINT. C F IS BETWEEN 0.0 AND 0.5 (EXCLUSIVELY). C OUTPUT--2 PAGES OF AUTOMATIC PRINTOUT-- C 1) AN AMPLITUDE PLOT; C 2) A PHASE PLOT; AND C 3) AN UPDATED DEMODULATION FREQUENCY ESTIMATE. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 5000. C --THE SAMPLE SIZE N MUST BE GREATER C THAN OR EQUAL TO 3. C --THE INPUT FREQUENCY F MUST BE C GREATER THAN OR EQUAL TO 2/(N-2). C --THE INPUT FREQUENCY F MUST BE C SMALLER THAN 0.5. C OTHER DATAPAC SUBROUTINES NEEDED--PLOTX. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, SIN, COS, ATAN. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--IN ORDER THAT THE RESULTS OF THE COMPLEX DEMODULATION C BE VALID AND PROPERLY INTERPRETED, THE INPUT DATA C IN X SHOULD BE EQUI-SPACED IN TIME C (OR WHATEVER VARIABLE CORRESPONDS TO TIME). C --IF THE INPUT OBSERVATIONS IN X ARE CONSIDERED C TO HAVE BEEN COLLECTED 1 SECOND APART IN TIME, C THEN THE DEMODULATION FREQUENCY F C WOULD BE IN UNITS OF HERTZ C (= CYCLES PER SECOND). C --A FREQUENCY OF 0.0 CORRESPONDS TO A CYCLE C IN THE DATA OF INFINITE (= 1/(0.0)) C LENGTH OR PERIOD. C A FREQUENCY OF 0.5 CORRESPONDS TO A CYCLE C IN THE DATA OF LENGTH = 1/(0.5) = 2 DATA POINTS. C --IN EXAMINING THE AMPLITUDE AND PHASE PLOTS, C ATTENTION SHOULD BE PAID NOT ONLY TO THE C STRUCTURE OF THE PHASE PLOT C (NEAR-ZERO SLOPE VERSUS NON-ZERO SLOPE) C BUT ALSO TO THE RANGE C OF VALUES ON THE VERTICAL AXIS. C A PLOT WITH MUCH STRUCTURE BUT C WITH A SMALL RANGE ON THE VERTICAL AXIS C IS USUALLY MORE INDICATIVE OF A C DEFINITE CYCLIC COMPONENT AT THE C SPECIFIED INPUT DEMODULATION FREQUENCY, C THAN IS A PLOT WITH LESS STRUCTURE BUT C A WIDER RANGE ON THE VERTICAL AXIS. C --INTERNAL TO THIS SUBROUTINE, 2 MOVING C AVERAGES ARE APPLIED, EACH OF LENGTH 1/F. C HENCE THE AMPLITUDE AND PHASE PLOTS C HAVE N - 2/F VALUES C (RATHER THAN N VALUES) ALONG THE C HORIZONTAL (TIME) AXIS. C IN ORDER THAT THE AMPLITUDE AND PHASE C PLOTS BE NON-EMPTY, AN INPUT C REQUIREMENT ON F FOR THIS SUBROUTINE C IS THAT THE SAMPLE SIZE N C AND THE DEMODULATION FREQUENCY F C MUST BE SUCH THAT C N - 2/F BE GREATER THAN ZERO. C FURTHER, SINCE A PLOT WITH BUT C 1 POINT IS MEANINGLESS C AND OUGHT ALSO BE EXCLUDED, C THE REQUIREMENT IS EXTENDED C SO THAT N - 2/F MUST BE GREATER THAN 1. C REFERENCES--GRANGER AND HATANAKA, PAGES 170 TO 189, C ESPECIALLY PAGES 173, 177, AND 182. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--NOVEMBER 1972. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y1(5000),Y2(5000),Z(5000) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y1(1),WS(1)),(Y2(1),WS(5001)),(Z(1),WS(10001)) DATA PI/3.141592653/ C IPR=6 ILOWER=3 IUPPER=5000 AN=N FMIN=2.0/(AN-2.0) C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.ILOWER.OR.N.GT.IUPPER)GOTO50 IF(F.LE.FMIN.OR.F.GE.0.5)GOTO60 HOLD=X(1) DO65I=2,N IF(X(I).NE.HOLD)GOTO90 65 CONTINUE WRITE(IPR, 9)HOLD RETURN 50 WRITE(IPR,17)ILOWER,IUPPER WRITE(IPR,47)N RETURN 60 WRITE(IPR,27)FMIN WRITE(IPR,46)F WRITE(IPR,28)FMIN,N RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE DEMOD SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 96H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 DEMOD SUBROUTINE IS OUTSIDE THE ALLOWABLE (,I6,1H,,I6,16H) INTER 1VAL *****) 27 FORMAT(1H , 96H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 DEMOD SUBROUTINE IS OUTSIDE THE ALLOWABLE (,F10.8,6H,0.5) , 1 14HINTERVAL *****) 28 FORMAT(1H ,42H THE ABOVE LOWER LIMIT (,F10.8, 1 46H) = 2/(N-2) WHERE N = THE INPUT SAMPLE SIZE = ,I8) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C C FORM THE COSINE AND SINE SERIES C DO100I=1,N AI=I Y1(I)=X(I)*COS(6.2831853*F*AI) Y2(I)=X(I)*SIN(6.2831853*F*AI) 100 CONTINUE C C DEFINE THE LENGTH OF THE 2 MOVING AVERAGES C LENMA1=1.0/F LENMA2=1.0/F ALEN1=LENMA1 ALEN2=LENMA2 IMAX1=N-LENMA1 IMAX2=IMAX1-LENMA2 C C FORM THE FIRST MOVING AVERAGE FOR THE COSINE SERIES C DO200I=1,IMAX1 ISTART=I+1 IEND=I+LENMA1-1 IENDP1=I+LENMA1 SUM=0.0 DO300J=ISTART,IEND SUM=SUM+Y1(J) 300 CONTINUE SUM=SUM+Y1(I)/2.0+Y1(IENDP1)/2.0 Z(I)=SUM/ALEN1 200 CONTINUE C C FORM THE SECOND MOVING AVERAGE FOR THE COSINE SERIES C DO400I=1,IMAX2 ISTART=I+1 IEND=I+LENMA2-1 IENDP1=I+LENMA2 SUM=0.0 DO500J=ISTART,IEND SUM=SUM+Z(J) 500 CONTINUE SUM=SUM+Z(I)/2.0+Z(IENDP1)/2.0 Y1(I)=SUM/ALEN2 400 CONTINUE C C FORM THE FIRST MOVING AVERAGE FOR THE SINE SERIES C DO800I=1,IMAX1 ISTART=I+1 IEND=I+LENMA1-1 IENDP1=I+LENMA1 SUM=0.0 DO900J=ISTART,IEND SUM=SUM+Y2(J) 900 CONTINUE SUM=SUM+Y2(I)/2.0+Y2(IENDP1)/2.0 Z(I)=SUM/ALEN1 800 CONTINUE C C FORM THE SECOND MOVING AVERAGE FOR THE SINE SERIES C DO1000I=1,IMAX2 ISTART=I+1 IEND=I+LENMA1-1 IENDP1=I+LENMA1 SUM=0.0 DO1100J=ISTART,IEND SUM=SUM+Z(J) 1100 CONTINUE SUM=SUM+Z(I)/2.0+Z(IENDP1)/2.0 Y2(I)=SUM/ALEN2 1000 CONTINUE C C C FORM THE AMPLITUDES AND PLOT THEM C DO1500I=1,IMAX2 Z(I)=2.0*SQRT(Y1(I)*Y1(I)+Y2(I)*Y2(I)) 1500 CONTINUE CALL PLOTX(Z,IMAX2) WRITE(IPR,2005)F C C COMPUTE THE DIFFERENCE BETWEEN THE MAX AND MIN AMPLITUDES AND WRITE IT OUT C ZMIN=Z(1) ZMAX=Z(1) DO1600I=1,IMAX2 IF(Z(I).LT.ZMIN)ZMIN=Z(I) IF(Z(I).GT.ZMAX)ZMAX=Z(I) 1600 CONTINUE RANGE=ZMAX-ZMIN WRITE(IPR,2010)ZMIN,ZMAX,RANGE C C FORM THE PHASES AND PLOT THEM C DO1700I=1,IMAX2 Z(I)=ATAN(Y1(I)/Y2(I)) 1700 CONTINUE CALL PLOTX(Z,IMAX2) WRITE(IPR,2020)F C C COMPUTE A NEW ESTIMATE FOR THE DEMODULATION FREQUENCY AND WRITE IT OUT C AIMAX2=IMAX2 IMAX2M=IMAX2-1 IFLAG=0 ZMIN=Z(1) ZMAX=Z(1) DO1800I=1,IMAX2M IP1=I+1 DEL=Z(IP1)-Z(I) IF(DEL.GT.2.5)IFLAG=IFLAG-1 IF(DEL.LT.-2.5)IFLAG=IFLAG+1 AIFLAG=IFLAG ZNEW=Z(IP1)+AIFLAG*PI IF(ZNEW.LT.ZMIN)ZMIN=ZNEW IF(ZNEW.GT.ZMAX)ZMAX=ZNEW 1800 CONTINUE RANGE=ZMAX-ZMIN SLOPER=RANGE/AIMAX2 SLOPEH=SLOPER/(2.0*PI) FEST=F+SLOPEH WRITE(IPR,2025)ZMIN,ZMAX,RANGE WRITE(IPR,2030)SLOPER,SLOPEH,FEST C 2005 FORMAT(1H ,30X, 48HAMPLITUDE PLOT FOR THE DEMODULATION FREQUENCY = 1 ,F8.6,21H CYCLES PER UNIT TIME) 2010 FORMAT(1H ,9X,20HMINIMUM AMPLITUDE = ,E15.8,5X,20HMAXIMUM AMPLITUD 1E = ,E15.8,5X,22HRANGE OF AMPLITUDES = ,E15.8) 2020 FORMAT(1H ,32X, 44HPHASE PLOT FOR THE DEMODULATION FREQUENCY = ,F8 1.6,21H CYCLES PER UNIT TIME) 2025 FORMAT(1H ,3X,16HMINIMUM PHASE = ,E15.8,11H RADIANS ,16HMAXIMUM 1PHASE = ,E15.8,11H RADIANS ,18HRANGE OF PHASES = ,E15.8,8H RADIA 1NS) 2030 FORMAT(1H ,8HSLOPE = ,E14.8,11H RADIANS = ,E14.6,52H CYCLES PER UN 1IT TIME EST. OF NEW DEMOD. FREQ. = ,E15.8,15H CYC./UNIT TIME) C RETURN END SUBROUTINE DEXCDF(X,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT DEXCDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR THE DOUBLE EXPONENTIAL C (LAPLACE) DISTRIBUTION WITH MEAN = 0 AND C STANDARD DEVIATION = SQRT(2). C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = 0.5*EXP(-ABS(X)). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF. C PRINTING--NONE. C RESTRICTIONS--NONE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--EXP. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 22-36. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS. C NO INPUT ARGUMENT ERRORS POSSIBLE C FOR THIS DISTRIBUTION. C C-----START POINT----------------------------------------------------- C IF(X.LE.0.0)CDF=0.5*EXP(X) IF(X.GT.0.0)CDF=1.0-(0.5*EXP(-X)) C RETURN END SUBROUTINE DEXPDF(X,PDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT DEXPDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY C FUNCTION VALUE FOR THE DOUBLE EXPONENTIAL C (LAPLACE) DISTRIBUTION WITH MEAN = 0 AND C STANDARD DEVIAITON = SQRT(2). C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = 0.5*EXP(-ABS(X)). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE PROBABILITY DENSITY C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--PDF = THE SINGLE PRECISION PROBABILITY C DENSITY FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY C FUNCTION VALUE PDF. C PRINTING--NONE. C RESTRICTIONS--NONE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--EXP. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 22-36. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --SEPTEMBER 1978. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS. C NO INPUT ARGUMENT ERRORS POSSIBLE C FOR THIS DISTRIBUTION. C C-----START POINT----------------------------------------------------- C ARG=X IF(X.LT.0.0)ARG=-X PDF=0.5*EXP(-ARG) C RETURN END SUBROUTINE DEXPLT(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT DEXPLT C C PURPOSE--THIS SUBROUTINE GENERATES A DOUBLE EXPONENTIAL (LAPLACE) C PROBABILITY PLOT. C THE PROTOTYPE DOUBLE EXPONENTIAL DISTRIBUTION USED HEREIN C HAS MEAN = 0 AND STANDARD DEVIATION = SQRT(2). C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = 0.5 * EXP(-ABS(X)). C AS USED HEREIN, A PROBABILITY PLOT FOR A DISTRIBUTION C IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS C THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION. C THE DOUBLE EXPONENTIAL PROBABILITY PLOT IS USEFUL IN C GRAPHICALLY TESTING THE COMPOSITE (THAT IS, C LOCATION AND SCALE PARAMETERS NEED NOT BE SPECIFIED) C HYPOTHESIS THAT THE UNDERLYING DISTRIBUTION C FROM WHICH THE DATA HAVE BEEN RANDOMLY DRAWN C IS THE DOUBLE EXPONENTIAL DISTRIBUTION. C IF THE HYPOTHESIS IS TRUE, THE PROBABILITY PLOT C SHOULD BE NEAR-LINEAR. C A MEASURE OF SUCH LINEARITY IS GIVEN BY THE C CALCULATED PROBABILITY PLOT CORRELATION COEFFICIENT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--A ONE-PAGE DOUBLE EXPONENTIAL PROBABILITY PLOT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, PLOT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, 'TECHNIQUES FOR TAIL LENGTH ANALYSIS', C PROCEEDINGS OF THE EIGHTEENTH CONFERENCE C ON THE DESIGN OF EXPERIMENTS IN ARMY RESEARCH C DEVELOPMENT AND TESTING (ABERDEEN, MARYLAND, C OCTOBER, 1972), PAGES 425-450. C --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING, C 1967, PAGES 260-308. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 22-36. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(7500),W(7500) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501)) C DATA TAU/1.76862179/ C IPR=6 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE DEXPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 DEXPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE DEXPLT SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C SORT THE DATA C CALL SORT(X,N,Y) C C GENERATE UNIFORM ORDER STATISTIC MEDIANS C CALL UNIMED(N,W) C C COMPUTE DOUBLE EXPONENTIAL ORDER STATISTIC MEDIANS C DO100I=1,N Q=W(I) IF(Q.LE.0.5)W(I)=ALOG(2.0*Q) IF(Q.GT.0.5)W(I)=-ALOG(2.0*(1.0-Q)) 100 CONTINUE C C PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS. C WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION C AND THE SAMPLE SIZE. C CALL PLOT(Y,W,N) WRITE(IPR,105)TAU,N C C COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. C COMPUTE LOCATION AND SCALE ESTIMATES C FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. C THEN WRITE THEM OUT. C SUM1=0.0 DO200I=1,N SUM1=SUM1+Y(I) 200 CONTINUE YBAR=SUM1/AN WBAR=0.0 SUM1=0.0 SUM2=0.0 SUM3=0.0 DO300I=1,N SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM2=SUM2+W(I)*Y(I) SUM3=SUM3+W(I)*W(I) 300 CONTINUE CC=SUM2/SQRT(SUM3*SUM1) YSLOPE=SUM2/SUM3 YINT=YBAR-YSLOPE*WBAR WRITE(IPR,305)CC,YINT,YSLOPE C 105 FORMAT(1H ,43HDOUBLE EXPONENTIAL PROBABILITY PLOT (TAU = ,E15.8,1H 1),44X,20HTHE SAMPLE SIZE N = ,I7) 305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X, 122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) C RETURN END SUBROUTINE DEXPPF(P,PPF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT DEXPPF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE FOR THE DOUBLE EXPONENTIAL C (LAPLACE) DISTRIBUTION WITH MEAN = 0 AND C STANDARD DEVIATION = SQRT(2). C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = 0.5*EXP(-ABS(X)). C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 AND 1.0) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT C FUNCTION VALUE PPF. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--P SHOULD BE BETWEEN 0.0 AND 1.0, EXCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGES 21-44, 229-231. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 22-36. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LE.0.0.OR.P.GE.1.0)GOTO50 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 DEXPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C IF(P.LE.0.5)PPF=ALOG(2.0*P) IF(P.GT.0.5)PPF=-ALOG(2.0*(1.0-P)) C RETURN END SUBROUTINE DEXRAN(N,ISTART,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT DEXRAN C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE DOUBLE EXPONENTIAL C (LAPLACE) DISTRIBUTION WITH MEAN = 0 AND C STANDARD DEVIATION = SQRT(2). C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = 0.5*EXP(-ABS(X)). C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C --ISTART = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL START THE C GENERATOR OVER AND HENCE C PRODUCE THE SAME RANDOM SAMPLE C OVER AND OVER AGAIN C UPON SUCCESSIVE CALLS TO C THIS SUBROUTINE WITHIN A RUN; OR C (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0, C LIKE, SAY, 1) WILL ALLOW C THE GENERATOR TO CONTINUE C FROM WHERE IT STOPPED C AND HENCE PRODUCE DIFFERENT C RANDOM SAMPLES UPON C SUCCESSIVE CALLS TO C THIS SUBROUTINE WITHIN A RUN. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE DOUBLE EXPONENTIAL C (LAPLACE) DISTRIBUTION WITH MEAN = 0 AND C STANDARD DEVIATION = SQRT(2). C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--TOCHER, THE ART OF SIMULATION, C 1963, PAGES 14-15. C --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS, C 1964, PAGE 36. C --FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGE 231. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 22-36. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 GOTO90 50 WRITE(IPR, 5) WRITE(IPR,47)N RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 DEXRAN SUBROUTINE IS NON-POSITIVE *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C C GENERATE N UNIFORM (0,1) RANDOM NUMBERS; C CALL UNIRAN(N,ISTART,X) C C GENERATE N DOUBLE EXPONENTIAL RANDOM NUMBERS C USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD. C DO100I=1,N Q=X(I) IF(Q.LE.0.5)X(I)=ALOG(2.0*Q) IF(Q.GT.0.5)X(I)=-ALOG(2.0*(1.0-Q)) 100 CONTINUE C RETURN END SUBROUTINE DEXSF(P,SF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT DEXSF C C PURPOSE--THIS SUBROUTINE COMPUTES THE SPARSITY C FUNCTION VALUE FOR THE DOUBLE EXPONENTIAL C (LAPLACE) DISTRIBUTION WITH MEAN = 0 AND C STANDARD DEVIATION = SQRT(2). C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = 0.5*EXP(-ABS(X)). C NOTE THAT THE SPARSITY FUNCTION OF A DISTRIBUTION C IS THE DERIVATIVE OF THE PERCENT POINT FUNCTION, C AND ALSO IS THE RECIPROCAL OF THE PROBABILITY C DENSITY FUNCTION (BUT IN UNITS OF P RATHER THAN X). C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 AND 1.0) C AT WHICH THE SPARSITY C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--SF = THE SINGLE PRECISION C SPARSITY FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION SPARSITY C FUNCTION VALUE SF. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--P SHOULD BE BETWEEN 0.0 AND 1.0, EXCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGES 21-44, 229-231. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 22-36. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LE.0.0.OR.P.GE.1.0)GOTO50 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 DEXSF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C IF(P.LE.0.5)SF=1.0/P IF(P.GT.0.5)SF=1.0/(1.0-P) C RETURN END SUBROUTINE DISCR2(X,N,NUMCLA,Y) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT DISCR2 C C PURPOSE--THIS SUBROUTINE 'DISCRETIZES' THE DATA C OF THE SINGLE PRECISION VECTOR X C INTO NUMCLA CLASSES. C ALL VALUES IN THE VECTOR X WITHIN A GIVEN CLASS C WILL BE MAPPED INTO THE MIDPOINT OF THAT CLASS. C THE SAMPLE MINIMUM AND SAMPLE MAXIMUM C ARE AUTOMATICALLY COMPUTED INTERNALLY C AND THE CLASS WIDTH (XDEL) IS COMPUTED AS C THE (SAMPLE MAX - SAMPLE MIN)/NUMCLA. C THE FIRST CLASS INTERVAL IS FROM C THE SAMPLE MIN TO THE SAMPLE MIN + XDEL; C THE SECOND CLASS INTERVAL IS FROM C THE SAMPLE MIN + XDEL TO C THE SAMPLE MIN + 2*XDEL; C ...; C THE LAST CLASS INTERVAL IS FROM C THE SAMPLE MAX - XDEL TO THE SAMPLE MAX. C THE USE OF THIS SUBROUTINE C (AND THE DISCRE AND DISCR3 SUBROUTINES) C GIVES THE DATA ANALYST THE CAPABILITY OF C CONSTRUCTING A DISCRETE VARIATE FROM C A CONTINUOUS ONE. C THE RESULTING DISCRETE VARIATE MIGHT THEN C (FOR EXAMPLE) BE ANALYZED IN ITSELF FOR C GROSS STRUCTURE, OR FOR ADHERENCE TO SOME C THEROETICAL DISCRETE PROBABILITY MODEL, C OR THE DISCRETE VARIATE MIGHT BE USED C AS A SUBSET DEFINITION VECTOR FOR SOME C OTHER VARIATE. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C TO BE DISCRETIZED. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --NUMLEV = THE INTEGER NUMBER OF CLASSES C DESIRED IN THE DISCRETIZATION. C OUTPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR OF C DISCRETIZED VALUES (= THE CLASS C MIDPOINTS) CORRESPONDING TO C THE CONTINUOUS VALUES IN THE VECTOR X. C THERE WILL RESULT N SUCH DISCRETIZED C VALUES. C OUTPUT--THE SINGLE PRECISION VECTOR Y C WHICH CONTAINS N DISCRETIZED VALUES C (= THE CLASS MIDPOINTS) C CORRESPONDING TO THE N C CONTINUOUS VALUES IN THE C INPUT VECTOR X. C ALSO, (NUMCLA+5) LINES OF SUMMARY INFORMATION C WILL BE GENERATED INDICATING C 1) WHAT THE SAMPLE SIZE IS (N); C 2) WHAT THE NUMBER OF CLASSES IS (NUMCLA). C 3) WHAT THE CLASS BOUNDARIES AND C THE NUMBER OF OBSERVATIONS C FALLING IN EACH CLASS ARE. C PRINTING--YES C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C --NUMCLA SHOULD BE POSITIVE AND NOT EXCEED 1000 C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--THIS SUBROUTINE DIFFERS FROM THE DISCR3 C SUBROUTINE INASMUCH AS THIS SUBROUTINE C PERFORMS ITS DISCRETIZATION BY OUTPUTING C CLASS MIDPOINTS, WHEREAS THE DISCR3 C SUBROUTINE OUTPUTS CLASS NUMBERS C (1, 2, ... , NUMCLA). C COMMENT--THE INPUT VECTOR X REMAINS UNALTERED. C COMMENT--IN THE MAIN (CALLING) ROUTINE, IT IS C PERMISSABLE (IF THE ANALYST SO DESIRES) C TO USE THE SAME VARIABLE NAME C IN THE FOURTH ARGUMENT AS USED IN THE FIRST C ARGUMENT IN THE CALLING SEQUENCE TO THIS C DISCR2 SUBROUTINE--NO CONFLICT WILL RESULT C IN THE INTERNAL OPERATION OF THE DISCR2 C SUBROUTINE. FOR EXAMPLE, IT IS PERMISSIBLE C TO HAVE CALL DISCR2(X,N,10,X) C IN WHICH THE VARIABLE NAME X IS USED C AS BOTH THE FIRST AND FOURTH ARGUMENTS. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--NOVEMBER 1974. C UPDATED --APRIL 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1),Y(1) DIMENSION ICOUNT(1000) DIMENSION CLASSM(1000) C IPR=6 IUPNCL=1000 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 IF(NUMCLA.LT.1.OR.NUMCLA.GT.IUPNCL)GOTO70 IF(NUMCLA.EQ.1)GOTO80 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD DO65I=1,N Y(I)=X(I) 65 CONTINUE RETURN 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) Y(1)=X(1) RETURN 70 WRITE(IPR,27)IUPNCL WRITE(IPR,47)NUMCLA DO71I=1,N Y(I)=0.0 71 CONTINUE RETURN 80 WRITE(IPR,28) 90 CONTINUE 9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE DISCR2 SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 DISCR2 SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE DISCR2 SUBROUTINE HAS THE VALUE 1 *****) 27 FORMAT(1H , 98H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 DISCR2 SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 28 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE THIRD INPUT ARGUME 1NT TO THE DISCR2 SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C ANUML=NUMCLA C C ZERO OUT THE COUNT VECTOR (ICOUNT) C DO100I=1,NUMCLA ICOUNT(I)=0 100 CONTINUE C C COMPUTE THE SAMPLE MINIMUM AND MAXIMUM, C THEN COMPUTE THE CLASS WIDTH. C XMIN=X(1) XMAX=X(1) DO200I=1,N IF(X(I).LT.XMIN)XMIN=X(I) IF(X(I).GT.XMAX)XMAX=X(I) 200 CONTINUE XDEL=(XMAX-XMIN)/ANUML C C COMPUTE THE CLASS MIDPOINT FOR EACH CLASS C DO300I=1,NUMCLA AI=I CLASSM(I)=XMIN+(AI-0.5)*XDEL 300 CONTINUE C C PERFORM THE DISCRETIZING TRANSFORMATION. C ALSO, KEEP A FREQUENCY COUNT FOR EACH CLASS. C DO400I=1,N P=(X(I)-XMIN)/(XMAX-XMIN) P=P*ANUML+1.0 IP=P IF(IP.LT.1)IP=1 IF(IP.GT.NUMCLA)IP=NUMCLA Y(I)=CLASSM(IP) ICOUNT(IP)=ICOUNT(IP)+1 400 CONTINUE C C COMPUTE CLASS LIMITS AND WRITE OUT SUMMARY INFORMATION. C WRITE(IPR,999) WRITE(IPR,501) WRITE(IPR,999) WRITE(IPR,502)N WRITE(IPR,508)NUMCLA WRITE(IPR,503)XMIN WRITE(IPR,504)XDEL WRITE(IPR,505)XMAX WRITE(IPR,999) WRITE(IPR,510) WRITE(IPR,997) DO500I=1,NUMCLA AI=I CMIN=XMIN+(AI-1.0)*XDEL CMAX=XMIN+AI*XDEL WRITE(IPR,520)I,CMIN,CLASSM(I),CMAX,ICOUNT(I) 500 CONTINUE C 501 FORMAT(1H ,35HOUTPUT FROM THE DISCR2 SUBROUTINE--) 502 FORMAT(1H ,7X,36HNUMBER OF OBSERVATIONS = ,I8) 503 FORMAT(1H ,7X,36HCOMPUTED LOWER BOUND OF INTERVAL = ,F15.7) 504 FORMAT(1H ,7X,36HCOMPUTED CLASS WIDTH = ,F15.7) 505 FORMAT(1H ,7X,36HCOMPUTED UPPER BOUND OF INTERVAL = ,F15.7) 508 FORMAT(1H ,7X,36HSPECIFIED NUMBER OF LEVELS = ,I8) 510 FORMAT(1H ,52H CLASS MINIMUM MIDPOINT MAXIMUM 1,11H COUNT) 520 FORMAT(1H ,4X,I6,2X,3F14.7,I8) 997 FORMAT(1H ,50H -------------------------------------------, 1 13H-------------) 999 FORMAT(1H ) C RETURN END SUBROUTINE DISCR3(X,N,NUMCLA,Y) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT DISCR3 C C PURPOSE--THIS SUBROUTINE 'DISCRETIZES' THE DATA C ON THE SINGLE PRECISION VECTOR X C INTO NUMCLA CLASSES. C ALL VALUES IN THE VECTOR X WITHIN A GIVEN CLASS C WILL BE MAPPED INTO THE CLASS NUMBER C (1, 2, ... , NUMCLA). C THUS ALL THE ELEMENTS IN THE LOWERMOST CLASS C WILL BE MAPPED INTO THE VALUE 1.0; C ALL THE ELEMENTS OF X IN THE NEXT HIGHER CLASS C WILL BE MAPPED INTO 2.0; C ETC. C THE SAMPLE MINIMUM AND SAMPLE MAXIMUM C ARE AUTOMATICALLY COMPUTED INTERNALLY C AND THE CLASS WIDTH (XDEL) IS COMPUTED AS C THE (SAMPLE MAX - SAMPLE MIN)/NUMCLA. C THE FIRST CLASS INTERVAL IS FROM C THE SAMPLE MIN TO THE SAMPLE MIN + XDEL; C THE SECOND CLASS INTERVAL IS FROM C THE SAMPLE MIN + XDEL TO C THE SAMPLE MIN + 2*XDEL; C ...; C THE LAST CLASS INTERVAL IS FROM C THE SAMPLE MAX - XDEL TO THE SAMPLE MAX. C THE USE OF THIS SUBROUTINE C (AND THE DISCRE AND DISCR2 SUBROUTINES) C GIVES THE DATA ANALYST THE CAPABILITY OF C CONSTRUCTING A DISCRETE VARIATE FROM C A CONTINUOUS ONE. C THE RESULTING DISCRETE VARIATE MIGHT THEN C (FOR EXAMPLE) BE ANALYZED IN ITSELF FOR C GROSS STRUCTURE, OR FOR ADHERENCE TO SOME C THEROETICAL DISCRETE PROBABILITY MODEL, C OR THE DISCRETE VARIATE MIGHT BE USED C AS A SUBSET DEFINITION VECTOR FOR SOME C OTHER VARIATE. C THIS DISCR3 SUBROUTINE IS PARTICULARLY C SUITED TO THIS LAST PURPOSE INASMUCH C AS IT OUTPUT'S 1'S, 2'S, ETC. C RATHER THAN MIDPOINTS. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C TO BE DISCRETIZED. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --NUMLEV = THE INTEGER NUMBER OF CLASSES C DESIRED IN THE DISCRETIZATION. C OUTPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR OF C DISCRETIZED VALUES CORRESPONDING TO C THE CONTINUOUS VALUES IN THE VECTOR X. C THERE WILL RESULT N SUCH DISCRETIZED C VALUES. C OUTPUT--THE SINGLE PRECISION VECTOR Y C WHICH CONTAINS N DISCRETIZED VALUES C CORRESPONDING TO THE N C CONTINUOUS VALUES IN THE C INPUT VECTOR X. C ALSO, (NUMCLA+5) LINES OF SUMMARY INFORMATION C WILL BE GENERATED INDICATING C 1) WHAT THE SAMPLE SIZE IS (N); C 2) WHAT THE NUMBER OF CLASSES IS (NUMCLA). C 3) WHAT THE CLASS BOUNDARIES AND C THE NUMBER OF OBSERVATIONS C FALLING IN EACH CLASS ARE. C PRINTING--YES C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C --NUMCLA SHOULD BE POSITIVE AND NOT EXCEED 1000 C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--THIS SUBROUTINE DIFFERS FROM THE DISCR2 C SUBROUTINE INASMUCH AS THIS SUBROUTINE C PERFORMS ITS DISCRETIZATION BY OUTPUTING C CLASS NUMBERS (1, 2,, ..., NUMCLA); C WHEREAS THE DISCR2 SUBROUTINE C OUTPUTS CLASS MIDPOINTS. C COMMENT--THE INPUT VECTOR X REMAINS UNALTERED. C COMMENT--IN THE MAIN (CALLING) ROUTINE, IT IS C PERMISSABLE (IF THE ANALYST SO DESIRES) C TO USE THE SAME VARIABLE NAME C IN THE FOURTH ARGUMENT AS USED IN THE FIRST C ARGUMENT IN THE CALLING SEQUENCE TO THIS C DISCR3 SUBROUTINE--NO CONFLICT WILL RESULT C IN THE INTERNAL OPERATION OF THE DISCR3 C SUBROUTINE. FOR EXAMPLE, IT IS PERMISSIBLE C TO HAVE CALL DISCR3(X,N,10,X) C IN WHICH THE VARIABLE NAME X IS USED C AS BOTH THE FIRST AND FOURTH ARGUMENTS. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--NOVEMBER 1974. C UPDATED --APRIL 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1),Y(1) DIMENSION ICOUNT(1000) C IPR=6 IUPNCL=1000 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 IF(NUMCLA.LT.1.OR.NUMCLA.GT.IUPNCL)GOTO70 IF(NUMCLA.EQ.1)GOTO80 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD DO65I=1,N Y(I)=X(I) 65 CONTINUE RETURN 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) Y(1)=X(1) RETURN 70 WRITE(IPR,27)IUPNCL WRITE(IPR,47)NUMCLA DO71I=1,N Y(I)=0.0 71 CONTINUE RETURN 80 WRITE(IPR,28) 90 CONTINUE 9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE DISCR3 SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 DISCR3 SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE DISCR3 SUBROUTINE HAS THE VALUE 1 *****) 27 FORMAT(1H , 98H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 DISCR3 SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 28 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE THIRD INPUT ARGUME 1NT TO THE DISCR3 SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C ANUML=NUMCLA C C ZERO OUT THE COUNT VECTOR (ICOUNT) C DO100I=1,NUMCLA ICOUNT(I)=0 100 CONTINUE C C COMPUTE THE SAMPLE MINIMUM AND MAXIMUM, C THEN COMPUTE THE CLASS WIDTH. C XMIN=X(1) XMAX=X(1) DO200I=1,N IF(X(I).LT.XMIN)XMIN=X(I) IF(X(I).GT.XMAX)XMAX=X(I) 200 CONTINUE XDEL=(XMAX-XMIN)/ANUML C C PERFORM THE DISCRETIZING TRANSFORMATION. C ALSO, KEEP A FREQUENCY COUNT FOR EACH CLASS. C DO400I=1,N P=(X(I)-XMIN)/(XMAX-XMIN) P=P*ANUML+1.0 IP=P IF(IP.LT.1)IP=1 IF(IP.GT.NUMCLA)IP=NUMCLA Y(I)=IP ICOUNT(IP)=ICOUNT(IP)+1 400 CONTINUE C C COMPUTE CLASS LIMITS AND WRITE OUT SUMMARY INFORMATION. C WRITE(IPR,999) WRITE(IPR,501) WRITE(IPR,999) WRITE(IPR,502)N WRITE(IPR,508)NUMCLA WRITE(IPR,503)XMIN WRITE(IPR,504)XDEL WRITE(IPR,505)XMAX WRITE(IPR,999) WRITE(IPR,510) WRITE(IPR,997) DO500I=1,NUMCLA AI=I CMIN=XMIN+(AI-1.0)*XDEL CMAX=XMIN+AI*XDEL WRITE(IPR,520)I,CMIN,CMAX,ICOUNT(I) 500 CONTINUE C 501 FORMAT(1H ,35HOUTPUT FROM THE DISCR3 SUBROUTINE--) 502 FORMAT(1H ,7X,36HNUMBER OF OBSERVATIONS = ,I8) 503 FORMAT(1H ,7X,36HCOMPUTED LOWER BOUND OF INTERVAL = ,F15.7) 504 FORMAT(1H ,7X,36HCOMPUTED CLASS WIDTH = ,F15.7) 505 FORMAT(1H ,7X,36HCOMPUTED UPPER BOUND OF INTERVAL = ,F15.7) 508 FORMAT(1H ,7X,36HSPECIFIED NUMBER OF LEVELS = ,I8) 510 FORMAT(1H ,49H LEVEL MINIMUM MAXIMUM COUNT) 520 FORMAT(1H ,4X,I6,2X,2F14.7,I8) 997 FORMAT(1H ,49H ------------------------------------------) 999 FORMAT(1H ) C RETURN END SUBROUTINE DISCRE(X,N,XMIN,XDEL,XMAX,Y) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT DISCRE C C PURPOSE--THIS SUBROUTINE 'DISCRETIZES' THE DATA C OF THE SINGLE PRECISION VECTOR X. C THE FIRST CLASS INTERVAL IS FROM C XMIN TO XMIN + XDEL; C THE SECOND CLASS INTERVAL IS FROM C XMIN+ XDEL TO XMIN + 2*XDEL; C ETC. C ALL VALUES IN THE VECTOR X WITHIN A GIVEN CLASS C WILL BE MAPPED INTO THE MIDPOINT OF THAT CLASS. C ALL VALUES IN THE VECTOR X SMALLER THAN XMIN C WILL BE MAPPED INTO XMIN - (XDEL/2.0). C ALL VALUES IN THE VECTOR X LARGER THAN XMAX C WILL BE MAPPED INTO XMAX + (XDEL/2.0). C THE USE OF THIS SUBROUTINE C (AND THE DISCR2 AND DISCR3 SUBROUTINES) C GIVES THE DATA ANALYST THE CAPABILITY OF C CONSTRUCTING A DISCRETE VARIATE FROM C A CONTINUOUS ONE. C THE RESULTING DISCRETE VARIATE MIGHT THEN C (FOR EXAMPLE) BE ANALYZED IN ITSELF FOR C GROSS STRUCTURE, OR FOR ADHERENCE TO SOME C THEROETICAL DISCRETE PROBABILITY MODEL, C OR THE DISCRETE VARIATE MIGHT BE USED C AS A SUBSET DEFINITION VECTOR FOR SOME C OTHER VARIATE. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C TO BE DISCRETIZED. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --XMIN = THE SINGLE PRECISION VALUE C WHICH DEFINES THE LOWER BOUNDARY C (INCLUSIVELY) OF THE LOWERMOST C CLASS. C --XDEL = THE SINGLE PRECISION VALUE C OF THE CLASS WIDTH. C --XMAX = THE SINGLE PRECISION VALUE C WHICH DEFINES THE UPPER BOUNDARY C (INCLUSIVELY) OF THE UPPERMOST C CLASS. C OUTPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR OF C DISCRETIZED VALUES (= CLASS C MIDPOINTS) CORRESPONDING TO C THE CONTINUOUS VALUES IN THE VECTOR X. C THERE WILL RESULT N SUCH DISCRETIZED C VALUES. C OUTPUT--THE SINGLE PRECISION VECTOR Y C WHICH CONTAINS N DISCRETIZED VALUES C (= CLASS MIDPOINTS) C CORRESPONDING TO THE N C CONTINUOUS VALUES IN THE C INPUT VECTOR X. C ALSO, A FEW LINES LINES OF SUMMARY INFORMATION C WILL BE GENERATED INDICATING C 1) WHAT THE SAMPLE SIZE IS (N); C 2) WHAT THE NUMBER OF CLASSES IS (NUMCLA). C 3) WHAT THE CLASS BOUNDARIES AND C THE NUMBER OF OBSERVATIONS C FALLING IN EACH CLASS ARE. C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C --XDEL SHOULD BE POSITIVE. C --(XMAX-XMIN)/XDEL SHOULD NOT EXCEED 999. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--IT IS SUGGESTED THAT XMIN, XDEL, C AND XMAX HAVE AT LEAST 1 MORE C DECIMAL PLACE THAN THE DATA VALUES C IN THE VECTOR X SO AS TO HELP ASSURE C A UNIQUE DISCRETIZATION MAPPING; C THAT IS, TO HELP ASSURE THAT C NO DATA VALUE WILL FALL C EXACTLY ON THE BOUNDARY POINT C BETWEEN 2 ADJACENT CLASSES. C COMMENT--IN THE MAIN (CALLING) ROUTINE, IT IS C PERMISSABLE (IF THE ANALYST SO DESIRES) C TO USE THE SAME VARIABLE NAME C IN THE SIXTH ARGUMENT AS USED IN THE FIRST C ARGUMENT IN THE CALLING SEQUENCE TO THIS C DISCRE SUBROUTINE--NO CONFLICT WILL RESULT C IN THE INTERNAL OPERATION OF THE DISCRE C SUBROUTINE. FOR EXAMPLE, IT IS PERMISSIBLE C TO HAVE CALL DISCRE(X,N,0.5,1.0,20.5,X) C IN WHICH THE VARIABLE NAME X IS USED C AS BOTH THE FIRST AND SIXTH ARGUMENTS. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--NOVEMBER 1974. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1),Y(1) DIMENSION ICOUNT(1000) DIMENSION CLASSM(1000) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 IF(XDEL.LE.0.0)GOTO70 IF(XMIN.EQ.XMAX)GOTO80 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD DO65I=1,N Y(I)=X(I) 65 CONTINUE RETURN 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) Y(1)=X(1) RETURN 70 WRITE(IPR,35) WRITE(IPR,48)XDEL DO71I=1,N Y(I)=0.0 71 CONTINUE RETURN 80 WRITE(IPR,26) WRITE(IPR,49)XMIN DO81I=1,N Y(I)=0.0 81 CONTINUE RETURN 90 CONTINUE 9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE DISCRE SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 DISCRE SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE DISCRE SUBROUTINE HAS THE VALUE 1 *****) 26 FORMAT(1H ,45H***** FATAL ERROR--THE THIRD AND FIFTH INPUT , 1 48HARGUMENTS TO THE DISCRE SUBROUTINE ARE IDENTICAL) 35 FORMAT(1H , 91H***** FATAL ERROR--THE FOURTH INPUT ARGUMENT TO THE 1 DISCRE SUBROUTINE IS NON-POSITIVE *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) 48 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.7 ,6H *** 1**) 49 FORMAT(1H , 37H***** THE VALUE OF THE ARGUMENTS ARE ,E15.7 ,6H * 1****) C C-----START POINT----------------------------------------------------- C C DETERMINE THE TRUE INTERVAL MIN AND MAX; C THEN DETERMINE THE NUMBER OF CLASSES C WITHIN THE SPECIFIED MIN AND MAX. C POINTL=XMIN POINTU=XMAX IF(XMIN.GT.XMAX)POINTL=XMAX IF(XMIN.GT.XMAX)POINTU=XMIN TOTDEL=POINTU-POINTL NUMCLA=(TOTDEL/XDEL)+0.999 C C ZERO OUT THE COUNT VECTOR (ICOUNT) C AND THE LOWER AND UPPER COUNT VARIABLES. C DO100I=1,NUMCLA ICOUNT(I)=0 100 CONTINUE ICOUNL=0 ICOUNU=0 C C COMPUTE THE CLASS MIDPOINT FOR EACH CLASS. C DO200I=1,NUMCLA AI=I CMIN=XMIN+(AI-1.0)*XDEL CMAX=XMIN+AI*XDEL CLASSM(I)=(CMIN+CMAX)/2.0 200 CONTINUE CMAX=POINTU CLASSM(NUMCLA)=(CMIN+CMAX)/2.0 C C PERFORM THE DISCRETIZING TRANSFORMATION. C DO300I=1,N IF(X(I).GE.POINTL.AND.X(I).LE.POINTU)GOTO350 IF(X(I).LT.POINTL)GOTO370 IF(X(I).GT.POINTU)GOTO390 GOTO300 350 IP=(X(I)-POINTL)/XDEL IP=IP+1 IF(IP.GT.NUMCLA)IP=NUMCLA Y(I)=CLASSM(IP) ICOUNT(IP)=ICOUNT(IP)+1 GOTO300 370 CLASML=POINTL-(XDEL/2.0) Y(I)=CLASML ICOUNL=ICOUNL+1 GOTO300 390 CLASMU=POINTU+(XDEL/2.0) Y(I)=CLASMU ICOUNU=ICOUNU+1 300 CONTINUE C C COMPUTE CLASS LIMITS AND WRITE OUT SUMMARY INFORMATION. C WRITE(IPR,999) WRITE(IPR,501) WRITE(IPR,999) WRITE(IPR,502)N WRITE(IPR,503)XMIN WRITE(IPR,504)XDEL WRITE(IPR,505)XMAX WRITE(IPR,508)NUMCLA WRITE(IPR,999) WRITE(IPR,510) WRITE(IPR,997) IF(ICOUNL.GE.1)WRITE(IPR,511)CLASML,POINTL,ICOUNL DO500I=1,NUMCLA AI=I CMIN=POINTL+(AI-1.0)*XDEL CMAX=POINTL+AI*XDEL IF(CMAX.GT.POINTU)CMAX=POINTU WRITE(IPR,520)I,CMIN,CLASSM(I),CMAX,ICOUNT(I) 500 CONTINUE IF(ICOUNU.GE.1)WRITE(IPR,512)POINTU,CLASMU,ICOUNU C 501 FORMAT(1H ,35HOUTPUT FROM THE DISCRE SUBROUTINE--) 502 FORMAT(1H ,7X,36HNUMBER OF OBSERVATIONS = ,I8) 503 FORMAT(1H ,7X,36HSPECIFIED LOWER BOUND OF INTERVAL = ,F15.7) 504 FORMAT(1H ,7X,36HSPECIFIED CLASS WIDTH = ,F15.7) 505 FORMAT(1H ,7X,36HSPECIFIED UPPER BOUND OF INTERVAL = ,F15.7) 508 FORMAT(1H ,7X,36HCOMPUTED NUMBER OF LEVELS = ,I8) 510 FORMAT(1H ,52H CLASS MINIMUM MIDPOINT MAXIMUM 1,11H COUNT) 511 FORMAT(1H ,4X,22H BELOW -INFINITY,2F14.7,I8) 512 FORMAT(1H ,4X,8H ABOVE,2F14.7,14H +INFINITY,I8) 520 FORMAT(1H ,4X,I6,2X,3F14.7,I8) 997 FORMAT(1H ,50H -------------------------------------------, 1 13H-------------) 999 FORMAT(1H ) C RETURN END SUBROUTINE DOT(A,B,IMIN,IMAX,PARPRO,DOTPRO) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT DOT C PURPOSE--TO COMPUTE THE DOT PRODUCT BETWEEN 2 VECTORS--A AND B. C ONLY ELEMENTS IMIN THROUGH IMAX OF THE 2 VECTORS ARE CONSIDERED. C THE COMPUTED DOT PRODUCT IS ADDED TO THE INPUT VALUE PARPRO C TO YIELD A FINAL ANSWER FOR DOTPRO. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DOUBLE PRECISION SUM,PROD,DPARPR DIMENSION A(1),B(1) C C-----START POINT----------------------------------------------------- C DPARPR=PARPRO SUM=0.0D0 IF(IMIN.GT.IMAX)GOTO150 DO100I=IMIN,IMAX PROD=A(I)*B(I) SUM=SUM+PROD 100 CONTINUE 150 DOTPRO=SUM+DPARPR C RETURN END SUBROUTINE EV1CDF(X,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT EV1CDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR THE EXTREME VALUE TYPE 1 C DISTRIBUTION. C THE EXTREME VALUE TYPE 1 DISTRIBUTION USED C HEREIN HAS MEAN = EULER'S NUMBER = 0.57721566 C AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983. C THIS DISTRIBUTION IS DEFINED FOR ALL X C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = (EXP(-X)) * (EXP(-(EXP(-X)))) C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE C AT WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF FOR THE EXTREME VALUE TYPE 1 C DISTRIBUTION WITH MEAN = EULER'S NUMBER = 0.57721566 C AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--NONE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--EXP. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 272-295. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS. C NO INPUT ARGUMENT ERRORS POSSIBLE C FOR THIS DISTRIBUTION. C C-----START POINT----------------------------------------------------- C CDF=1.0-EXP(-(EXP(-X))) C RETURN END SUBROUTINE EV1PLT(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT EV1PLT C C PURPOSE--THIS SUBROUTINE GENERATES AN EXTREME VALUE TYPE 1 C PROBABILITY PLOT. C THE PROTOTYPE EXTREME VALUE TYPE 1 DISTRIBUTION USED HERE C HAS MEAN = EULER'S NUMBER = 0.57721566 C AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983. C THIS DISTRIBUTION IS DEFINED FOR ALL X C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = (EXP(-X)) * (EXP(-(EXP(-X)))) C AS USED HEREIN, A PROBABILITY PLOT FOR A DISTRIBUTION C IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS C THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION. C THE EXTREME VALUE TYPE 1 PROBABILITY PLOT IS USEFUL IN C GRAPHICALLY TESTING THE COMPOSITE (THAT IS, C LOCATION AND SCALE PARAMETERS NEED NOT BE SPECIFIED) C HYPOTHESIS THAT THE UNDERLYING DISTRIBUTION C FROM WHICH THE DATA HAVE BEEN RANDOMLY DRAWN C IS THE EXTREME VALUE TYPE 1 DISTRIBUTION. C IF THE HYPOTHESIS IS TRUE, THE PROBABILITY PLOT C SHOULD BE NEAR-LINEAR. C A MEASURE OF SUCH LINEARITY IS GIVEN BY THE C CALCULATED PROBABILITY PLOT CORRELATION COEFFICIENT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--A ONE-PAGE EXTREME VALUE TYPE 1 PROBABILITY PLOT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, PLOT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, 'TECHNIQUES FOR TAIL LENGTH ANALYSIS', C PROCEEDINGS OF THE EIGHTEENTH CONFERENCE C ON THE DESIGN OF EXPERIMENTS IN ARMY RESEARCH C DEVELOPMENT AND TESTING (ABERDEEN, MARYLAND, C OCTOBER, 1972), PAGES 425-450. C --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING, C 1967, PAGES 260-308. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 272-295. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(7500),W(7500) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501)) C DATA TAU/1.56186687/ C IPR=6 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE EV1PLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 EV1PLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE EV1PLT SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C SORT THE DATA C CALL SORT(X,N,Y) C C GENERATE UNIFORM ORDER STATISTIC MEDIANS C CALL UNIMED(N,W) C C COMPUTE EXTREME VALUE TYPE 1 ORDER STATISTIC MEDIANS C DO100I=1,N W(I)=-ALOG(ALOG(1.0/W(I))) 100 CONTINUE C C PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS. C WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION C AND THE SAMPLE SIZE. C CALL PLOT(Y,W,N) WRITE(IPR,105)TAU,N C C COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. C COMPUTE LOCATION AND SCALE ESTIMATES C FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. C THEN WRITE THEM OUT. C SUM1=0.0 SUM2=0.0 DO200I=1,N SUM1=SUM1+Y(I) SUM2=SUM2+W(I) 200 CONTINUE YBAR=SUM1/AN WBAR=SUM2/AN SUM1=0.0 SUM2=0.0 SUM3=0.0 DO300I=1,N SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 300 CONTINUE CC=SUM2/SQRT(SUM3*SUM1) YSLOPE=SUM2/SUM3 YINT=YBAR-YSLOPE*WBAR WRITE(IPR,305)CC,YINT,YSLOPE C 105 FORMAT(1H ,64HEXTREME VALUE TYPE 1 (EXPONENTIAL TYPE) PROBABILITY 1PLOT (TAU = ,E15.8,1H),23X,20HTHE SAMPLE SIZE N = ,I7) 305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X, 122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) C RETURN END SUBROUTINE EV1PPF(P,PPF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT EV1PPF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE FOR THE EXTREME VALUE TYPE 1 C DISTRIBUTION. C THE EXTREME VALUE TYPE 1 DISTRIBUTION USED C HEREIN HAS MEAN = EULER'S NUMBER = 0.57721566 C AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983. C THIS DISTRIBUTION IS DEFINED FOR ALL X C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = (EXP(-X)) * (EXP(-(EXP(-X)))) C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 (EXCLUSIVELY) C AND 1.0 (EXCLUSIVELY)) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT FUNCTION . C VALUE PPF FOR THE EXTREME VALUE TYPE 1 DISTRIBUTION C WITH MEAN = EULER'S NUMBER = 0.57721566 C AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 272-295. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LE.0.0.OR.P.GE.1.0)GOTO50 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P PPF=0.0 RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 EV1PPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C PPF=-ALOG(ALOG(1.0/P)) C RETURN END SUBROUTINE EV1RAN(N,ISEED,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT EV1RAN C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE EXTREME VALUE TYPE 1 DISTRIBUTION. C THE PROTOTYPE EXTREME VALUE TYPE 1 DISTRIBUTION USED C HEREIN HAS MEAN = EULER'S NUMBER = 0.57721566 C AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983. C THIS DISTRIBUTION IS DEFINED FOR ALL X C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = (EXP(-X)) * (EXP(-(EXP(-X)))) C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE EXTREME VALUE TYPE 1 DISTRIBUTION C WITH MEAN = EULER'S NUMBER = 0.57721566 C AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--TOCHER, THE ART OF SIMULATION, C 1963, PAGES 14-15. C --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS, C 1964, PAGE 36. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 272-295. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82/7 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) C C--------------------------------------------------------------------- C CCCCC CHARACTER*4 IFEEDB CCCCC CHARACTER*4 IPRINT C CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW CCCCC COMMON /PRINT/IFEEDB,IPRINT C IPR=6 C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 GOTO90 50 WRITE(IPR, 5) WRITE(IPR,47)N RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 EV1RAN SUBROUTINE IS NON-POSITIVE *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C GENERATE N UNIFORM (0,1) RANDOM NUMBERS; C CALL UNIRAN(N,ISEED,X) C C GENERATE N EXTREME VALUE TYPE 1 RANDOM NUMBERS C USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD. C DO100I=1,N X(I)=-ALOG(ALOG(1.0/X(I))) 100 CONTINUE C RETURN END SUBROUTINE EV2CDF(X,GAMMA,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT EV2CDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR THE EXTREME VALUE TYPE 2 C DISTRIBUTION WITH SINGLE PRECISION C TAIL LENGTH PARAMETER = GAMMA. C THE EXTREME VALUE TYPE 2 DISTRIBUTION USED C HEREIN IS DEFINED FOR ALL NON-NEGATIVE X, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = GAMMA * (X**(-GAMMA-1)) * EXP(-(X**(-GAMMA))). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE C AT WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C X SHOULD BE NON-NEGATIVE. C --GAMMA = THE SINGLE PRECISION VALUE C OF THE TAIL LENGTH PARAMETER. C GAMMA SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF FOR THE EXTREME VALUE TYPE 2 C DISTRIBUTION WITH TAIL LENGTH PARAMETER VALUE = GAMMA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--GAMMA SHOULD BE POSITIVE. C --X SHOULD BE NON-NEGATIVE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--EXP. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 272-295. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(X.LT.0.0)GOTO50 IF(GAMMA.LE.0.0)GOTO55 GOTO90 50 WRITE(IPR,4) WRITE(IPR,46)X CDF=0.0 RETURN 55 WRITE(IPR,15) WRITE(IPR,46)GAMMA CDF=0.0 RETURN 90 CONTINUE 4 FORMAT(1H , 96H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE EV2CDF SUBROUTINE IS NEGATIVE *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 EV2CDF SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C CDF=0.0 IF(X.EQ.0.0)RETURN CDF=EXP(-(X**(-GAMMA))) C RETURN END SUBROUTINE EV2PLT(X,N,GAMMA) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT EV2PLT C C PURPOSE--THIS SUBROUTINE GENERATES A EXTREME VALUE TYPE 2 C PROBABILITY PLOT C (WITH TAIL LENGTH PARAMETER VALUE = GAMMA). C THE PROTOTYPE EXTREME VALUE TYPE 2 DISTRIBUTION USED N C HEREIN IS DEFINED FOR ALL NON-NEGATIVE X, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = GAMMA * (X**(-GAMMA-1)) * EXP(-(X**(-GAMMA))). C AS USED HEREIN, A PROBABILITY PLOT FOR A DISTRIBUTION C IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS C THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION. C THE EXTREME VALUE TYPE 2 PROBABILITY PLOT IS USEFUL IN C GRAPHICALLY TESTING THE COMPOSITE (THAT IS, C LOCATION AND SCALE PARAMETERS NEED NOT BE SPECIFIED) C HYPOTHESIS THAT THE UNDERLYING DISTRIBUTION C FROM WHICH THE DATA HAVE BEEN RANDOMLY DRAWN C IS THE EXTREME VALUE TYPE 2 DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = GAMMA. C IF THE HYPOTHESIS IS TRUE, THE PROBABILITY PLOT C SHOULD BE NEAR-LINEAR. C A MEASURE OF SUCH LINEARITY IS GIVEN BY THE C CALCULATED PROBABILITY PLOT CORRELATION COEFFICIENT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --GAMMA = THE SINGLE PRECISION VALUE OF THE C TAIL LENGTH PARAMETER. C GAMMA SHOULD BE POSITIVE. C OUTPUT--A ONE-PAGE EXTREME VALUE TYPE 2 PROBABILITY PLOT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C --GAMMA SHOULD BE POSITIVE. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, PLOT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, 'TECHNIQUES FOR TAIL LENGTH ANALYSIS', C PROCEEDINGS OF THE EIGHTEENTH CONFERENCE C ON THE DESIGN OF EXPERIMENTS IN ARMY RESEARCH C DEVELOPMENT AND TESTING (ABERDEEN, MARYLAND, C OCTOBER, 1972), PAGES 425-450. C --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING, C 1967, PAGES 260-308. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 272-295. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--DECEMBER 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(7500),W(7500) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501)) C IPR=6 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 IF(GAMMA.LE.0.0)GOTO60 HOLD=X(1) DO65I=2,N IF(X(I).NE.HOLD)GOTO90 65 CONTINUE WRITE(IPR, 9)HOLD RETURN 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 60 WRITE(IPR,25) WRITE(IPR,46)GAMMA RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE EV2PLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 EV2PLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE EV2PLT SUBROUTINE HAS THE VALUE 1 *****) 25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 EV2PLT SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C SORT THE DATA C CALL SORT(X,N,Y) C C GENERATE UNIFORM ORDER STATISTIC MEDIANS C CALL UNIMED(N,W) C C COMPUTE EXREME VALUE TYPE 2 DISTRIBUTION ORDER STATISTIC MEDIANS C DO100I=1,N W(I)=(-ALOG(W(I)))**(-1.0/GAMMA) 100 CONTINUE C C PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS. C COMPUTE THE TAIL LENGTH MEASURE OF THE DISTRIBUTION. C WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION C AND THE SAMPLE SIZE. C CALL PLOT(Y,W,N) Q=.9975 PP9975=(-ALOG(Q))**(-1.0/GAMMA) Q=.0025 PP0025=(-ALOG(Q))**(-1.0/GAMMA) Q=.975 PP975 =(-ALOG(Q))**(-1.0/GAMMA) Q=.025 PP025 =(-ALOG(Q))**(-1.0/GAMMA) TAU=(PP9975-PP0025)/(PP975-PP025) WRITE(IPR,105)GAMMA,TAU,N C C COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. C COMPUTE LOCATION AND SCALE ESTIMATES C FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. C THEN WRITE THEM OUT. C SUM1=0.0 SUM2=0.0 DO200I=1,N SUM1=SUM1+Y(I) SUM2=SUM2+W(I) 200 CONTINUE YBAR=SUM1/AN WBAR=SUM2/AN SUM1=0.0 SUM2=0.0 SUM3=0.0 DO300I=1,N SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 300 CONTINUE CC=SUM2/SQRT(SUM3*SUM1) YSLOPE=SUM2/SUM3 YINT=YBAR-YSLOPE*WBAR WRITE(IPR,305)CC,YINT,YSLOPE C 105 FORMAT(1H ,63HEXTREME VALUE TYPE 2 (CAUCHY TYPE) PROB. PLOT WITH E 1XP. PAR. = ,E17.10,1X,7H(TAU = ,E15.8,1H),1X,16HSAMPLE SIZE N = ,I 17) 305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X, 122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) C RETURN END SUBROUTINE EV2PPF(P,GAMMA,PPF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT EV2PPF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE FOR THE EXTREME VALUE TYPE 2 C DISTRIBUTION WITH SINGLE PRECISION C TAIL LENGTH PARAMETER = GAMMA. C THE EXTREME VALUE TYPE 2 DISTRIBUTION USED C HEREIN IS DEFINED FOR ALL NON-NEGATIVE X, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = GAMMA * (X**(-GAMMA-1)) * EXP(-(X**(-GAMMA))). C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 (EXCLUSIVELY) C AND 1.0 (EXCLUSIVELY)) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C --GAMMA = THE SINGLE PRECISION VALUE C OF THE TAIL LENGTH PARAMETER. C GAMMA SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT FUNCTION . C VALUE PPF FOR THE EXTREME VALUE TYPE 2 DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = GAMMA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--GAMMA SHOULD BE POSITIVE. C --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 272-295. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LE.0.0.OR.P.GE.1.0)GOTO50 IF(GAMMA.LE.0.0)GOTO55 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P PPF=0.0 RETURN 55 WRITE(IPR,15) WRITE(IPR,46)GAMMA PPF=0.0 RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 EV2PPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 EV2PPF SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C PPF=(-ALOG(P))**(-1.0/GAMMA) C RETURN END SUBROUTINE EV2RAN(N,GAMMA,ISEED,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT EV2RAN C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE EXTREME VALUE TYPE 2 DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = GAMMA. C THE PROTOTYPE EXTREME VALUE TYPE 2 DISTRIBUTION USED C HEREIN IS DEFINED FOR ALL NON-NEGATIVE X, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = GAMMA * (X**(-GAMMA-1)) * EXP(-(X**(-GAMMA))). C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C --GAMMA = THE SINGLE PRECISION VALUE OF THE C TAIL LENGTH PARAMETER. C GAMMA SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE EXTREME VALUE TYPE 2 DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = GAMMA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C --GAMMA SHOULD BE POSITIVE. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--TOCHER, THE ART OF SIMULATION, C 1963, PAGES 14-15. C --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS, C 1964, PAGE 36. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 272-295. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82/7 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) C C--------------------------------------------------------------------- C CCCCC CHARACTER*4 IFEEDB CCCCC CHARACTER*4 IPRINT C CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW CCCCC COMMON /PRINT/IFEEDB,IPRINT C IPR=6 C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(GAMMA.LE.0.0)GOTO60 GOTO90 50 WRITE(IPR, 5) WRITE(IPR,47)N RETURN 60 WRITE(IPR,15) WRITE(IPR,46)GAMMA RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 EV2RAN SUBROUTINE IS NON-POSITIVE *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 EV2RAN SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C GENERATE N UNIFORM (0,1) RANDOM NUMBERS; C CALL UNIRAN(N,ISEED,X) C C GENERATE N EXTREME VALUE TYPE 2 DISTRIBUTION RANDOM NUMBERS C USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD. C DO100I=1,N X(I)=(-ALOG(X(I)))**(-1.0/GAMMA) 100 CONTINUE C RETURN END SUBROUTINE EXPCDF(X,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT EXPCDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR THE EXPONENTIAL DISTRIBUTION C WITH MEAN = 1 AND STANDARD DEVIATION = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = EXP(-X). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--X SHOULD BE NON-NEGATIVE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--EXP. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 207-232. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(X.LT.0.0)GOTO50 GOTO90 50 WRITE(IPR,4) WRITE(IPR,46)X CDF=0.0 RETURN 90 CONTINUE 4 FORMAT(1H , 96H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE EXPCDF SUBROUTINE IS NEGATIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C CDF=1.0-EXP(-X) C RETURN END SUBROUTINE EXPPDF(X,PDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT EXPPDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY C FUNCTION VALUE FOR THE EXPONENTIAL DISTRIBUTION C WITH MEAN = 1 AND STANDARD DEVIATION = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = EXP(-X). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE PROBABILITY DENSITY C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--PDF = THE SINGLE PRECISION PROBABILITY C DENSITY FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY C FUNCTION VALUE PDF. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--X SHOULD BE NON-NEGATIVE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--EXP. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 207-232. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(X.LT.0.0)GOTO50 GOTO90 50 WRITE(IPR,4) WRITE(IPR,46)X PDF=0.0 RETURN 90 CONTINUE 4 FORMAT(1H , 96H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE EXPPDF SUBROUTINE IS NEGATIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C PDF=EXP(-X) C RETURN END SUBROUTINE EXPPLT(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT EXPPLT C C PURPOSE--THIS SUBROUTINE GENERATES AN EXPONENTIAL C PROBABILITY PLOT. C THE PROTOTYPE EXPONENTIAL DISTRIBUTION USED HEREIN C HAS MEAN = 1 AND STANDARD DEVIATION = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X)=EXP(-X). C AS USED HEREIN, A PROBABILITY PLOT FOR A DISTRIBUTION C IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS C THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION. C THE EXPONENTIAL PROBABILITY PLOT IS USEFUL IN C GRAPHICALLY TESTING THE COMPOSITE (THAT IS, C LOCATION AND SCALE PARAMETERS NEED NOT BE SPECIFIED) C HYPOTHESIS THAT THE UNDERLYING DISTRIBUTION C FROM WHICH THE DATA HAVE BEEN RANDOMLY DRAWN C IS THE EXPONENTIAL DISTRIBUTION. C IF THE HYPOTHESIS IS TRUE, THE PROBABILITY PLOT C SHOULD BE NEAR-LINEAR. C A MEASURE OF SUCH LINEARITY IS GIVEN BY THE C CALCULATED PROBABILITY PLOT CORRELATION COEFFICIENT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--A ONE-PAGE EXPONENTIAL PROBABILITY PLOT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, PLOT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, 'TECHNIQUES FOR TAIL LENGTH ANALYSIS', C PROCEEDINGS OF THE EIGHTEENTH CONFERENCE C ON THE DESIGN OF EXPERIMENTS IN ARMY RESEARCH C DEVELOPMENT AND TESTING (ABERDEEN, MARYLAND, C OCTOBER, 1972), PAGES 425-450. C --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING, C 1967, PAGES 260-308. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 207-232. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(7500),W(7500) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501)) C DATA TAU/1.63473745/ C IPR=6 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE EXPPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 EXPPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE EXPPLT SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C SORT THE DATA C CALL SORT(X,N,Y) C C GENERATE UNIFORM ORDER STATISTIC MEDIANS C CALL UNIMED(N,W) C C COMPUTE EXPONENTIAL ORDER STATISTIC MEDIANS C DO100I=1,N W(I)=-ALOG(1.0-W(I)) 100 CONTINUE C C PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS. C WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION C AND THE SAMPLE SIZE. C CALL PLOT(Y,W,N) WRITE(IPR,105)TAU,N C C COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. C COMPUTE LOCATION AND SCALE ESTIMATES C FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. C THEN WRITE THEM OUT. C SUM1=0.0 SUM2=0.0 DO200I=1,N SUM1=SUM1+Y(I) SUM2=SUM2+W(I) 200 CONTINUE YBAR=SUM1/AN WBAR=SUM2/AN SUM1=0.0 SUM2=0.0 SUM3=0.0 DO300I=1,N SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 300 CONTINUE CC=SUM2/SQRT(SUM3*SUM1) YSLOPE=SUM2/SUM3 YINT=YBAR-YSLOPE*WBAR WRITE(IPR,305)CC,YINT,YSLOPE C 105 FORMAT(1H ,36HEXPONENTIAL PROBABILITY PLOT (TAU = ,E15.8,1H),51X,2 10HTHE SAMPLE SIZE N = ,I7) 305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X, 122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) C RETURN END SUBROUTINE EXPPPF(P,PPF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT EXPPPF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE FOR THE EXPONENTIAL DISTRIBUTION C WITH MEAN = 1 AND STANDARD DEVIATION = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = EXP(-X). C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 AND 1.0) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT C FUNCTION VALUE PPF. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--P SHOULD BE BETWEEN 0.0 (INCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGES 21-44, 229-231. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 207-232. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LT.0.0.OR.P.GE.1.0)GOTO50 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 EXPPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C PPF=-ALOG(1.0-P) C RETURN END SUBROUTINE EXPRAN(N,ISEED,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT EXPRAN C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE EXPONENTIAL DISTRIBUTION C WITH MEAN = 1 AND STANDARD DEVIATION = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = EXP(-X). C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE EXPONENTIAL DISTRIBUTION C WITH MEAN = 1 AND STANDARD DEVIATION = 1. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--TOCHER, THE ART OF SIMULATION, C 1963, PAGES 14, 35-36. C --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS, C 1964, PAGE 36. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 207-232. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGE 58. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82/7 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --JULY 1976. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) C C--------------------------------------------------------------------- C CCCCC CHARACTER*4 IFEEDB CCCCC CHARACTER*4 IPRINT C CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW CCCCC COMMON /PRINT/IFEEDB,IPRINT C IPR=6 C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 GOTO90 50 WRITE(IPR, 5) WRITE(IPR,47)N RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 EXPRAN SUBROUTINE IS NON-POSITIVE *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C GENERATE N UNIFORM (0,1) RANDOM NUMBERS; C CALL UNIRAN(N,ISEED,X) C C GENERATE N EXPONENTIAL RANDOM NUMBERS C USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD. C DO100I=1,N X(I)=-ALOG(X(I)) 100 CONTINUE C RETURN END SUBROUTINE EXPSF(P,SF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT EXPSF C C PURPOSE--THIS SUBROUTINE COMPUTES THE SPARSITY C FUNCTION VALUE FOR THE EXPONENTIAL DISTRIBUTION C WITH MEAN = 1 AND STANDARD DEVIATION = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = EXP(-X). C NOTE THAT THE SPARSITY FUNCTION OF A DISTRIBUTION C IS THE DERIVATIVE OF THE PERCENT POINT FUNCTION, C AND ALSO IS THE RECIPROCAL OF THE PROBABILITY C DENSITY FUNCTION (BUT IN UNITS OF P RATHER THAN X). C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 AND 1.0) C AT WHICH THE SPARSITY C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--SF = THE SINGLE PRECISION C SPARSITY FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION SPARSITY C FUNCTION VALUE SF. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--P SHOULD BE BETWEEN 0.0 (INCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGES 21-44, 229-231. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 207-232. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LT.0.0.OR.P.GE.1.0)GOTO50 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 EXPSF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C SF=1.0/(1.0-P) C RETURN END SUBROUTINE EXTREM(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT EXTREM C C PURPOSE--THIS SUBROUTINE PERFORMS AN EXTREME VALUE ANALYSIS C ON THE DATA IN THE INPUT VECTOR X. C THIS ANALYSIS CONSISTS OF DETERMINING THAT PARTICULAR C EXTREME VALUE TYPE 1 OR EXTREME VALUE TYPE 2 DISTRIBUTION C WHICH BEST FITS THE DATA SET. C THE GOODNESS OF FIT CRITERION IS THE MAXIMUM PROBABILITY C PLOT CORRELATION COEFFICIENT CRITERION. C AFTER THE BEST-FIT DISTRIBUTION IS DETERMINED, C ESTIMATES ARE COMPUTED AND PRINTED OUT FOR THE C LOCATION AND SCALE PARAMETERS. C TWO PROBABILITY PLOTS ARE ALSO PRINTED OUT-- C THE BEST-FIT TYPE 2 PROBABILITY PLOT C (IF THE BEST FIT WAS IN FACT A TYPE 2), C AND THE TYPE 1 PROBABILITY PLOT. C PREDICTED EXTREMES FOR VARIOUS RETURN PERIODS ARE C ALSO COMPUTED AND PRINTED OUT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--6 PAGES OF AUTOMATIC PRINTOUT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, EV1PLT, C EV2PLT, PLOT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN (1972), 'TECHNIQUES FOR TAIL LENGTH C ANALYSIS', PROCEEDINGS OF THE EIGHTEENTH C CONFERENCE ON THE DESIGN OF EXPERIMENTS IN C ARMY RESEARCH AND TESTING, PAGES 425-450. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C UNPUBLISHED MANUSCRIPT. C --JOHNSON AND KOTZ (1970), CONTINUOUS UNIVARIATE C DISTRIBUTIONS-1, 1970, PAGES 272-295. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --DECEMBER 1974. C UPDATED --NOVEMBER 1975. C UPDATED --MAY 1976. C C--------------------------------------------------------------------- C CHARACTER*4 BLANK,ALPHAM,ALPHAA,ALPHAX CHARACTER*4 ALPHAI,ALPHAN,ALPHAF,ALPHAT,ALPHAY CHARACTER*4 ALPHAG,EQUAL C CHARACTER*4 IFLAG1 CHARACTER*4 IFLAG2 CHARACTER*4 IFLAG3 C DIMENSION W(3000) DIMENSION X(1) DIMENSION Y(7500),Z(7500) DIMENSION GAMTAB(50),CORR(50) DIMENSION YI(50),YS(50),T(50) DIMENSION IFLAG1(50),IFLAG2(50),IFLAG3(50) CCCCC DIMENSION C(10) DIMENSION AM(50) DIMENSION SCRAT(50) C DIMENSION AINDEX(50) CCCCC DIMENSION P0(10) DIMENSION H(60,2) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(Z(1),WS(7501)) DATA BLANK,ALPHAM,ALPHAA,ALPHAX/' ','M','A','X'/ DATA ALPHAI,ALPHAN,ALPHAF,ALPHAT,ALPHAY/'I','N','F','T','Y'/ DATA ALPHAG,EQUAL/'G','='/ DATA GAMTAB(1),GAMTAB(2),GAMTAB(3),GAMTAB(4),GAMTAB(5), 1GAMTAB(6),GAMTAB(7),GAMTAB(8),GAMTAB(9),GAMTAB(10), 1GAMTAB(11),GAMTAB(12),GAMTAB(13),GAMTAB(14),GAMTAB(15), 1GAMTAB(16),GAMTAB(17),GAMTAB(18),GAMTAB(19),GAMTAB(20), 1GAMTAB(21),GAMTAB(22),GAMTAB(23),GAMTAB(24),GAMTAB(25) 1/1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12., 113.,14.,15.,16.,17.,18.,19.,20.,21.,22.,23.,24.,25./ DATA GAMTAB(26),GAMTAB(27),GAMTAB(28),GAMTAB(29),GAMTAB(30), 1GAMTAB(31),GAMTAB(32),GAMTAB(33),GAMTAB(34),GAMTAB(35), 1GAMTAB(36),GAMTAB(37),GAMTAB(38),GAMTAB(39),GAMTAB(40), 1GAMTAB(41),GAMTAB(42) 1/30.,35.,40.,45.,50.,60.,70.,80.,90.,100.,150.,200.,250., 1350.,500.,750.,1000./ CCCCC DATA C(1),C(2),C(3),C(4),C(5),C(6),C(7),C(8),C(9),C(10) CCCCC1/60.,75.,100.,150.,250.,500.,1000.,10000.,100000.,1000000./ CCCCC DATA P0(1),P0(2),P0(3),P0(4),P0(5),P0(6),P0(7),P0(8),P0(9),P0(10) CCCCC1/.0,.5,.75,.9,.95,.975,.99,.999,.9999,.99999/ DATA T(1),T(2),T(3),T(4),T(5),T(6),T(7),T(8),T(9),T(10), 1T(11),T(12),T(13),T(14),T(15),T(16),T(17),T(18),T(19),T(20), 1T(21),T(22),T(23),T(24),T(25) 1/10.18011,3.39672,2.47043,2.14609,1.98712,1.89429,1.83394, 11.79175,1.76069,1.73691,1.71814,1.70297,1.69045,1.67996, 11.67103,1.66335,1.65667,1.65082,1.64564,1.64102,1.63689, 11.63316,1.62979,1.62672,1.62391/ DATA T(26),T(27),T(28),T(29),T(30), 1T(31),T(32),T(33),T(34),T(35),T(36),T(37),T(38),T(39),T(40), 1T(41),T(42),T(43) 1/1.61287,1.60516,1.59947,1.59510,1.59164,1.58651,1.58289, 11.58019,1.57811,1.57645,1.57152,1.56908,1.56763,1.56666, 11.56546,1.56377,1.56330,1.56187/ DATA AINDEX(1),AINDEX(2),AINDEX(3),AINDEX(4),AINDEX(5), 1AINDEX(6),AINDEX(7),AINDEX(8),AINDEX(9),AINDEX(10), 1AINDEX(11),AINDEX(12),AINDEX(13),AINDEX(14),AINDEX(15), 1AINDEX(16),AINDEX(17),AINDEX(18),AINDEX(19),AINDEX(20), 1AINDEX(21),AINDEX(22),AINDEX(23),AINDEX(24),AINDEX(25) 1/1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12., 113.,14.,15.,16.,17.,18.,19.,20.,21.,22.,23.,24.,25./ DATA AINDEX(26),AINDEX(27),AINDEX(28),AINDEX(29),AINDEX(30), 1AINDEX(31),AINDEX(32),AINDEX(33),AINDEX(34),AINDEX(35), 1AINDEX(36),AINDEX(37),AINDEX(38),AINDEX(39),AINDEX(40), 1AINDEX(41),AINDEX(42),AINDEX(43),AINDEX(44),AINDEX(45), 1AINDEX(46),AINDEX(47),AINDEX(48),AINDEX(49),AINDEX(50) 1/26.,27.,28.,29.,30.,31.,32.,33.,34.,35.,36.,37.,38., 139.,40.,41.,42.,43.,44.,45.,46.,47.,48.,49.,50./ C IPR=6 IUPPER=7500 NUMDIS=43 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD RETURN 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE EXTREM SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 EXTREM SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE EXTREM SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C COMPUTE THE SAMPLE MINIMUM AND SAMPLE MAXIMUM C XMIN=X(1) XMAX=X(1) DO140I=2,N IF(X(I).LT.XMIN)XMIN=X(I) IF(X(I).GT.XMAX)XMAX=X(I) 140 CONTINUE C C COMPUTE THE PROB PLOT CORRELATION COEFFICIENTS FOR THE VARIOUS VALUES C OF GAMMA C CALL SORT(X,N,Y) CALL UNIMED(N,Z) C DO100IDIS=1,NUMDIS IF(IDIS.EQ.NUMDIS)GOTO150 A=GAMTAB(IDIS) DO110I=1,N W(I)=(-ALOG(Z(I)))**(-1.0/A) 110 CONTINUE GOTO170 150 DO160I=1,N W(I)=-ALOG(ALOG(1.0/Z(I))) 160 CONTINUE C 170 SUM1=0.0 SUM2=0.0 DO200I=1,N SUM1=SUM1+Y(I) SUM2=SUM2+W(I) 200 CONTINUE YBAR=SUM1/AN WBAR=SUM2/AN SUM1=0.0 SUM2=0.0 SUM3=0.0 DO300I=1,N SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 300 CONTINUE SY=SQRT(SUM1/(AN-1.0)) CC=SUM2/SQRT(SUM3*SUM1) YSLOPE=SUM2/SUM3 YINT=YBAR-YSLOPE*WBAR CORR(IDIS)=CC YI(IDIS)=YINT YS(IDIS)=YSLOPE 100 CONTINUE C C DETERMINE THAT DISTRIBUTION WITH THE MAX PROB PLOT CORR COEFFICIENT C IDISMX=1 CORRMX=CORR(1) DO400IDIS=1,NUMDIS IF(CORR(IDIS).GT.CORRMX)IDISMX=IDIS IF(CORR(IDIS).GT.CORRMX)CORRMX=CORR(IDIS) 400 CONTINUE DO500IDIS=1,NUMDIS IFLAG1(IDIS)=BLANK IFLAG2(IDIS)=BLANK IFLAG3(IDIS)=BLANK IF(IDIS.EQ.IDISMX)GOTO550 GOTO500 550 IFLAG1(IDIS)=ALPHAM IFLAG2(IDIS)=ALPHAA IFLAG3(IDIS)=ALPHAX 500 CONTINUE C C WRITE OUT THE TABLE OF PROB PLOT CORR COEFFICIENTS FOR VARIOUS GAMMA C WRITE(IPR,998) WRITE(IPR,305) WRITE(IPR,999) WRITE(IPR,310)N WRITE(IPR,311)YBAR WRITE(IPR,312)SY WRITE(IPR,313)XMIN WRITE(IPR,314)XMAX WRITE(IPR,999) WRITE(IPR,323) WRITE(IPR,324) WRITE(IPR,325) WRITE(IPR,999) C NUMDM1=NUMDIS-1 IF(NUMDM1.LT.1)GOTO850 DO800I=1,NUMDM1 WRITE(IPR,805)GAMTAB(I),CORR(I),IFLAG1(I),IFLAG2(I),IFLAG3(I), 1YI(I),YS(I),T(I) 800 CONTINUE 850 I=NUMDIS WRITE(IPR,806)ALPHAI,ALPHAN,ALPHAF,ALPHAI,ALPHAN,ALPHAI, 1ALPHAT,ALPHAY,CORR(I),IFLAG1(I),IFLAG2(I),IFLAG3(I), 1YI(I),YS(I),T(I) C C PLOT THE PROB PLOT CORR COEFFICIENT VERSUS GAMMA VALUE INDEX C CALL PLOT(CORR,AINDEX,NUMDIS) WRITE(IPR,810)ALPHAG,ALPHAA,ALPHAM,ALPHAM,ALPHAA,EQUAL, 1GAMTAB(1),GAMTAB(12),GAMTAB(23),GAMTAB(34), 1ALPHAI,ALPHAN,ALPHAF,ALPHAI,ALPHAN,ALPHAI,ALPHAT,ALPHAY WRITE(IPR,999) WRITE(IPR,812) WRITE(IPR,813) C C IF THE OPTIMAL GAMMA IS FINITE, PLOT OUT THE EXTREME VALUE C TYPE 2 PROBABILITY PLOT FOR THE OPTIMAL VALUE C OF GAMMA. C IF(IDISMX.LT.NUMDIS)CALL EV2PLT(X,N,GAMTAB(IDISMX)) C C PLOT OUT AN EXTREME VALUE TYPE 1 PROBABILITY PLOT C CALL EV1PLT(X,N) C C FORM THE VARIOUS RETURN PERIOD VALUES C 1650 K=0 DO2100I=1,4 DO2200J=1,9 K=K+1 AM(K)=J*(10**(I-1)) 2200 CONTINUE 2100 CONTINUE K=K+1 AM(K)=10000. K=K+1 AM(K)=50000. K=K+1 AM(K)=100000. K=K+1 AM(K)=500000. K=K+1 AM(K)=1000000. K=K+1 AM(K)=N NUMAM=K CALL SORT(AM,NUMAM,SCRAT) DO2300I=1,NUMAM AM(I)=SCRAT(I) 2300 CONTINUE C C IF THE OPTIMAL GAMMA IS FINITE, COMPUTE THE C PREDICTED EXTREME (= F(1-(1/M)) FOR VARIOUS RETURN PERIODS M C FOR THE OPTIMAL EXTREME VALUE TYPE 2 DISTRIBUTION. C IF(IDISMX.EQ.NUMDIS)GOTO2450 A=GAMTAB(IDISMX) YINT=YI(IDISMX) YSLOPE=YS(IDISMX) DO2400I=2,NUMAM R=1.0/AM(I) P=1.0-R ARG=-ALOG(P) IF(ARG.LE.0.0)GOTO2400 H(I,1)=YINT+YSLOPE*(ARG**(-1.0/A)) 2400 CONTINUE C C COMPUTE THE PREDICTED EXTREME (= F(1-(1/M)) FOR VARIOUS RETURN C PERIODS M FOR THE EXTREME VALUE TYPE 1 DISTRIBUTION. C 2450 YINT=YI(NUMDIS) YSLOPE=YS(NUMDIS) DO2500I=2,NUMAM R=1.0/AM(I) P=1.0-R ARG=-ALOG(P) IF(ARG.LE.0.0)GOTO2500 H(I,2)=YINT+YSLOPE*(-ALOG(ARG)) 2500 CONTINUE C C WRITE OUT THE PAGE WITH THE RETURN PERIODS AND THE PREDICTED EXTREMES C FOR THE 2 DISTRIBUTIONS--OPTIMAL EXTREME VALUE TYPE 2, AND EXTREME C VALUE TYPE 1. C WRITE(IPR,998) IF(IDISMX.EQ.NUMDIS)GOTO2750 WRITE(IPR,2602) WRITE(IPR,2604) WRITE(IPR,2606) WRITE(IPR,2608) WRITE(IPR,2610)GAMTAB(IDISMX) WRITE(IPR,999) DO2700I=2,NUMAM WRITE(IPR,2705)AM(I),H(I,1),H(I,2) J=I-1 JSKIP=J-5*(J/5) IF(JSKIP.EQ.0)WRITE(IPR,999) 2700 CONTINUE RETURN C 2750 WRITE(IPR,2802) WRITE(IPR,2804) WRITE(IPR,2806) WRITE(IPR,2808) WRITE(IPR,999) DO2900I=2,NUMAM WRITE(IPR,2705)AM(I),H(I,2) J=I-1 JSKIP=J-5*(J/5) IF(JSKIP.EQ.0)WRITE(IPR,999) 2900 CONTINUE C 998 FORMAT(1H1) 999 FORMAT(1H ) 305 FORMAT(1H ,40X,22HEXTREME VALUE ANALYSIS) 310 FORMAT(1H ,37X,20HTHE SAMPLE SIZE N = ,I7) 311 FORMAT(1H ,34X,18HTHE SAMPLE MEAN = ,F14.7) 312 FORMAT(1H ,28X,32HTHE SAMPLE STANDARD DEVIATION = ,F14.7) 313 FORMAT(1H ,32X,21HTHE SAMPLE MINIMUM = ,F14.7) 314 FORMAT(1H ,32X,21HTHE SAMPLE MAXIMUM = ,F14.7) 323 FORMAT(1H ,85H EXTREME VALUE PROBABILITY PLOT LOCATIO 1N SCALE TAIL LENGTH) 324 FORMAT(1H ,83H TYPE 2 TAIL LENGTH CORRELATION ESTIMAT 1E ESTIMATE MEASURE) 325 FORMAT(1H ,37H PARAMETER (GAMMA) COEFFICIENT) 805 FORMAT(1H ,3X,F10.2,13X,F8.5,1X,3A1,2X,F14.7,2X,F14.7,3X,F10.5) 806 FORMAT(1H ,5X,8A1,13X,F8.5,1X,3A1,2X,F14.7,2X,F14.7,3X,F10.5) 810 FORMAT(1H ,12X,5A1,1X,A1,F14.7,11X,F14.7,11X,F14.7,11X,F14.7, 115X,8A1) 812 FORMAT(1H ,96HTHE ABOVE IS A PLOT OF THE 46 PROBABILITY PLOT CORRE 1LATION COEFFICIENTS (FROM THE PREVIOUS PAGE)) 813 FORMAT(1H ,16X,41HVERSUS THE 46 EXTREME VALUE DISTRIBUTIONS) 2602 FORMAT(1H ,43H RETURN PERIOD PREDICTED EXTREME WIND, 1 27H PREDICTED EXTREME WIND) 2604 FORMAT(1H ,43H (IN YEARS) BASED ON OPTIMAL , 1 20H BASED ON) 2606 FORMAT(1H ,42H EXTREME VALUE TYPE 2, 1 27H EXTREME VALUE TYPE 1) 2608 FORMAT(1H ,43H DISTRIBUTION , 1 22H DISTRIBUTION) 2610 FORMAT(1H ,30H (GAMMA = ,F12.5,1H)) 2705 FORMAT(1H ,2X,F9.1,13X,F10.2,17X,F10.2) 2802 FORMAT(1H ,43H RETURN PERIOD PREDICTED EXTREME WIND) 2804 FORMAT(1H ,36H (IN YEARS) BASED ON) 2806 FORMAT(1H ,42H EXTREME VALUE TYPE 1) 2808 FORMAT(1H ,38H DISTRIBUTION) C RETURN END SUBROUTINE FCDF(X,NU1,NU2,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT FCDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR THE F DISTRIBUTION C WITH INTEGER DEGREES OF FREEDOM C PARAMETERS = NU1 AND NU2. C THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X. C THE PROBABILITY DENSITY FUNCTION IS GIVEN C IN THE REFERENCES BELOW. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C X SHOULD BE NON-NEGATIVE. C --NU1 = THE INTEGER DEGREES OF FREEDOM C FOR THE NUMERATOR OF THE F RATIO. C NU1 SHOULD BE POSITIVE. C --NU2 = THE INTEGER DEGREES OF FREEDOM C FOR THE DENOMINATOR OF THE F RATIO. C NU2 SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF FOR THE F DISTRIBUTION C WITH DEGREES OF FREEDOM C PARAMETERS = NU1 AND NU2. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--X SHOULD BE NON-NEGATIVE. C --NU1 SHOULD BE A POSITIVE INTEGER VARIABLE. C --NU2 SHOULD BE A POSITIVE INTEGER VARIABLE. C OTHER DATAPAC SUBROUTINES NEEDED--NORCDF,CHSCDF. C FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DATAN. C MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGES 946-947, C FORMULAE 26.6.4, 26.6.5, 26.6.8, AND 26.6.15. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGE 83, FORMULA 20, C AND PAGE 84, THIRD FORMULA. C --PAULSON, AN APPROXIMATE NORMAILIZATION C OF THE ANALYSIS OF VARIANCE DISTRIBUTION, C ANNALS OF MATHEMATICAL STATISTICS, 1942, C NUMBER 13, PAGES 233-135. C --SCHEFFE AND TUKEY, A FORMULA FOR SAMPLE SIZES C FOR POPULATION TOLERANCE LIMITS, 1944, C NUMBER 15, PAGE 217. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--AUGUST 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --OCTOBER 1976. C C--------------------------------------------------------------------- C DOUBLE PRECISION DX,PI,ANU1,ANU2,Z,SUM,TERM,AI,COEF1,COEF2,ARG DOUBLE PRECISION COEF DOUBLE PRECISION THETA,SINTH,COSTH,A,B DOUBLE PRECISION DSQRT,DATAN DOUBLE PRECISION DFACT1,DFACT2,DNUM,DDEN DOUBLE PRECISION DPOW1,DPOW2 DOUBLE PRECISION DNU1,DNU2 DOUBLE PRECISION TERM1,TERM2,TERM3 DATA PI/3.14159265358979D0/ DATA DPOW1,DPOW2/0.33333333333333D0,0.66666666666667D0/ DATA NUCUT1,NUCUT2/100,1000/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(NU1.LE.0)GOTO50 IF(NU2.LE.0)GOTO55 IF(X.LT.0.0)GOTO60 GOTO90 50 WRITE(IPR,15) WRITE(IPR,47)NU1 CDF=0.0 RETURN 55 WRITE(IPR,23) WRITE(IPR,47)NU2 CDF=0.0 RETURN 60 WRITE(IPR,4) WRITE(IPR,46)X CDF=0.0 RETURN 90 CONTINUE 4 FORMAT(1H , 96H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE FCDF SUBROUTINE IS NEGATIVE *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 FCDF SUBROUTINE IS NON-POSITIVE *****) 23 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 FCDF SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C DX=X M=NU1 N=NU2 ANU1=NU1 ANU2=NU2 DNU1=NU1 DNU2=NU2 C C IF X IS NON-POSITIVE, SET CDF = 0.0 AND RETURN. C IF NU2 IS 5 THROUGH 9 AND X IS MORE THAN 3000 C STANDARD DEVIATIONS BELOW THE MEAN, C SET CDF = 0.0 AND RETURN. C IF NU2 IS 10 OR LARGER AND X IS MORE THAN 150 C STANDARD DEVIATIONS BELOW THE MEAN, C SET CDF = 0.0 AND RETURN. C IF NU2 IS 5 THROUGH 9 AND X IS MORE THAN 3000 C STANDARD DEVIATIONS ABOVE THE MEAN, C SET CDF = 1.0 AND RETURN. C IF NU2 IS 10 OR LARGER AND X IS MORE THAN 150 C STANDARD DEVIATIONS ABOVE THE MEAN, C SET CDF = 1.0 AND RETURN. C IF(X.LE.0.0)GOTO105 IF(NU2.LE.4)GOTO109 T1=2.0/ANU1 T2=ANU2/(ANU2-2.0) T3=(ANU1+ANU2-2.0)/(ANU2-4.0) AMEAN=T2 SD=SQRT(T1*T2*T2*T3) ZRATIO=(X-AMEAN)/SD IF(NU2.LT.10.AND.ZRATIO.LT.-3000.0)GOTO105 IF(NU2.GE.10.AND.ZRATIO.LT.-150.0)GOTO105 IF(NU2.LT.10.AND.ZRATIO.GT.3000.0)GOTO107 IF(NU2.GE.10.AND.ZRATIO.GT.150.0)GOTO107 GOTO109 105 CDF=0.0 RETURN 107 CDF=1.0 RETURN 109 CONTINUE C C DISTINGUISH BETWEEN 6 SEPARATE REGIONS C OF THE (NU1,NU2) SPACE. C BRANCH TO THE PROPER COMPUTATIONAL METHOD C DEPENDING ON THE REGION. C NUCUT1 HAS THE VALUE 100. C NUCUT2 HAS THE VALUE 1000. C IF(NU1.LT.NUCUT2.AND.NU2.LT.NUCUT2)GOTO1000 IF(NU1.GE.NUCUT2.AND.NU2.GE.NUCUT2)GOTO2000 IF(NU1.LT.NUCUT1.AND.NU2.GE.NUCUT2)GOTO3000 IF(NU1.GE.NUCUT1.AND.NU2.GE.NUCUT2)GOTO2000 IF(NU1.GE.NUCUT2.AND.NU2.LT.NUCUT1)GOTO5000 IF(NU1.GE.NUCUT2.AND.NU2.GE.NUCUT1)GOTO2000 IBRAN=5 WRITE(IPR,99)IBRAN 99 FORMAT(1H ,42H*****INTERNAL ERROR IN FCDF SUBROUTINE--, 146HIMPOSSIBLE BRANCH CONDITION AT BRANCH POINT = ,I8) RETURN C C TREAT THE CASE WHEN NU1 AND NU2 C ARE BOTH SMALL OR MODERATE C (THAT IS, BOTH ARE SMALLER THAN 1000). C METHOD UTILIZED--EXACT FINITE SUM C (SEE AMS 55, PAGE 946, FORMULAE 26.6.4, 26.6.5, C AND 26.6.8). C 1000 CONTINUE Z=ANU2/(ANU2+ANU1*DX) IFLAG1=NU1-2*(NU1/2) IFLAG2=NU2-2*(NU2/2) IF(IFLAG1.EQ.0)GOTO120 IF(IFLAG2.EQ.0)GOTO150 GOTO250 C C DO THE NU1 EVEN AND NU2 EVEN OR ODD CASE C 120 SUM=0.0D0 TERM=1.0D0 IMAX=(M-2)/2 IF(IMAX.LE.0)GOTO110 DO100I=1,IMAX AI=I COEF1=2.0D0*(AI-1.0D0) COEF2=2.0D0*AI TERM=TERM*((ANU2+COEF1)/COEF2)*(1.0D0-Z) SUM=SUM+TERM 100 CONTINUE C 110 SUM=SUM+1.0D0 SUM=(Z**(ANU2/2.0D0))*SUM CDF=1.0D0-SUM RETURN C C DO THE NU1 ODD AND NU2 EVEN CASE C 150 SUM=0.0D0 TERM=1.0D0 IMAX=(N-2)/2 IF(IMAX.LE.0)GOTO210 DO200I=1,IMAX AI=I COEF1=2.0D0*(AI-1.0D0) COEF2=2.0D0*AI TERM=TERM*((ANU1+COEF1)/COEF2)*Z SUM=SUM+TERM 200 CONTINUE C 210 SUM=SUM+1.0D0 CDF=((1.0D0-Z)**(ANU1/2.0D0))*SUM RETURN C C DO THE NU1 ODD AND NU2 ODD CASE C 250 SUM=0.0D0 TERM=1.0D0 ARG=DSQRT((ANU1/ANU2)*DX) THETA=DATAN(ARG) SINTH=ARG/DSQRT(1.0D0+ARG*ARG) COSTH=1.0D0/DSQRT(1.0D0+ARG*ARG) IF(N.EQ.1)GOTO320 IF(N.EQ.3)GOTO310 IMAX=N-2 DO300I=3,IMAX,2 AI=I COEF1=AI-1.0D0 COEF2=AI TERM=TERM*(COEF1/COEF2)*(COSTH*COSTH) SUM=SUM+TERM 300 CONTINUE C 310 SUM=SUM+1.0D0 SUM=SUM*SINTH*COSTH C 320 A=(2.0D0/PI)*(THETA+SUM) 350 SUM=0.0D0 TERM=1.0D0 IF(M.EQ.1)B=0.0D0 IF(M.EQ.1)GOTO450 IF(M.EQ.3)GOTO410 IMAX=M-3 DO400I=1,IMAX,2 AI=I COEF1=AI COEF2=AI+2.0D0 TERM=TERM*((ANU2+COEF1)/COEF2)*(SINTH*SINTH) SUM=SUM+TERM 400 CONTINUE C 410 SUM=SUM+1.0D0 SUM=SUM*SINTH*(COSTH**N) COEF=1.0D0 IEVODD=N-2*(N/2) IMIN=3 IF(IEVODD.EQ.0)IMIN=2 IF(IMIN.GT.N)GOTO420 DO430I=IMIN,N,2 AI=I COEF=((AI-1.0D0)/AI)*COEF 430 CONTINUE C 420 COEF=COEF*ANU2 IF(IEVODD.EQ.0)GOTO440 COEF=COEF*(2.0D0/PI) C 440 B=COEF*SUM C 450 CDF=A-B RETURN C C TREAT THE CASE WHEN NU1 AND NU2 C ARE BOTH LARGE C (THAT IS, BOTH ARE EQUAL TO OR LARGER THAN 1000); C OR WHEN NU1 IS MODERATE AND NU2 IS LARGE C (THAT IS, WHEN NU1 IS EQUAL TO OR GREATER THAN 100 C BUT SMALLER THAN 1000, C AND NU2 IS EQUAL TO OR LARGER THAN 1000); C OR WHEN NU2 IS MODERATE AND NU1 IS LARGE C (THAT IS WHEN NU2 IS EQUAL TO OR GREATER THAN 100 C BUT SMALLER THAN 1000, C AND NU1 IS EQUAL TO OR LARGER THAN 1000). C METHOD UTILIZED--PAULSON APPROXIMATION C (SEE AMS 55, PAGE 947, FORMULA 26.6.15). C 2000 CONTINUE DFACT1=1.0D0/(4.5D0*DNU1) DFACT2=1.0D0/(4.5D0*DNU2) DNUM=((1.0D0-DFACT2)*(DX**DPOW1))-(1.0D0-DFACT1) DDEN=DSQRT((DFACT2*(DX**DPOW2))+DFACT1) U=DNUM/DDEN CALL NORCDF(U,GCDF) CDF=GCDF RETURN C C TREAT THE CASE WHEN NU1 IS SMALL C AND NU2 IS LARGE C (THAT IS, WHEN NU1 IS SMALLER THAN 100, C AND NU2 IS EQUAL TO OR LARGER THAN 1000). C METHOD UTILIZED--SHEFFE-TUKEY APPROXIMATION C (SEE JOHNSON AND KOTZ, VOLUME 2, PAGE 84, THIRD FORMULA). C 3000 CONTINUE TERM1=DNU1 TERM2=(DNU1/DNU2)*(0.5D0*DNU1-1.0D0) TERM3=-(DNU1/DNU2)*0.5D0 U=(TERM1+TERM2)/((1.0D0/DX)-TERM3) CALL CHSCDF(U,NU1,CCDF) CDF=CCDF RETURN C C TREAT THE CASE WHEN NU2 IS SMALL C AND NU1 IS LARGE C (THAT IS, WHEN NU2 IS SMALLER THAN 100, C AND NU1 IS EQUAL TO OR LARGER THAN 1000). C METHOD UTILIZED--SHEFFE-TUKEY APPROXIMATION C (SEE JOHNSON AND KOTZ, VOLUME 2, PAGE 84, THIRD FORMULA). C 5000 CONTINUE TERM1=DNU2 TERM2=(DNU2/DNU1)*(0.5D0*DNU2-1.0D0) TERM3=-(DNU2/DNU1)*0.5D0 U=(TERM1+TERM2)/(DX-TERM3) CALL CHSCDF(U,NU2,CCDF) CDF=1.0-CCDF RETURN C END SUBROUTINE FOURIE(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT FOURIE C C PURPOSE--THIS SUBROUTINE PERFORMS A FOURIER ANALYSIS C OF THE DATA IN THE INPUT VECTOR X. C THE ANALYSIS CONSISTS OF THE FOLLOWING-- C 1) COMPUTING (AND PRINTING) C (FOR EACH OF THE HARMONIC FREQUENCIES C 1/N, 2/N, 3/N, ..., 1/2) C THE CORRESPONDING FOURIER COEFICIENTS, C THE AMPLITUDE, THE PHASE, C THE CONTRIBUTION TO THE TOTAL VARIANCE, C AND THE RELATIVE CONTRIBUTION TO THE TOTAL C VARIANCE. C 2) PLOTTING OUT A FOURIER LINE SPECTRUM = C THE PERIODOGRAM = THE PLOT OF RELATIVE C CONTRIBUTION TO TOTAL VARIANCE C (AT EACH FOURIER FREQUENCY) VERSUS C THE FOURIER FREQUENCY. C C IN ORDER THAT THE RESULTS OF THE FOURIER ANALYSIS C BE VALID AND PROPERLY INTERPRETED, THE INPUT DATA C IN X SHOULD BE EQUI-SPACED IN TIME C (OR WHATEVER VARIABLE CORRESPONDS TO TIME). C C THE HORIZONTAL AXIS OF THE SPECTRA PRODUCED C BY THIS SUBROUTINE IS FREQUENCY. C THIS FREQUENCY IS MEASURED IN UNITS OF C CYCLES PER 'DATA POINT' OR, MORE PRECISELY, IN C CYCLES PER UNIT TIME WHERE C 'UNIT TIME' IS DEFINED AS THE C ELAPSED TIME BETWEEN ADJACENT OBSERVATIONS. C THE RANGE OF THE FREQUENCY AXIS IS 0.0 TO 0.5. C C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED) OBSERVATIONS. C N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--2 TO 10 PAGES (DEPENDING ON C THE INPUT SAMPLE SIZE) OF C AUTOMATIC PRINTOUT-- C 1) A LISTING OF THE AMPLITUDE, C PHASE, CONTRIBUTION TO THE C TOTAL VARIANCE, AND RELATIVE C CONTRIBUTION TO THE TOTAL C VARIANCE FOR EACH OF THE C FOURIER FREQUENCIES C (1/N, 2/N, 3/N, ..., 1/2). C THIS LISTING MAY TAKE AS LITTLE AS 1 C PAGE OR AS MANY AS N/100 PAGES C (THE EXACT NUMBER DEPENDING ON C THE INPUT SAMPLE SIZE N). C THIS LISTING IS TERMINATED C AFTER AT MOST 8 COMPUTER PAGES. C IF MORE PAGES ARE DESIRED, C CHANGE THE VALUE OF THE C VARIABLE MAXPAG C WITHIN THIS SUBROUTINE C FROM 8 TO WHATEVER DESIRED. C 2) A PLOT OF THE RELATIVE C CONTRIBUTION TO THE C TOTAL VARIANCE VERSUS FREQUENCY. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 15000. C --THE SAMPLE SIZE N MUST BE GREATER C THAN OR EQUAL TO 3. C OTHER DATAPAC SUBROUTINES NEEDED--PLOTSP AND CHSPPF. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, SIN, COS, ATAN. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--FOURIER ANALYSIS DIFFERS FROM SPECTRAL ANALYSIS C (AS, FOR EXAMPLE, PRODUCED BY THE DATAPAC C TIMESE SUBROUTINE) IN THAT A C FOURIER ANALYSIS DOES NO SMOOTHING ON C THE SPECTRAL ESTIMATES WHEREAS A SPECRRAL C ANALYSIS DOES SMOOTH THE SPECTRAL ESTIMATES. C THE NET RESULT IS THAT THE SPECTRAL C ESTIMATES OBTAINED FROM A FOURIER C ANALYSIS ARE ALMOST ALWAYS MORE C VARIABLE THAN THOSE OBTAINED IN A C SPECTRAL ANALYSIS. C THE PRACTICAL CONCLUSION IS THAT C WHEN THE DATA ANALYST HAS A CHOICE C OF WHETHER TO PERFORM A FOURIER C ANALYSIS OR A SPECTRAL ANALYSIS, C THE SPECTRAL ANALYSIS SHOULD C ALMOST ALWAYS BE PREFERRED. C --THE MAXIMUM NUMBER OF FOURIER FREQUENCIES C FOR WHICH THE FOURIER COEFFICIENTS IS C COMPUTED (AND LISTED) IS N/2 WHERE N IS C THE SAMPLE SIZE (LENGTH OF THE C DATA RECORD IN THE VECTOR X). C THIS RULE IS OVERRIDDEN C (FOR LISTING PURPOSES ONLY) C IN LARGE DATA SETS AND IS REPLACED C BY THE RULE THAT THE MAXIMUM C NUMBER OF LAGS LISTED = 800 C (WHICH CORRESPONDS TO AN C 8-PAGE LISTING OF FOURIER COEFFICIENTS. C IF MORE PAGES ARE DESIRED, C CHANGE THE VALUE OF THE C VARIABLE MAXPAG C WITHIN THIS SUBROUTINE C FROM 8 TO WHATEVER DESIRED. C --IF THE INPUT OBSERVATIONS IN X ARE CONSIDERED C TO HAVE BEEN COLLECTED 1 SECOND APART IN TIME, C THEN THE FREQUENCY AXIS OF THE RESULTING C SPECTRA WOULD BE IN UNITS OF HERTZ C (= CYCLES PER SECOND). C --THE FREQUENCY OF 0.0 CORRESPONDS TO A CYCLE C IN THE DATA OF INFINITE (= 1/(0.0)) C LENGTH OR PERIOD. C THE FREQUENCY OF 0.5 CORRESPONDS TO A CYCLE C IN THE DATA OF LENGTH = 1/(0.5) = 2 DATA POINTS. C --ANY EQUI-SPACED FOURIER ANALYSIS IS C INTRINSICALLY LIMITED TO DETECTING FREQUENCIES C NO LARGER THAN 0.5 CYCLES PER DATA POINT; C THIS CORRESPONDS TO THE FACT THAT THE C SMALLEST DETECTABLE CYCLE IN THE DATA C IS 2 DATA POINTS PER CYCLE. C REFERENCES--JENKINS AND WATTS, ESPECIALLY PAGE 290. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--NOVEMBER 1972. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C CHARACTER*4 ALPERC DIMENSION X(1) DIMENSION A(7500),B(7500) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (A(1),WS(1)),(B(1),WS(7501)) DATA PI/3.14159265358979/ DATA ALPERC/'%'/ C IPR=6 ILOWER=3 IUPPER=15000 MAXPAG=8 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.ILOWER.OR.N.GT.IUPPER)GOTO50 HOLD=X(1) DO65I=2,N IF(X(I).NE.HOLD)GOTO90 65 CONTINUE WRITE(IPR, 9)HOLD RETURN 50 WRITE(IPR,17)ILOWER,IUPPER WRITE(IPR,47)N RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE FOURIE SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 96H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 FOURIE SUBROUTINE IS OUTSIDE THE ALLOWABLE (,I6,1H,,I6,16H) INTER 1VAL *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C DETERMINE IF N IS ODD OR EVEN C IEVODD=N-2*(N/2) DEL=(AN+1.0)/2.0 IF(IEVODD.EQ.0)DEL=(AN+2.0)/2.0 C C COMPUTE THE SAMPLE MEAN C SUM=0.0 DO100I=1,N SUM=SUM+X(I) 100 CONTINUE XBAR=SUM/AN C C COMPUTE THE BIASED SAMPLE VARIANCE C SUM=0.0 DO200I=1,N SUM=SUM+(X(I)-XBAR)**2 200 CONTINUE VBIAS=SUM/AN C C COMPUTE THE FOURIER COSINE AND SINE COEFFICIENTS--THEY ARE PLACED C IN VECTORS A AND B, RESPECTIVELY. C NHALF=N/2 DO400I=1,NHALF AI=I SUMA=0.0 SUMB=0.0 DO500J=1,N T=J SUMA=SUMA+X(J)*COS(2.0*PI*(AI/AN)*(T-DEL)) SUMB=SUMB+X(J)*SIN(2.0*PI*(AI/AN)*(T-DEL)) 500 CONTINUE A(I)=SUMA/AN B(I)=SUMB/AN 400 CONTINUE C C WRITE OUT THE SAMPLE SIZE, THE SAMPLE MEAN, C AND THE (BIASED) SAMPLE VARIANCE. C WRITE(IPR,998) WRITE(IPR,801) WRITE(IPR,999) WRITE(IPR,999) WRITE(IPR,805)N WRITE(IPR,810)XBAR WRITE(IPR,815)VBIAS WRITE(IPR,999) C C COMPUTE THE HARMONIC CONTRIBUTION C AT EACH OF THE FOURIER FREQUENCIES. C THE FUNDAMENTAL FOURIER FREQUENCY C IS 1/N CYCLES PER DATA POINT C (WHERE N = THE INPUT SAMPLE SIZE). C THE OTHER FOURIER FREQUENCIES C ARE MULTIPLES OR HARMONICS C (2/N, 3/N, 4/N, ...1/2) OF THE FUNDAMENTAL. C COMPUTE AMPLITUDES, PHASES, AND C CONTRIBUTIONS TO THE VARIANCE AT EACH C OF THE FOURIER FREQUENCIES. C COMPUTE THE PERCENTAGE CONTRIBUTION C TO THE TOTAL VARIANCE AT EACH C OF THE FOURIER FREQUENCIES. C NOTE--TO SAVE STORAGE, ALSO COPY C THE PERCENTAGE CONTRIBUTIONS TO THE VARIANCE) C (WHICH WILL LATER BE PLOTTED OUT LIKE A SPECTRUM) C INTO THE VECTOR A; THIS WILL DESTROY C THE PREVIOUS CONTENTS OF THE VECTOR A. C WRITE OUT ALL OF THE ABOVE. C NNPAGE=50 I=0 DO600IPAGE=1,MAXPAG WRITE(IPR,998) WRITE(IPR,820) WRITE(IPR,821) WRITE(IPR,822) DO700J=1,NNPAGE I=I+1 AI=I FFREQ =AI/AN PERIOD=1.0/FFREQ ANGRAD =(AI/AN)*2.0*PI ANGDEG =(AI/AN)*360.0 AMP =SQRT(A(I)*A(I)+B(I)*B(I)) PHASE1 =ATAN(-B(I)/A(I)) PHASE2 =PHASE1 *360.0/(2.0*PI) CONMSQ =2.0*AMP *AMP IF(I.EQ.NHALF.AND.IEVODD.EQ.0)CONMSQ=CONMSQ/2.0 PERCON =100.0*(CONMSQ /VBIAS) WRITE(IPR,825)I,FFREQ,PERIOD,A(I),B(I),AMP,PHASE1,PHASE2, 1CONMSQ,PERCON,ALPERC A(I)=PERCON IF(I.GE.NHALF)GOTO750 ISKIP=I-10*(I/10) IF(ISKIP.EQ.0)WRITE(IPR,999) 700 CONTINUE 600 CONTINUE 750 CONTINUE C C PLOT OUT THE PERCENTAGE CONTRIBUTIONS C TO THE TOTAL VARIANCE AT C EACH OF THE FOURIER FREQUENCIES C (1/N, 2/N, 3/N, ..., 1/2). C THIS WILL CORRESPOND TO A SPECTRAL C PLOT IN SPECTRAL ANALYSIS. C CALL PLOTSP(A,NHALF,0) WRITE(IPR,855) C 801 FORMAT(1H ,44X,16HFOURIER ANALYSIS) 805 FORMAT(1H ,40X,41HTHE SAMPLE SIZE N = ,I8) 810 FORMAT(1H ,40X,41HTHE SAMPLE MEAN = ,F20.8) 815 FORMAT(1H ,40X,41HTHE SAMPLE VARIANCE (WITH DIVISOR N-1) = ,F20.8) 820 FORMAT(1H ,40H I FOURIER PERIOD FOURIER , 1 30H FOURIER AMPLITUDE , 1 46H PHASE PHASE VARIANCE , 1 10H RELATIVE) 821 FORMAT(1H ,44H FREQUENCY COEFFICIENT , 1 11HCOEFFICIENT , 1 59H RADIANS DEGREES COMPONENT, 1 12H VARIANCE) 822 FORMAT(1H ,43H (CYCLES/POINT) A(I) , 1 14H B(I) , 1 50H , 1 22H COMPONENT (%)) 825 FORMAT(1H ,I6,2X,F8.6,1X,F8.2,6(1X,E14.7),2X,F6.2,A1) 855 FORMAT(1H ,40X,56HPERIODOGRAM = FOURIER LINE SPECTRUM OF THE ORIGI 1NAL DATA) 998 FORMAT(1H1) 999 FORMAT(1H ) C RETURN END SUBROUTINE FRAN(N,NU1,NU2,ISTART,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT FRAN C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE F DISTRIBUTION C WITH INTEGER DEGREES OF FREEDOM C PARAMETERS = NU1 AND NU2. C THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X. C THE PROBABILITY DENSITY FUNCTION IS GIVEN C IN THE REFERENCES BELOW. C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C --NU1 = THE INTEGER DEGREES OF FREEDOM C FOR THE NUMERATOR OF THE F RATIO. C --NU2 = THE INTEGER DEGREES OF FREEDOM C FOR THE DENOMINATOR OF THE F RATIO. C --ISTART = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL START THE C GENERATOR OVER AND HENCE C PRODUCE THE SAME RANDOM SAMPLE C OVER AND OVER AGAIN C UPON SUCCESSIVE CALLS TO C THIS SUBROUTINE WITHIN A RUN; OR C (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0, C LIKE, SAY, 1) WILL ALLOW C THE GENERATOR TO CONTINUE C FROM WHERE IT STOPPED C AND HENCE PRODUCE DIFFERENT C RANDOM SAMPLES UPON C SUCCESSIVE CALLS TO C THIS SUBROUTINE WITHIN A RUN. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE F DISTRIBUTION C WITH DEGREES OF FREEDOM C PARAMETERS = NU1 AND NU2. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C --NU1 SHOULD BE A POSITIVE INTEGER VARIABLE. C --NU2 SHOULD BE A POSITIVE INTEGER VARIABLE. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG, SQRT, SIN, COS. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--MOOD AND GRABLE, INTRODUCTION TO THE C THEORY OF STATISTICS, 1963, PAGES 231-232. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 75-93. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGE 64. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(2),Z(2) DATA PI/3.14159265358979/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(NU1.LE.0)GOTO60 IF(NU2.LE.0)GOTO65 GOTO90 50 WRITE(IPR,5) WRITE(IPR,47)N RETURN 60 WRITE(IPR,15) WRITE(IPR,47)NU1 RETURN 65 WRITE(IPR,25) WRITE(IPR,47)NU2 RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 FRAN SUBROUTINE IS NON-POSITIVE *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 FRAN SUBROUTINE IS NON-POSITIVE *****) 25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 FRAN SUBROUTINE IS NON-POSITIVE *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C CALL UNIRAN(1,ISTART,Y) C C GENERATE N F RANDOM NUMBERS C USING THE DEFINITION THAT C A F VARIATE WITH NU1 AND NU2 DEGREES OF FREEDOM C EQUALS (CHS1/NU1)/(CHS2/NU2) C WHERE CHS1 IS A CHI-SQUARED VARIATE C WITH NU1 DEGREES OF FREEDOM, C AND CHS2 IS A CHI-SQUARED VARIATE C WITH NU2 DEGREES OF FREEDOM. C FIRST GENERATE UNIFORM (0,1) RANDOM NUMBERS, C THEN GENERATE NORMAL RANDOM NUMBERS, C THEN CHI-SQUARED RANDOM NUMBERS WITH NU1 DEGREES C OF FREEDOM, C THEN CHI-SQUARED RANDOM NUMBERS WITH NU2 DEGREES C OF FREEDOM, C AND THEN FINALLY THE F RANDOM NUMBER. C ANU1=NU1 ANU2=NU2 DO100I=1,N C SUM=0.0 DO200J=1,NU1,2 CALL UNIRAN(2,1,Y) ARG1=-2.0*ALOG(Y(1)) ARG2=2.0*PI*Y(2) Z(1)=(SQRT(ARG1))*(COS(ARG2)) Z(2)=(SQRT(ARG1))*(SIN(ARG2)) SUM=SUM+Z(1)*Z(1) IF(J.EQ.NU1)GOTO200 SUM=SUM+Z(2)*Z(2) 200 CONTINUE CHS1=SUM C SUM=0.0 DO300J=1,NU2,2 CALL UNIRAN(2,1,Y) ARG1=-2.0*ALOG(Y(1)) ARG2=2.0*PI*Y(2) Z(1)=(SQRT(ARG1))*(COS(ARG2)) Z(2)=(SQRT(ARG1))*(SIN(ARG2)) SUM=SUM+Z(1)*Z(1) IF(J.EQ.NU2)GOTO300 SUM=SUM+Z(2)*Z(2) 300 CONTINUE CHS2=SUM C X(I)=(CHS1/ANU1)/(CHS2/ANU2) C 100 CONTINUE C RETURN END SUBROUTINE FREQ(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT FREQ C C PURPOSE--THIS SUBROUTINE COMPUTES THE SAMPLE FREQUENCY C AND SAMPLE CUMULATIVE FREQUENCY C FOR THE DATA IN THE INPUT VECTOR X. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--SEVERAL (FOR LARGE DATA SETS) PAGES OF AUTOMATIC C PRINTOUT (WITH APPROXIMATELY 55 VALUES PER PAGE) C CONSISTING OF AN ORDERED LISTING OF EACH DISTINCT C VALUE IN THE DATA SET ALONG WITH C THE FREQUENCY OF OCCURANCE OF THAT VALUE C AND THE CUMULATIVE FREQUENCY. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 15000. C OTHER DATAPAC SUBROUTINES NEEDED--SORT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 1, EDITION 2, 1963, PAGE 8. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--DECEMBER 1972. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(15000) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)) C IPR=6 IUPPER=15000 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE FREQ SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 FREQ SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** FATAL ERROR-- THE SECOND INPUT ARGUME 1NT TO THE FREQ SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C COMPUTE THE SAMPLE MEAN AND SAMPLE STANDARD DEVIATION C SUM=0.0 DO100I=1,N SUM=SUM+X(I) 100 CONTINUE XBAR=SUM/AN SUM=0.0 DO200I=1,N SUM=SUM+(X(I)-XBAR)**2 200 CONTINUE S=SQRT(SUM/(AN-1.0)) C WRITE(IPR,998) WRITE(IPR,101) WRITE(IPR,999) WRITE(IPR,102)N WRITE(IPR,103)XBAR WRITE(IPR,104)S WRITE(IPR,999) WRITE(IPR,999) WRITE(IPR,105) WRITE(IPR,106) WRITE(IPR,107) WRITE(IPR,999) C CALL SORT(X,N,Y) NDV=0 ICFREQ=0 NUMSEQ=1 NM1=N-1 DO400I=1,NM1 IP1=I+1 IF(Y(I).EQ.Y(IP1))NUMSEQ=NUMSEQ+1 IF(Y(I).EQ.Y(IP1))GOTO400 NDV=NDV+1 DVALUE=Y(I) IFREQ=NUMSEQ ICFREQ=ICFREQ+IFREQ FRQ=IFREQ CFREQ=ICFREQ PFREQ=100.0*FRQ/AN PCFREQ=100.0*CFREQ/AN WRITE(IPR,110)NDV,DVALUE,IFREQ,PFREQ,ICFREQ,PCFREQ IFLAG=NDV-10*(NDV/10) IF(IFLAG.EQ.0)WRITE(IPR,999) NUMSEQ=1 400 CONTINUE NDV=NDV+1 DVALUE=Y(N) IFREQ=NUMSEQ ICFREQ=ICFREQ+IFREQ FRQ=IFREQ CFREQ=ICFREQ PFREQ=100.0*FRQ/AN PCFREQ=100.0*CFREQ/AN WRITE(IPR,110)NDV,DVALUE,IFREQ,PFREQ,ICFREQ,PCFREQ IFLAG=NDV-10*(NDV/10) IF(IFLAG.EQ.0)WRITE(IPR,999) C 101 FORMAT(1H ,18X,48HSAMPLE FREQUENCY AND SAMPLE CUMULATIVE FREQUENCY 1) 102 FORMAT(1H ,27X,20HTHE SAMPLE SIZE N = ,I8) 103 FORMAT(1H ,25X,18HTHE SAMPLE MEAN = ,E15.8) 104 FORMAT(1H ,20X,32HTHE SAMPLE STANDARD DEVIATION = ,E15.8) 105 FORMAT(1H , 88H INDEX VALUE FREQUENCY PERCE 1NTAGE CUMULATIVE PERCENTAGE) 106 FORMAT(1H , 88H FREQU 1ENCY FREQUENCY CUMULATIVE) 107 FORMAT(1H , 88H 1 FREQUENCY ) 110 FORMAT(1H ,I8,4X,E17.10,3X,I8,6X,F8.4,10X,I8,6X,F8.4) 998 FORMAT(1H1) 999 FORMAT(1H ) RETURN END SUBROUTINE GAMCDF(X,GAMMA,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT GAMCDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR THE GAMMA C DISTRIBUTION WITH SINGLE PRECISION C TAIL LENGTH PARAMETER = GAMMA. C THE GAMMA DISTRIBUTION USED C HEREIN HAS MEAN = GAMMA C AND STANDARD DEVIATION = SQRT(GAMMA). C THIS DISTRIBUTION IS DEFINED FOR ALL POSITIVE X, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = (1/CONSTANT) * (X**(GAMMA-1)) * EXP(-X) C WHERE THE CONSTANT = THE GAMMA FUNCTION EVALUATED C AT THE VALUE GAMMA. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE C AT WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C X SHOULD BE POSITIVE. C --GAMMA = THE SINGLE PRECISION VALUE C OF THE TAIL LENGTH PARAMETER. C GAMMA SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF FOR THE GAMMA DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = GAMMA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--GAMMA SHOULD BE POSITIVE. C --X SHOULD BE POSITIVE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--DEXP, DLOG. C MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN. C ACCURACY--(ON THE UNIVAC 1108, EXEC 8 SYSTEM AT NBS) C COMPARED TO THE KNOWN GAMMA = 1 (EXPONENTIAL) C RESULTS, AGREEMENT WAS HAD OUT TO 7 SIGNIFICANT C DIGITS FOR ALL TESTED X. C THE TESTED X VALUES COVERED THE ENTIRE C RANGE OF THE DISTRIBUTION--FROM THE 0.00001 C PERCENT POINT UP TO THE 99.99999 PERCENT POINT C OF THE DISTRIBUTION. C REFERENCES--WILK, GNANADESIKAN, AND HUYETT, 'PROBABILITY C PLOTS FOR THE GAMMA DISTRIBUTION', C TECHNOMETRICS, 1962, PAGES 1-15, C ESPECIALLY PAGES 3-5. C --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 257, FORMULA 6.1.41. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 166-206. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGES 68-73. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C C--------------------------------------------------------------------- C DOUBLE PRECISION DX,DGAMMA,AI,TERM,SUM,CUT1,CUT2,CUTOFF,T DOUBLE PRECISION Z,Z2,Z3,Z4,Z5,DEN,A,B,C,D,G DOUBLE PRECISION DEXP,DLOG DIMENSION D(10) DATA C/ .918938533204672741D0/ DATA D(1),D(2),D(3),D(4),D(5) 1 /+.833333333333333333D-1,-.277777777777777778D-2, 1+.793650793650793651D-3,-.595238095238095238D-3,+.8417508417508417 151D-3/ DATA D(6),D(7),D(8),D(9),D(10) 1 /-.191752691752691753D-2,+.641025641025641025D-2,-.2955065359 147712418D-1,+.179644372368830573D0,-.139243221690590111D1/ C C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(X.LE.0.0)GOTO50 IF(GAMMA.LE.0.0)GOTO55 GOTO90 50 WRITE(IPR,4) WRITE(IPR,46)X CDF=0.0 RETURN 55 WRITE(IPR,15) WRITE(IPR,46)GAMMA CDF=0.0 RETURN 90 CONTINUE 4 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE GAMCDF SUBROUTINE IS NON-POSITIVE *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 GAMCDF SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C DX=X DGAMMA=GAMMA MAXIT=10000 C C COMPUTE THE GAMMA FUNCTION USING THE ALGORITHM IN THE C NBS APPLIED MATHEMATICS SERIES REFERENCE. C Z=DGAMMA DEN=1.0D0 300 IF(Z.GE.10.0D0)GOTO400 DEN=DEN*Z Z=Z+1 GOTO300 400 Z2=Z*Z Z3=Z*Z2 Z4=Z2*Z2 Z5=Z2*Z3 A=(Z-0.5D0)*DLOG(Z)-Z+C B=D(1)/Z+D(2)/Z3+D(3)/Z5+D(4)/(Z2*Z5)+D(5)/(Z4*Z5)+ 1D(6)/(Z*Z5*Z5)+D(7)/(Z3*Z5*Z5)+D(8)/(Z5*Z5*Z5)+D(9)/(Z2*Z5*Z5*Z5) G=DEXP(A+B)/DEN C C COMPUTE T-SUB-Q AS DEFINED ON PAGE 4 OF THE WILK, GNANADESIKAN, C AND HUYETT REFERENCE C SUM=1.0D0/DGAMMA TERM=1.0D0/DGAMMA CUT1=DX-DGAMMA CUT2=DX*10000000000.0D0 DO200I=1,MAXIT AI=I TERM=DX*TERM/(DGAMMA+AI) SUM=SUM+TERM CUTOFF=CUT1+(CUT2*TERM/SUM) IF(AI.GT.CUTOFF)GOTO250 200 CONTINUE WRITE(IPR,205)MAXIT WRITE(IPR,206)X WRITE(IPR,207)GAMMA WRITE(IPR,208) CDF=1.0 RETURN C 250 T=SUM CDF=(DX**DGAMMA)*(DEXP(-DX))*T/G C 205 FORMAT(1H ,48H*****ERROR IN INTERNAL OPERATIONS IN THE GAMCDF , 1 45HSUBROUTINE--THE NUMBER OF ITERATIONS EXCEEDS ,I7) 206 FORMAT(1H ,33H THE INPUT VALUE OF X IS ,E15.8) 207 FORMAT(1H ,33H THE INPUT VALUE OF GAMMA IS ,E15.8) 208 FORMAT(1H ,48H THE OUTPUT VALUE OF CDF HAS BEEN SET TO 1.0) C RETURN END SUBROUTINE GAMPLT(X,N,GAMMA) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT GAMPLT C C PURPOSE--THIS SUBROUTINE GENERATES A GAMMA C PROBABILITY PLOT C (WITH TAIL LENGTH PARAMETER VALUE = GAMMA). C THE PROTOTYPE GAMMA DISTRIBUTION USED C HEREIN HAS MEAN = GAMMA C AND STANDARD DEVIATION = SQRT(GAMMA). C THIS DISTRIBUTION IS DEFINED FOR ALL POSITIVE X, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = (1/CONSTANT) * (X**(GAMMA-1)) * EXP(-X) C WHERE THE CONSTANT = THE GAMMA FUNCTION EVALUATED C AT THE VALUE GAMMA. C AS USED HEREIN, A PROBABILITY PLOT FOR A DISTRIBUTION C IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS C THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION. C THE GAMMA PROBABILITY PLOT IS USEFUL IN C GRAPHICALLY TESTING THE COMPOSITE (THAT IS, C LOCATION AND SCALE PARAMETERS NEED NOT BE SPECIFIED) C HYPOTHESIS THAT THE UNDERLYING DISTRIBUTION C FROM WHICH THE DATA HAVE BEEN RANDOMLY DRAWN C IS THE GAMMA DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = GAMMA. C IF THE HYPOTHESIS IS TRUE, THE PROBABILITY PLOT C SHOULD BE NEAR-LINEAR. C A MEASURE OF SUCH LINEARITY IS GIVEN BY THE C CALCULATED PROBABILITY PLOT CORRELATION COEFFICIENT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --GAMMA = THE SINGLE PRECISION VALUE OF THE C TAIL LENGTH PARAMETER. C GAMMA SHOULD BE POSITIVE. C OUTPUT--A ONE-PAGE GAMMA PROBABILITY PLOT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C --GAMMA SHOULD BE POSITIVE. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, PLOT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ABS, EXP, DEXP, DLOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION AND DOUBLE PRECISION C LANGUAGE--ANSI FORTRAN. C REFERENCES--WILK, GNANADESIKAN, AND HUYETT, 'PROBABILITY C PLOTS FOR THE GAMMA DISTRIBUTION', C TECHNOMETRICS, 1962, PAGES 1-15. C --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 257, FORMULA 6.1.41. C --FILLIBEN, 'TECHNIQUES FOR TAIL LENGTH ANALYSIS', C PROCEEDINGS OF THE EIGHTEENTH CONFERENCE C ON THE DESIGN OF EXPERIMENTS IN ARMY RESEARCH C DEVELOPMENT AND TESTING (ABERDEEN, MARYLAND, C OCTOBER, 1972), PAGES 425-450. C --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING, C 1967, PAGES 260-308. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 166-206. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1974. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DOUBLE PRECISION Z,Z2,Z3,Z4,Z5,DEN,A,B,C,D DOUBLE PRECISION DEXP,DLOG DIMENSION D(10) DIMENSION X(1) DIMENSION Y(7500),W(7500) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501)) DATA C/ .918938533204672741D0/ DATA D(1),D(2),D(3),D(4),D(5) 1 /+.833333333333333333D-1,-.277777777777777778D-2, 1+.793650793650793651D-3,-.595238095238095238D-3,+.8417508417508417 151D-3/ DATA D(6),D(7),D(8),D(9),D(10) 1 /-.191752691752691753D-2,+.641025641025641025D-2,-.2955065359 147712418D-1,+.179644372368830573D0,-.139243221690590111D1/ C IPR=6 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 IF(GAMMA.LE.0.0)GOTO60 HOLD=X(1) DO65I=2,N IF(X(I).NE.HOLD)GOTO90 65 CONTINUE WRITE(IPR, 9)HOLD RETURN 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 60 WRITE(IPR,25) WRITE(IPR,46)GAMMA RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE GAMPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 GAMPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE GAMPLT SUBROUTINE HAS THE VALUE 1 *****) 25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 GAMPLT SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N DGAMMA=GAMMA C C COMPUTE THE GAMMA FUNCTION USING THE ALGORITHM IN THE C NBS APPLIED MATHEMATICS SERIES REFERENCE. C THIS GAMMA FUNCTION NEED BE CALCULATED ONLY ONCE. C IT IS USED IN THE CALCULATION OF THE CDF BASED ON C THE TENTATIVE VALUE OF THE PPF IN THE ITERATION. C Z=DGAMMA DEN=1.0D0 150 IF(Z.GE.10.0D0)GOTO160 DEN=DEN*Z Z=Z+1.0D0 GOTO150 160 Z2=Z*Z Z3=Z*Z2 Z4=Z2*Z2 Z5=Z2*Z3 A=(Z-0.5D0)*DLOG(Z)-Z+C B=D(1)/Z+D(2)/Z3+D(3)/Z5+D(4)/(Z2*Z5)+D(5)/(Z4*Z5)+ 1D(6)/(Z*Z5*Z5)+D(7)/(Z3*Z5*Z5)+D(8)/(Z5*Z5*Z5)+D(9)/(Z2*Z5*Z5*Z5) G=DEXP(A+B)/DEN C C SORT THE DATA C CALL SORT(X,N,Y) C C GENERATE UNIFORM ORDER STATISTIC MEDIANS C CALL UNIMED(N,W) C C GENERATE GAMMA DISTRIBUTION ORDER STATISTIC MEDIANS C C DETERMINE LOWER AND UPPER BOUNDS ON THE DESIRED I-TH GAMMA C ORDER STATISTIC MEDIAN. C FOR EACH I, A LOWER BOUND IS GIVEN BY C (Y(I)*GAMMA*THE GAMMA FUNCTION OF GAMMA)**(1.0/GAMMA) C WHERE Y(I) IS THE CORRESPONDING UNIFORM (0,1) ORDER STATISIC C MEDIAN. C FOR EACH I EXCEPT I = N, AN UPPER BOUND IS GIVEN BY THE C (I+1)-ST GAMMA ORDER STATISTIC MEDIAN (ASSUMEDLY ALREADY C CALCULTATED). C FOR I = N, AN UPPER BOUND IS DETERMINED BY COMPUTING C MULTIPLES OF THE LOWER BOUND FOR I = N UNTIL A LARGER C VALUE IS OBTAINED. C DUE TO THE ABOVE CONSIDERATIONS, THE GAMMA ORDER STATISTIC C MEDIANS WILL BE CALCULATED LARGEST TO SMALLEST, THAT IS, C IN THE FOLLOWING SEQUENCE: W(N), W(N-1), ..., W(2), W(1). C NOTE ALSO THAT 1) THE CODE IS COMPLICATED SLIGHTLY BY THE C FACT THAT PERCENT POINT VALUES INVOLVED IN THE CALCULATION OF C THE TAIL LENGTH MEASURE TAU (SEE LABEL 605) ARE GOING ON C 'SIMULATNEOUSLY'. AND 2) THE VECTOR W WILL AT VARIOUS TIMES C IN THE PROGRAM HAVE UNIFORM ORDER STATISTIC MEDIANS AND C THEN LATER GRADUALLY FILL UP WITH GAMMA ORDER STATISTIC C MEDIANS. C I=N ITAIL=0 310 IF(ITAIL.EQ.0)U=W(I) DP=U XMIN0=(U*GAMMA*G)**(1.0/GAMMA) XMIN=XMIN0 IF(I.EQ.N.OR.ITAIL.GE.1)GOTO320 IP1=I+1 XMAX=W(IP1) GOTO370 320 ILOOP=1 ICOUNT=1 350 ACOUNT=ICOUNT XMAX=ACOUNT*XMIN0 DX=XMAX GOTO1000 360 IF(PCALC.GE.DP)GOTO370 XMIN=XMAX ICOUNT=ICOUNT+1 IF(ICOUNT.LE.30000)GOTO350 370 XMID=(XMIN+XMAX)/2.0 C C AT THIS STAGE WE NOW HAVE LOWER AND UPPER LIMITS ON C THE DESIRED I-TH GAMMA ORDER STATISITC MEDIAN W(I). C NOW ITERATE BY BISECTION UNTIL THE DESIRED ACCURACY IS ACHIEVED C FOR THE I-TH GAMMA ORDER STATISITIC MEDIAN. C ILOOP=2 XLOWER=XMIN XUPPER=XMAX ICOUNT=0 550 DX=XMID GOTO1000 560 IF(PCALC.EQ.DP)GOTO570 IF(PCALC.GT.DP)GOTO580 XLOWER=XMID XMID=(XMID+XUPPER)/2.0 GOTO590 580 XUPPER=XMID XMID=(XMID+XLOWER)/2.0 590 XDEL=ABS(XMID-XLOWER) ICOUNT=ICOUNT+1 IF(XDEL.LT.0.0000001.OR.ICOUNT.GT.100)GOTO570 GOTO550 570 IF(ITAIL.GE.1)GOTO605 W(I)=XMID IF(I.LE.1)GOTO595 I=I-1 GOTO310 595 CONTINUE C C AT THIS POINT, THE GAMMA ORDER STATISTIC MEDIANS ARE ALL COMPUTED. C NOW PLOT OUT THE GAMMA PROBABILITY PLOT C CALL PLOT(Y,W,N) C C COMPUTE THE TAIL LENGTH MEASURE OF THE DISTRIBUTION. C WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION C AND THE SAMPLE SIZE. C 605 IF(ITAIL.EQ.0)GOTO600 IF(ITAIL.EQ.1)GOTO610 IF(ITAIL.EQ.2)GOTO620 IF(ITAIL.EQ.3)GOTO630 GOTO640 600 U=.9975 ITAIL=1 GOTO310 610 PP9975=XMID U=.0025 ITAIL=2 GOTO310 620 PP0025=XMID U=.975 ITAIL=3 GOTO310 630 PP975=XMID U=.025 ITAIL=4 GOTO310 640 PP025=XMID TAU=(PP9975-PP0025)/(PP975-PP025) WRITE(IPR,655)GAMMA,TAU,N C C COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. C COMPUTE LOCATION AND SCALE ESTIMATES C FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. C THEN WRITE THEM OUT. C SUM1=0.0 SUM2=0.0 DO660I=1,N SUM1=SUM1+Y(I) SUM2=SUM2+W(I) 660 CONTINUE YBAR=SUM1/AN WBAR=SUM2/AN SUM1=0.0 SUM2=0.0 SUM3=0.0 DO670I=1,N SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 670 CONTINUE CC=SUM2/SQRT(SUM3*SUM1) YSLOPE=SUM2/SUM3 YINT=YBAR-YSLOPE*WBAR WRITE(IPR,675)CC,YINT,YSLOPE C 655 FORMAT(1H ,46HGAMMA PROBABILITY PLOT WITH SHAPE PARAMETER = , 1E17.10,1X,7H(TAU = ,E15.8,1H),16X,16HSAMPLE SIZE N = ,I7) 675 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X, 122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) C RETURN C C******************************************************************** C THIS SECTION BELOW IS LOGICALLY SEPARATE FROM THE ABOVE. C THIS SECTION COMPUTES A CDF VALUE FOR ANY GIVEN TENTATIVE C PERCENT POINT X VALUE AS DEFINED IN EITHER OF THE 2 C ITERATION LOOPS IN THE ABOVE CODE. C C COMPUTE T-SUB-Q AS DEFINED ON PAGE 4 OF THE WILK, GNANADESIKAN, C AND HUYETT REFERENCE C 1000 SUM=1.0/DGAMMA TERM=1.0/DGAMMA CUT1=DX-DGAMMA CUT2=DX*10000000.0 DO700J=1,1000 AJ=J TERM=DX*TERM/(DGAMMA+AJ) SUM=SUM+TERM CUTOFF=CUT1+(CUT2*TERM/SUM) IF(AJ.GT.CUTOFF)GOTO750 700 CONTINUE WRITE(IPR,705) WRITE(IPR,707)GAMMA 705 FORMAT(1H ,48H*****ERROR IN INTERNAL OPERATIONS IN THE GAMPLT , 1 53HSUBROUTINE--THE NUMBER OF CDF ITERATIONS EXCEEDS 1000) 707 FORMAT(1H ,33H THE INPUT VALUE OF GAMMA IS ,E15.8) 750 T=SUM PCALC=(DX**DGAMMA)*(EXP(-DX))*T/G IF(ILOOP.EQ.1)GOTO360 GOTO560 C END SUBROUTINE GAMPPF(P,GAMMA,PPF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT GAMPPF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE FOR THE GAMMA DISTRIBUTION C WITH SINGLE PRECISION C TAIL LENGTH PARAMETER = GAMMA. C THE GAMMA DISTRIBUTION USED C HEREIN HAS MEAN = GAMMA C AND STANDARD DEVIATION = SQRT(GAMMA). C THIS DISTRIBUTION IS DEFINED FOR ALL POSITIVE X, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = (1/CONSTANT) * (X**(GAMMA-1)) * EXP(-X) C WHERE THE CONSTANT = THE GAMMA FUNCTION EVALUATED C AT THE VALUE GAMMA. C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 (EXCLUSIVELY) C AND 1.0 (EXCLUSIVELY)) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C --GAMMA = THE SINGLE PRECISION VALUE OF THE C TAIL LENGTH PARAMETER. C GAMMA SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT FUNCTION . C VALUE PPF FOR THE GAMMA DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = GAMMA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--GAMMA SHOULD BE POSITIVE. C --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--DEXP, DLOG. C MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN. C ACCURACY--(ON THE UNIVAC 1108, EXEC 8 SYSTEM AT NBS) C COMPARED TO THE KNOWN GAMMA = 1 (EXPONENTIAL) C RESULTS, AGREEMENT WAS HAD OUT TO 6 SIGNIFICANT C DIGITS FOR ALL TESTED P IN THE RANGE P = .001 TO C P = .999. FOR P = .95 AND SMALLER, THE AGREEMENT C WAS EVEN BETTER--7 SIGNIFICANT DIGITS. C (NOTE THAT THE TABULATED VALUES GIVEN IN THE WILK, C GNANADESIKAN, AND HUYETT REFERENCE BELOW, PAGE 20, C ARE IN ERROR FOR AT LEAST THE GAMMA = 1 CASE-- C THE WORST DETECTED ERROR WAS AGREEMENT TO ONLY 3 C SIGNIFICANT DIGITS (IN THEIR 8 SIGNIFICANT DIGIT TABLE) C FOR P = .999.) C REFERENCES--WILK, GNANADESIKAN, AND HUYETT, 'PROBABILITY C PLOTS FOR THE GAMMA DISTRIBUTION', C TECHNOMETRICS, 1962, PAGES 1-15, C ESPECIALLY PAGES 3-5. C --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 257, FORMULA 6.1.41. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 166-206. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGES 68-73. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1974. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DOUBLE PRECISION DP,DGAMMA DOUBLE PRECISION Z,Z2,Z3,Z4,Z5,DEN,A,B,C,D,G DOUBLE PRECISION XMIN0,XMIN,AI,XMAX,DX,PCALC,XMID DOUBLE PRECISION XLOWER,XUPPER,XDEL DOUBLE PRECISION SUM,TERM,CUT1,CUT2,AJ,CUTOFF,T DOUBLE PRECISION DEXP,DLOG DIMENSION D(10) DATA C/ .918938533204672741D0/ DATA D(1),D(2),D(3),D(4),D(5) 1 /+.833333333333333333D-1,-.277777777777777778D-2, 1+.793650793650793651D-3,-.595238095238095238D-3,+.8417508417508417 151D-3/ DATA D(6),D(7),D(8),D(9),D(10) 1 /-.191752691752691753D-2,+.641025641025641025D-2,-.2955065359 147712418D-1,+.179644372368830573D0,-.139243221690590111D1/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LE.0.0.OR.P.GE.1.0)GOTO50 IF(GAMMA.LE.0.0)GOTO55 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P PPF=0.0 RETURN 55 WRITE(IPR,15) WRITE(IPR,46)GAMMA PPF=0.0 RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 GAMPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 GAMPPF SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C DP=P DGAMMA=GAMMA MAXIT=10000 C C COMPUTE THE GAMMA FUNCTION USING THE ALGORITHM IN THE C NBS APPLIED MATHEMATICS SERIES REFERENCE. C THIS GAMMA FUNCTION NEED BE CALCULATED ONLY ONCE. C IT IS USED IN THE CALCULATION OF THE CDF BASED ON C THE TENTATIVE VALUE OF THE PPF IN THE ITERATION. C Z=DGAMMA DEN=1.0D0 150 IF(Z.GE.10.0D0)GOTO160 DEN=DEN*Z Z=Z+1.0D0 GOTO150 160 Z2=Z*Z Z3=Z*Z2 Z4=Z2*Z2 Z5=Z2*Z3 A=(Z-0.5D0)*DLOG(Z)-Z+C B=D(1)/Z+D(2)/Z3+D(3)/Z5+D(4)/(Z2*Z5)+D(5)/(Z4*Z5)+ 1D(6)/(Z*Z5*Z5)+D(7)/(Z3*Z5*Z5)+D(8)/(Z5*Z5*Z5)+D(9)/(Z2*Z5*Z5*Z5) G=DEXP(A+B)/DEN C C DETERMINE LOWER AND UPPER LIMITS ON THE DESIRED 100P C PERCENT POINT. C ILOOP=1 XMIN0=(DP*DGAMMA*G)**(1.0D0/DGAMMA) XMIN=XMIN0 ICOUNT=1 350 AI=ICOUNT XMAX=AI*XMIN0 DX=XMAX GOTO1000 360 IF(PCALC.GE.DP)GOTO370 XMIN=XMAX ICOUNT=ICOUNT+1 IF(ICOUNT.LE.30000)GOTO350 370 XMID=(XMIN+XMAX)/2.0D0 C C NOW ITERATE BY BISECTION UNTIL THE DESIRED ACCURACY IS ACHIEVED. C ILOOP=2 XLOWER=XMIN XUPPER=XMAX ICOUNT=0 550 DX=XMID GOTO1000 560 IF(PCALC.EQ.DP)GOTO570 IF(PCALC.GT.DP)GOTO580 XLOWER=XMID XMID=(XMID+XUPPER)/2.0D0 GOTO590 580 XUPPER=XMID XMID=(XMID+XLOWER)/2.0D0 590 XDEL=XMID-XLOWER IF(XDEL.LT.0.0D0)XDEL=-XDEL ICOUNT=ICOUNT+1 IF(XDEL.LT.0.0000000001D0.OR.ICOUNT.GT.100)GOTO570 GOTO550 570 PPF=XMID RETURN C C******************************************************************** C THIS SECTION BELOW IS LOGICALLY SEPARATE FROM THE ABOVE. C THIS SECTION COMPUTES A CDF VALUE FOR ANY GIVEN TENTATIVE C PERCENT POINT X VALUE AS DEFINED IN EITHER OF THE 2 C ITERATION LOOPS IN THE ABOVE CODE. C C COMPUTE T-SUB-Q AS DEFINED ON PAGE 4 OF THE WILK, GNANADESIKAN, C AND HUYETT REFERENCE C 1000 SUM=1.0D0/DGAMMA TERM=1.0D0/DGAMMA CUT1=DX-DGAMMA CUT2=DX*10000000000.0D0 DO700J=1,MAXIT AJ=J TERM=DX*TERM/(DGAMMA+AJ) SUM=SUM+TERM CUTOFF=CUT1+(CUT2*TERM/SUM) IF(AJ.GT.CUTOFF)GOTO750 700 CONTINUE WRITE(IPR,705)MAXIT WRITE(IPR,706)P WRITE(IPR,707)GAMMA WRITE(IPR,708) PPF=0.0 RETURN C 750 T=SUM PCALC=(DX**DGAMMA)*(DEXP(-DX))*T/G IF(ILOOP.EQ.1)GOTO360 GOTO560 C 705 FORMAT(1H ,48H*****ERROR IN INTERNAL OPERATIONS IN THE GAMPPF , 1 45HSUBROUTINE--THE NUMBER OF ITERATIONS EXCEEDS ,I7) 706 FORMAT(1H ,33H THE INPUT VALUE OF P IS ,E15.8) 707 FORMAT(1H ,33H THE INPUT VALUE OF GAMMA IS ,E15.8) 708 FORMAT(1H ,48H THE OUTPUT VALUE OF PPF HAS BEEN SET TO 0.0) C END SUBROUTINE GAMRAN(N,GAMMA,ISEED,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT GAMRAN C ******STILL NEEDS ALGORITHM WORK ****** C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE GAMMA DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = GAMMA. C THE PROTOTYPE GAMMA DISTRIBUTION USED C HEREIN HAS MEAN = GAMMA C AND STANDARD DEVIATION = SQRT(GAMMA). C THIS DISTRIBUTION IS DEFINED FOR ALL POSITIVE X, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = (1/CONSTANT) * (X**(GAMMA-1)) * EXP(-X) C WHERE THE CONSTANT = THE GAMMA FUNCTION EVALUATED C AT THE VALUE GAMMA. C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C --GAMMA = THE SINGLE PRECISION VALUE OF THE C TAIL LENGTH PARAMETER. C GAMMA SHOULD BE POSITIVE. C GAMMA SHOULD BE LARGER C THAN 1/3 (ALGORITHMIC RESTRICTION). C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE GAMMA DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = GAMMA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C --GAMMA SHOULD BE POSITIVE. C --GAMMA SHOULD BE LARGER C THAN 1/3 (ALGORITHMIC RESTRICTION). C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN, NORRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, EXP. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--GREENWOOD, 'A FAST GENERATOR FOR C GAMMA-DISTRIBUTED RANDOM VARIABLES', C COMPSTAT 1974, PROCEEDINGS IN C COMPUTATIONAL STATISTICS, VIENNA, C SEPTEMBER, 1974, PAGES 19-27. C --TOCHER, THE ART OF SIMULATION, C 1963, PAGES 24-27. C --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS, C 1964, PAGES 36-37. C --WILK, GNANADESIKAN, AND HUYETT, 'PROBABILITY C PLOTS FOR THE GAMMA DISTRIBUTION', C TECHNOMETRICS, 1962, PAGES 1-15. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 166-206. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGES 68-73. C --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 952. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82/7 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C UPDATED --JUNE 1978. C UPDATED --DECEMBER 1981. C UPDATED --MARCH 1982. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) C C--------------------------------------------------------------------- C CCCCC CHARACTER*4 IFEEDB CCCCC CHARACTER*4 IPRINT C CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW CCCCC COMMON /PRINT/IFEEDB,IPRINT C C-----DATA STATEMENTS------------------------------------------------- C DATA ATHIRD/0.3333333/ DATA SQRT3 /1.73205081/ C IPR=6 C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(GAMMA.LE.0.0)GOTO60 IF(GAMMA.LE.0.33333333)GOTO65 GOTO90 50 WRITE(IPR, 5) WRITE(IPR,47)N RETURN 60 WRITE(IPR,15) WRITE(IPR,46)GAMMA RETURN 65 WRITE(IPR,16) WRITE(IPR,17) WRITE(IPR,46)GAMMA RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 GAMRAN SUBROUTINE IS NON-POSITIVE *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 GAMRAN SUBROUTINE IS NON-POSITIVE *****) 16 FORMAT(1H ,114H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 GAMRAN SUBROUTINE IS SMALLER THAN OR EQUAL TO 0.33333333 *****) 17 FORMAT(1H , 44H (ALGORITHMIC RESTIRCTION)) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C GENERATE N GAMMA DISTRIBUTION RANDOM NUMBERS C USING GREENWOOD'S REJECTION ALGORITHM-- C 1) GENERATE A NORMAL RANDOM NUMBER; C 2) TRANSFORM THE NORMAL VARIATE TO AN APPROXIMATE C GAMMA VARIATE USING THE WILSON-HILFERTY C APPROXIMATION (SEE THE JOHNSON AND KOTZ C REFERENCE, PAGE 176); C 3) FORM THE REJECTION FUNCTION VALUE, BASED C ON THE PROBABILITY DENSITY FUNCTION VALUE C OF THE ACTUAL DISTRIBUTION OF THE PSEUDO-GAMMA C VARIATE, AND THE PROBABILITY DENSITY FUNCTION VALUE C OF A TRUE GAMMA VARIATE. C 4) GENERATE A UNIFORM RANDOM NUMBER; C 5) IF THE UNIFORM RANDOM NUMBER IS LESS THAN C THE REJECTION FUNCTION VALUE, THEN ACCEPT C THE PSEUDO-RANDOM NUMBER AS A GAMMA VARIATE; C IF THE UNIFORM RANDOM NUMBER IS LARGER THAN C THE REJECTION FUNCTION VALUE, THEN REJECT C THE PSEUDO-RANDOM NUMBER AS A GAMMA VARIATE. C A1=1.0/(9.0*GAMMA) B1=SQRT(A1) XN0=-SQRT3+B1 XG0=GAMMA*(1.0-A1+B1*XN0)**3 DO100I=1,N 150 CALL NORRAN(1,ISEED,XN) XG=GAMMA*(1.0-A1+B1*XN)**3 IF(XG.LT.0.0)GOTO150 TERM=(XG/XG0)**(GAMMA-ATHIRD) ARG=0.5*XN*XN-XG-0.5*XN0*XN0+XG0 FUNCT=TERM*EXP(ARG) CALL UNIRAN(1,ISEED,U) IF(U.LE.FUNCT)GOTO170 GOTO150 170 X(I)=XG 100 CONTINUE C RETURN END SUBROUTINE GEOCDF(X,P,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT GEOCDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE AT THE SINGLE PRECISION VALUE X C FOR THE GEOMETRIC DISTRIBUTION C WITH SINGLE PRECISION C 'BERNOULLI PROBABILITY' PARAMETER = P. C THE GEOMETRIC DISTRIBUTION USED HEREIN C HEREIN HAS MEAN = (1-P)/P C AND STANDARD DEVIATION = SQRT((1-P)/(P*P))). C THIS DISTRIBUTION IS DEFINED FOR C ALL NON-NEGATIVE INTEGER X--X = 0, 1, 2, ... . C THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION C F(X) = P * (1-P)**X. C THE GEOMETRIC DISTRIBUTION IS THE C DISTRIBUTION OF THE NUMBER OF FAILURES C BEFORE OBTAINING 1 SUCCESS IN AN C INDEFINITE SEQUENCE OF BERNOULLI (0,1) C TRIALS WHERE THE PROBABILITY OF SUCCESS C IN A SINGLE TRIAL = P. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE C AT WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C X SHOULD BE NON-NEGATIVE AND C INTEGRAL-VALUED. C --P = THE SINGLE PRECISION VALUE C OF THE 'BERNOULLI PROBABILITY' C PARAMETER FOR THE GEOMETRIC C DISTRIBUTION. C P SHOULD BE BETWEEN C 0.0 (EXCLUSIVELY) AND C 1.0 (EXCLUSIVELY). C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF C FOR THE GEOMETRIC DISTRIBUTION C WITH 'BERNOULLI PROBABILITY' PARAMETER = P. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--X SHOULD BE NON-NEGATIVE AND INTEGRAL-VALUED. C --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--NOTE THAT EVEN THOUGH THE INPUT C TO THIS CUMULATIVE C DISTRIBUTION FUNCTION SUBROUTINE C FOR THIS DISCRETE DISTRIBUTION C SHOULD (UNDER NORMAL CIRCUMSTANCES) BE A C DISCRETE INTEGER VALUE, C THE INPUT VARIABLE X IS SINGLE C PRECISION IN MODE. C X HAS BEEN SPECIFIED AS SINGLE C PRECISION SO AS TO CONFORM WITH THE DATAPAC C CONVENTION THAT ALL INPUT ****DATA**** C (AS OPPOSED TO SAMPLE SIZE, FOR EXAMPLE) C VARIABLES TO ALL C DATAPAC SUBROUTINES ARE SINGLE PRECISION. C THIS CONVENTION IS BASED ON THE BELIEF THAT C 1) A MIXTURE OF MODES (FLOATING POINT C VERSUS INTEGER) IS INCONSISTENT AND C AN UNNECESSARY COMPLICATION C IN A DATA ANALYSIS; AND C 2) FLOATING POINT MACHINE ARITHMETIC C (AS OPPOSED TO INTEGER ARITHMETIC) C IS THE MORE NATURAL MODE FOR DOING C DATA ANALYSIS. C REFERENCES--FELLER, AN INTRODUCTION TO PROBABILITY C THEORY AND ITS APPLICATIONS, VOLUME 1, C EDITION 2, 1957, PAGES 155-157, 210. C --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 929. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LE.0.0.OR.P.GE.1.0)GOTO50 IF(X.LT.0.0)GOTO55 INTX=X+0.0001 FINTX=INTX DEL=X-FINTX IF(DEL.LT.0.0)DEL=-DEL IF(DEL.GT.0.001)GOTO60 GOTO90 50 WRITE(IPR,11) WRITE(IPR,46)P CDF=0.0 RETURN 55 WRITE(IPR,4) WRITE(IPR,46)X CDF=0.0 RETURN 60 WRITE(IPR,5) WRITE(IPR,46)X 90 CONTINUE 4 FORMAT(1H , 96H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE GEOCDF SUBROUTINE IS NEGATIVE *****) 5 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE GEOCDF SUBROUTINE IS NON-INTEGRAL *****) 11 FORMAT(1H ,115H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 GEOCDF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C CDF=1.0-(1.0-P)**(X+1.0) C RETURN END SUBROUTINE GEOPLT(X,N,P) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT GEOPLT C C PURPOSE--THIS SUBROUTINE GENERATES A GEOMETRIC C PROBABILITY PLOT C (WITH 'BERNOULLI PROBABILITY' PARAMETER VALUE = P). C THE GEOMETRIC DISTRIBUTION USED C HEREIN HAS MEAN = (1-P)/P C AND STANDARD DEVIATION = SQRT((1-P)/(P*P))). C THIS DISTRIBUTION IS DEFINED FOR C ALL NON-NEGATIVE INTEGER X--X = 0, 1, 2, ... . C THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION C F(X) = P * (1-P)**X. C THE GEOMETRIC DISTRIBUTION IS THE C DISTRIBUTION OF THE NUMBER OF FAILURES C BEFORE OBTAINING 1 SUCCESS IN AN C INDEFINITE SEQUENCE OF BERNOULLI (0,1) C TRIALS WHERE THE PROBABILITY OF SUCCESS C IN A SINGLE TRIAL = P. C AS USED HEREIN, A PROBABILITY PLOT FOR A DISTRIBUTION C IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS C THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION. C THE GEOMETRIC PROBABILITY PLOT IS USEFUL IN C GRAPHICALLY TESTING THE COMPOSITE (THAT IS, C LOCATION AND SCALE PARAMETERS NEED NOT BE SPECIFIED) C HYPOTHESIS THAT THE UNDERLYING DISTRIBUTION C FROM WHICH THE DATA HAVE BEEN RANDOMLY DRAWN C IS THE GEOMETRIC DISTRIBUTION C WITH PROBABILITY PARAMETER VALUE = P. C IF THE HYPOTHESIS IS TRUE, THE PROBABILITY PLOT C SHOULD BE NEAR-LINEAR. C A MEASURE OF SUCH LINEARITY IS GIVEN BY THE C CALCULATED PROBABILITY PLOT CORRELATION COEFFICIENT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --P = THE SINGLE PRECISION VALUE C OF THE 'BERNOULLI PROBABILITY' C PARAMETER FOR THE GEOMETRIC C DISTRIBUTION. C P SHOULD BE BETWEEN C 0.0 (EXCLUSIVELY) AND C 1.0 (EXCLUSIVELY). C OUTPUT--A ONE-PAGE GEOMETRIC PROBABILITY PLOT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, PLOT, GEOPPF. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, 'TECHNIQUES FOR TAIL LENGTH ANALYSIS', C PROCEEDINGS OF THE EIGHTEENTH CONFERENCE C ON THE DESIGN OF EXPERIMENTS IN ARMY RESEARCH C DEVELOPMENT AND TESTING (ABERDEEN, MARYLAND, C OCTOBER, 1972), PAGES 425-450. C --FELLER, AN INTRODUCTION TO PROBABILITY C THEORY AND ITS APPLICATIONS, VOLUME 1, C EDITION 2, 1957, PAGES 155-157, 210. C --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 929. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C UPDATED --FEBRUARY 1976. C UPDATED --MARCH 1987. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(7500),W(7500) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501)) C IPR=6 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 IF(P.LE.0.0.OR.P.GE.1.0)GO TO 60 HOLD=X(1) DO65I=2,N IF(X(I).NE.HOLD)GOTO90 65 CONTINUE WRITE(IPR, 9)HOLD RETURN 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 60 WRITE(IPR,21) WRITE(IPR,46)P RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE GEOPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 GEOPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE GEOPLT SUBROUTINE HAS THE VALUE 1 *****) 21 FORMAT(1H ,115H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 GEOPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C SORT THE DATA C CALL SORT(X,N,Y) C C GENERATE UNIFORM ORDER STATISTIC MEDIANS C CALL UNIMED(N,W) C C COMPUTE GEOMETRIC DISTRIBUTION ORDER STATISTIC MEDIANS C DO100I=1,N CALL GEOPPF(W(I),P,W(I)) 100 CONTINUE C C PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS. C COMPUTE THE TAIL LENGTH MEASURE OF THE DISTRIBUTION. C WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION C AND THE SAMPLE SIZE. C CALL PLOT(Y,W,N) Q=.9975 CALL GEOPPF(Q,P,PP9975) Q=.0025 CALL GEOPPF(Q,P,PP0025) Q=.975 CALL GEOPPF(Q,P,PP975) Q=.025 CALL GEOPPF(Q,P,PP025) TAU=(PP9975-PP0025)/(PP975-PP025) WRITE(IPR,105)P,TAU,N C C COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. C COMPUTE LOCATION AND SCALE ESTIMATES C FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. C THEN WRITE THEM OUT. C SUM1=0.0 SUM2=0.0 DO200I=1,N SUM1=SUM1+Y(I) SUM2=SUM2+W(I) 200 CONTINUE YBAR=SUM1/AN WBAR=SUM2/AN SUM1=0.0 SUM2=0.0 SUM3=0.0 DO300I=1,N SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 300 CONTINUE CC=SUM2/SQRT(SUM3*SUM1) YSLOPE=SUM2/SUM3 YINT=YBAR-YSLOPE*WBAR WRITE(IPR,305)CC,YINT,YSLOPE C 105 FORMAT(1H ,44HGEOMETRIC PROBABILITY PLOT WITH PROBABILITY , 1 12HPARAMETER = ,E17.10,1X,7H(TAU = ,E15.8,1H),11X,11HTHE SAMPLE , 1 9HSIZE N = ,I7) 305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X, 122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) C RETURN END SUBROUTINE GEOPPF(P,PPAR,PPF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT GEOPPF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE FOR THE GEOMETRIC C DISTRIBUTION WITH SINGLE PRECISION C 'BERNOULLI PROBABILITY' PARAMETER = PPAR. C THE GEOMETRIC DISTRIBUTION USED C HEREIN HAS MEAN = (1-PPAR)/PPAR C AND STANDARD DEVIATION = SQRT((1-PPAR)/(PPAR*PPAR))). C THIS DISTRIBUTION IS DEFINED FOR C ALL NON-NEGATIVE INTEGER X--X = 0, 1, 2, ... . C THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION C F(X) = PPAR * (1-PPAR)**X. C THE GEOMETRIC DISTRIBUTION IS THE C DISTRIBUTION OF THE NUMBER OF FAILURES C BEFORE OBTAINING 1 SUCCESS IN AN C INDEFINITE SEQUENCE OF BERNOULLI (0,1) C TRIALS WHERE THE PROBABILITY OF SUCCESS C IN A SINGLE TRIAL = PPAR. C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 (INCLUSIVELY) C AND 1.0 (EXCLUSIVELY)) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C --PPAR = THE SINGLE PRECISION VALUE C OF THE 'BERNOULLI PROBABILITY' C PARAMETER FOR THE GEOMETRIC C DISTRIBUTION. C PPAR SHOULD BE BETWEEN C 0.0 (EXCLUSIVELY) AND C 1.0 (EXCLUSIVELY). C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT FUNCTION . C VALUE PPF FOR THE GEOMETRIC DISTRIBUTION C WITH 'BERNOULLI PROBABILITY' PARAMETER VALUE = PPAR. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--PPAR SHOULD BE BETWEEN 0.0 (EXCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C --P SHOULD BE BETWEEN 0.0 (INCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--NOTE THAT EVEN THOUGH THE OUTPUT C FROM THIS DISCRETE DISTRIBUTION C PERCENT POINT FUNCTION C SUBROUTINE MUST NECESSARILY BE A C DISCRETE INTEGER VALUE, C THE OUTPUT VARIABLE PPF IS SINGLE C PRECISION IN MODE. C PPF HAS BEEN SPECIFIED AS SINGLE C PRECISION SO AS TO CONFORM WITH THE DATAPAC C CONVENTION THAT ALL OUTPUT VARIABLES FROM ALL C DATAPAC SUBROUTINES ARE SINGLE PRECISION. C THIS CONVENTION IS BASED ON THE BELIEF THAT C 1) A MIXTURE OF MODES (FLOATING POINT C VERSUS INTEGER) IS INCONSISTENT AND C AN UNNECESSARY COMPLICATION C IN A DATA ANALYSIS; AND C 2) FLOATING POINT MACHINE ARITHMETIC C (AS OPPOSED TO INTEGER ARITHMETIC) C IS THE MORE NATURAL MODE FOR DOING C DATA ANALYSIS. C REFERENCES--FELLER, AN INTRODUCTION TO PROBABILITY C THEORY AND ITS APPLICATIONS, VOLUME 1, C EDITION 2, 1957, PAGES 155-157, 210. C --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 929. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LT.0.0.OR.P.GE.1.0)GOTO50 IF(PPAR.LE.0.0.OR.PPAR.GE.1.0)GOTO55 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P PPF=0.0 RETURN 55 WRITE(IPR,11) WRITE(IPR,46)PPAR PPF=0.0 RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 GEOPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 11 FORMAT(1H ,115H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 GEOPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C IF(P.NE.0.0)GOTO150 PPF=0.0 RETURN 150 CONTINUE C ARG1=1.0-P ARG2=1.0-PPAR ANUM=ALOG(ARG1) ADEN=ALOG(ARG2) RATIO=ANUM/ADEN IRATIO=RATIO PPF=IRATIO ARATIO=IRATIO IF(ARATIO.EQ.RATIO)PPF=IRATIO-1 RETURN C END SUBROUTINE GEORAN(N,P,ISEED,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT GEORAN C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE GEOMETRIC DISTRIBUTION C WITH SINGLE PRECISION 'BERNOULLI PROBABILITY' C PARAMETER = P. C THE GEOMETRIC DISTRIBUTION USED C HEREIN HAS MEAN = (1-P)/P C AND STANDARD DEVIATION = SQRT((1-P)/(P*P))). C THIS DISTRIBUTION IS DEFINED FOR C ALL NON-NEGATIVE INTEGER X--X = 0, 1, 2, ... . C THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION C F(X) = P * (1-P)**X. C THE GEOMETRIC DISTRIBUTION IS THE C DISTRIBUTION OF THE NUMBER OF FAILURES C BEFORE OBTAINING 1 SUCCESS IN AN C INDEFINITE SEQUENCE OF BERNOULLI (0,1) C TRIALS WHERE THE PROBABILITY OF SUCCESS C IN A SINGLE TRIAL = P. C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C --P = THE SINGLE PRECISION VALUE C OF THE 'BERNOULLI PROBABILITY' C PARAMETER FOR THE GEOMETRIC C DISTRIBUTION. C P SHOULD BE BETWEEN C 0.0 (EXCLUSIVELY) AND C 1.0 (EXCLUSIVELY). C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE GEOMETRIC DISTRIBUTION C WITH 'BERNOULLI PROBABILITY' PARAMETER = P. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C COMMENT--NOTE THAT EVEN THOUGH THE OUTPUT C FROM THIS DISCRETE RANDOM NUMBER C GENERATOR MUST NECESSARILY BE A C SEQUENCE OF ***INTEGER*** VALUES, C THE OUTPUT VECTOR X IS SINGLE C PRECISION IN MODE. C X HAS BEEN SPECIFIED AS SINGLE C PRECISION SO AS TO CONFORM WITH THE DATAPAC C CONVENTION THAT ALL OUTPUT VECTORS FROM ALL C DATAPAC SUBROUTINES ARE SINGLE PRECISION. C THIS CONVENTION IS BASED ON THE BELIEF THAT C 1) A MIXTURE OF MODES (FLOATING POINT C VERSUS INTEGER) IS INCONSISTENT AND C AN UNNECESSARY COMPLICATION C IN A DATA ANALYSIS; AND C 2) FLOATING POINT MACHINE ARITHMETIC C (AS OPPOSED TO INTEGER ARITHMETIC) C IS THE MORE NATURAL MODE FOR DOING C DATA ANALYSIS. C REFERENCES--TOCHER, THE ART OF SIMULATION, C 1963, PAGES 14-15. C --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS, C 1964, PAGE 36. C --FELLER, AN INTRODUCTION TO PROBABILITY C THEORY AND ITS APPLICATIONS, VOLUME 1, C EDITION 2, 1957, PAGES 155-157, 210. C --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 929. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82/7 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) C C--------------------------------------------------------------------- C CCCCC CHARACTER*4 IFEEDB CCCCC CHARACTER*4 IPRINT C CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW CCCCC COMMON /PRINT/IFEEDB,IPRINT C IPR=6 C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(P.LE.0.0.OR.P.GE.1.0)GOTO55 GOTO90 50 WRITE(IPR, 5) WRITE(IPR,47)N RETURN 55 WRITE(IPR,11) WRITE(IPR,46)P RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 GEORAN SUBROUTINE IS NON-POSITIVE *****) 11 FORMAT(1H ,115H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 GEORAN SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C GENERATE N UNIFORM (0,1) RANDOM NUMBERS; C CALL UNIRAN(N,ISEED,X) C C GENERATE N GEOMETRIC RANDOM NUMBERS C USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD. C DO100I=1,N IF(X(I).EQ.0.0)GOTO100 ARG1=1.0-X(I) ARG2=1.0-P ANUM=ALOG(ARG1) ADEN=ALOG(ARG2) RATIO=ANUM/ADEN IRATIO=RATIO X(I)=IRATIO ARATIO=IRATIO IF(ARATIO.EQ.RATIO)X(I)=IRATIO-1 100 CONTINUE C RETURN END SUBROUTINE HFNCDF(X,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT HFNCDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR THE HALFNORMAL C DISTRIBUTION. C THE HALFNORMAL DISTRIBUTION USED C HEREIN HAS MEAN = SQRT(2/PI) = 0.79788456 C AND STANDARD DEVIATION = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = (2/SQRT(2*PI)) * EXP(-X*X/2). C THE HALFNORMAL DISTRIBUTION USED HEREIN C IS THE DISTRIBUTION OF THE VARIATE X = ABS(Z) WHERE C THE VARIATE Z IS NORMALLY DISTRIBUTED C WITH MEAN = 0 AND STANDARD DEVIATION = 1. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE C AT WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C X SHOULD BE NON-NEGATIVE. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF FOR THE HALFNORMAL C DISTRIBUTION WITH MEAN = SQRT(2/PI) = 0.79788456 C AND STANDARD DEVIATION = 1. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--X SHOULD BE NON-NEGATIVE. C OTHER DATAPAC SUBROUTINES NEEDED--NORCDF. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 53, 59, 81, 83. C --DANIEL, 'USE OF HALF-NORMAL PLOTS IN C INTERPRETING FACTORIAL TWO-LEVEL EXPERIMENTS', C TECHNOMETRICS, 1959, PAGES 311-341. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --OCTOBER 1976. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(X.LT.0.0)GOTO50 GOTO90 50 WRITE(IPR,4) WRITE(IPR,46)X CDF=0.0 RETURN 90 CONTINUE 4 FORMAT(1H , 96H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE HFNCDF SUBROUTINE IS NEGATIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C CALL NORCDF(X,CDF) CDF=2.0*CDF-1.0 C RETURN END SUBROUTINE HFNPLT(X,N) C C PURPOSE--THIS SUBROUTINE GENERATES A HALFNORMAL C PROBABILITY PLOT. C THE PROTOTYPE HALFNORMAL DISTRIBUTION USED HEREIN C HAS MEAN = SQRT(2/PI) = 0.79788456 C AND STANDARD DEVIATION = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = (2/SQRT(2*PI)) * EXP(-X*X/2). C THE PROTOTYPE HALFNORMAL DISTRIBUTION USED HEREIN C IS THE DISTRIBUTION OF THE VARIATE X = ABS(Z) WHERE C THE VARIATE Z IS NORMALLY DISTRIBUTED C WITH MEAN = 0 AND STANDARD DEVIATION = 1. C AS USED HEREIN, A PROBABILITY PLOT FOR A DISTRIBUTION C IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS C THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION. C THE HALFNORMAL PROBABILITY PLOT IS USEFUL IN C GRAPHICALLY TESTING THE COMPOSITE (THAT IS, C LOCATION AND SCALE PARAMETERS NEED NOT BE SPECIFIED) C HYPOTHESIS THAT THE UNDERLYING DISTRIBUTION C FROM WHICH THE DATA HAVE BEEN RANDOMLY DRAWN C IS THE HALFNORMAL DISTRIBUTION. C IF THE HYPOTHESIS IS TRUE, THE PROBABILITY PLOT C SHOULD BE NEAR-LINEAR. C A MEASURE OF SUCH LINEARITY IS GIVEN BY THE C CALCULATED PROBABILITY PLOT CORRELATION COEFFICIENT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--A ONE-PAGE HALFNORMAL PROBABILITY PLOT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, NORPPF, PLOT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--DANIEL, 'USE OF HALF-NORMAL PLOTS IN C INTERPRETING FACTORIAL TWO-LEVEL EXPERIMENTS', C TECHNOMETRICS, 1959, PAGES 311-341. C --FILLIBEN, 'TECHNIQUES FOR TAIL LENGTH ANALYSIS', C PROCEEDINGS OF THE EIGHTEENTH CONFERENCE C ON THE DESIGN OF EXPERIMENTS IN ARMY RESEARCH C DEVELOPMENT AND TESTING (ABERDEEN, MARYLAND, C OCTOBER, 1972), PAGES 425-450. C --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING, C 1967, PAGES 260-308. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 53, 59, 81, 83. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(7500),W(7500) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501)) C DATA TAU/1.41223913/ C IPR=6 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE HFNPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 HFNPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE HFNPLT SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C SORT THE DATA C CALL SORT(X,N,Y) C C GENERATE UNIFORM ORDER STATISTIC MEDIANS C CALL UNIMED(N,W) C C COMPUTE HALFNORMAL ORDER STATISTIC MEDIANS C DO100I=1,N Q=W(I) Q=(Q+1.0)/2.0 CALL NORPPF(Q,W(I)) 100 CONTINUE C C PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS. C WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION C AND THE SAMPLE SIZE. C CALL PLOT(Y,W,N) WRITE(IPR,105)TAU,N C C COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. C COMPUTE LOCATION AND SCALE ESTIMATES C FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. C THEN WRITE THEM OUT. C SUM1=0.0 SUM2=0.0 DO200I=1,N SUM1=SUM1+Y(I) SUM2=SUM2+W(I) 200 CONTINUE YBAR=SUM1/AN WBAR=SUM2/AN SUM1=0.0 SUM2=0.0 SUM3=0.0 DO300I=1,N SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 300 CONTINUE CC=SUM2/SQRT(SUM3*SUM1) YSLOPE=SUM2/SUM3 YINT=YBAR-YSLOPE*WBAR WRITE(IPR,305)CC,YINT,YSLOPE C 105 FORMAT(1H ,35HHALFNORMAL PROBABILITY PLOT (TAU = ,E15.8,1H),52X,20 1HTHE SAMPLE SIZE N = ,I7) 305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X, 122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) C RETURN END SUBROUTINE HFNPPF(P,PPF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT HFNPPF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE FOR THE HALFNORMAL C DISTRIBUTION. C THE HALFNORMAL DISTRIBUTION USED C HEREIN HAS MEAN = SQRT(2/PI) = 0.79788456 C AND STANDARD DEVIATION = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = (2/SQRT(2*PI)) * EXP(-X*X/2). C THE HALFNORMAL DISTRIBUTION USED HEREIN C IS THE DISTRIBUTION OF THE VARIATE X = ABS(Z) WHERE C THE VARIATE Z IS NORMALLY DISTRIBUTED C WITH MEAN = 0 AND STANDARD DEVIATION = 1. C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 (INCLUSIVELY) C AND 1.0 (EXCLUSIVELY)) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT FUNCTION . C VALUE PPF FOR THE HALFNORMAL DISTRIBUTION C WITH MEAN = SQRT(2/PI) = 0.79788456 C AND STANDARD DEVIATION = 1. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--P SHOULD BE BETWEEN 0.0 (INCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C OTHER DATAPAC SUBROUTINES NEEDED--NORPPF. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 53, 59, 81, 83. C --DANIEL, 'USE OF HALF-NORMAL PLOTS IN C INTERPRETING FACTORIAL TWO-LEVEL EXPERIMENTS', C TECHNOMETRICS, 1959, PAGES 311-341. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --OCTOBER 1976. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LT.0.0.OR.P.GE.1.0)GOTO50 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P PPF=0.0 RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 HFNPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C ARG=(1.0+P)/2.0 CALL NORPPF(ARG,PPF) IF(PPF.LE.0.0)PPF=0.0 C RETURN END SUBROUTINE HFNRAN(N,ISEED,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT HFNRAN C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE HALFNORMAL DISTRIBUTION. C THE PROTOTYPE HALFNORMAL DISTRIBUTION USED C HEREIN HAS MEAN = SQRT(2/PI) = 0.79788456 C AND STANDARD DEVIATION = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = (2/SQRT(2*PI)) * EXP(-X*X/2). C THE PROTOTYPE HALFNORMAL DISTRIBUTION USED HEREIN C IS THE DISTRIBUTION OF THE VARIATE X = ABS(Z) WHERE C THE VARIATE Z IS NORMALLY DISTRIBUTED C WITH MEAN = 0 AND STANDARD DEVIATION = 1. C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE HALFNORMAL DISTRIBUTION C WITH MEAN = SQRT(2/PI) = 0.79788456 C AND STANDARD DEVIATION = 1. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG, SQRT, SIN, COS. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--TOCHER, THE ART OF SIMULATION, C 1963, PAGES 14-15. C --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS, C 1964, PAGE 36. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 53, 59, 81, 83. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82/7 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --JULY 1976. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) DIMENSION Y(2) C C--------------------------------------------------------------------- C CCCCC CHARACTER*4 IFEEDB CCCCC CHARACTER*4 IPRINT C CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW CCCCC COMMON /PRINT/IFEEDB,IPRINT C C-----DATA STATEMENTS------------------------------------------------- C DATA PI/3.14159265359/ C IPR=6 C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 GOTO90 50 WRITE(IPR, 5) WRITE(IPR,47)N RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 HFNRAN SUBROUTINE IS NON-POSITIVE *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C GENERATE N UNIFORM (0,1) RANDOM NUMBERS; C THEN GENERATE 2 ADDITIONAL UNIFORM (0,1) RANDOM NUMBERS C (TO BE USED BELOW IN FORMING THE N-TH NORMAL C RANDOM NUMBER WHEN THE DESIRED SAMPLE SIZE N C HAPPENS TO BE ODD). C CALL UNIRAN(N,ISEED,X) CALL UNIRAN(2,ISEED,Y) C C GENERATE N NORMAL RANDOM NUMBERS C USING THE BOX-MULLER METHOD. C DO200I=1,N,2 IP1=I+1 U1=X(I) IF(I.EQ.N)GOTO210 U2=X(IP1) GOTO220 210 U2=Y(2) 220 ARG1=-2.0*ALOG(U1) ARG2=2.0*PI*U2 SQRT1=SQRT(ARG1) Z1=SQRT1*COS(ARG2) Z2=SQRT1*SIN(ARG2) X(I)=Z1 IF(I.EQ.N)GOTO200 X(IP1)=Z2 200 CONTINUE C C GENERATE N HALFNORMAL RANDOM NUMBERS C USING THE DEFINITION THAT C A HALFNORMAL VARIATE C EQUALS THE ABSOLUTE VALUE OF A NORMAL VARIATE. C DO400I=1,N IF(X(I).LT.0.0)X(I)=-X(I) 400 CONTINUE C RETURN END SUBROUTINE HIST(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT HIST C C PURPOSE--THIS SUBROUTINE PRODUCES 2 HISTOGRAMS C (WITH DIFFERING CLASS WIDTHS) C OF THE DATA IN THE INPUT VECTOR X. C THE FIRST HISTOGRAM HAS CLASS WIDTH = 0.1 C SAMPLE STANDARD DEVIATIONS; C THE SECOND HISTOGRAM HAS CLASS WIDTH = 0.2 C SAMPLE STANDARD DEVIATIONS. C TWO HISTOGRAMS OF THE SAME DATA SET C ARE PRINTED OUT SO AS TO GIVE THE DATA C ANALYST SOME FEEL FOR HOW DEPENDENT C THE HISTOGRAM SHAPE IS AS A FUNCTION C OF THE CLASS WIDTH AND NUMBER OF CLASSES. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--1 PAGE OF AUTOMATIC PRINTOUT C CONSISTING OF 2 HALF-PAGE HISTOGRAMS C (WITH CLASS WIDTHS = 0.1 AND 0.2 SAMPLE C STANDARD DEVIATIONS, RESPECTIVELY) C OF THE DATA IN THE INPUT VECTOR X. C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 1, EDITION 2, 1963, PAGE 4. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--DECEMBER 1972. C UPDATED --JANUARY 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX CHARACTER*4 IGRAPH C DIMENSION X(1) DIMENSION IXLABL(21) COMMON /BLOCK1/ IGRAPH(55,130) CCCCC COMMON IGRAPH(22,123) DIMENSION ICOUNT(121),ICOUN2(121) DIMENSION TLABLE(13),ITLABL(13) DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD RETURN 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 90 CONTINUE 9 FORMAT(1H ,105H***** FATAL DIAGNOSTIC--THE FIRST INPUT ARGUMENT ( 1A VECTOR) TO THE HIST SUBROUTINE HAS ALL ELEMENTS = ,E15.8, 16H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 HIST SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** FATAL ERROR-- THE SECOND INPUT ARGUME 1NT TO THE HIST SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C NUMHIS=2 AN=N C C FIND THE MINIMUM AND THE MAXIMUM XMIN=X(1) XMAX=X(1) DO100I=1,N IF(X(I).LT.XMIN)XMIN=X(I) IF(X(I).GT.XMAX)XMAX=X(I) 100 CONTINUE C C COMPUTE THE SAMPLE MEAN AND SAMPLE STANDARD DEVIATION C SUM=0.0 DO200I=1,N SUM=SUM+X(I) 200 CONTINUE XBAR=SUM/AN SUM=0.0 DO300I=1,N SUM=SUM+(X(I)-XBAR)**2 300 CONTINUE S=SQRT(SUM/(AN-1.0)) C C FORM THE BASIC FREQUENCY TABLE (ICOUNT) WHICH CORRESPONDS TO A HISTOGRAM C WITH 121 CLASSES AND A CLASS WIDTH OF ONE TENTH A SAMPLE STANDARD C DEVIATION. C DO1000I=1,121 ICOUNT(I)=0 1000 CONTINUE C NUMOUT=0 DO1100I=1,N Z=(X(I)-XBAR)/S MT=10.0*(Z+6.0)+2.5 IF(MT.LT.2.OR.MT.GT.122)NUMOUT=NUMOUT+1 IF(MT.LT.2.OR.MT.GT.122)GOTO1100 ICOUNT(MT)=ICOUNT(MT)+1 1100 CONTINUE C C LOOP THROUGH NUMHIS (= 2) HISTOGRAMS C NOTE THAT NUMHIS WAS PREVIOUSLY SET TO 6 (BEFORE JANUARY 1975) C DO1500IHIST=1,NUMHIS C C ZERO OUT THE MINI-GRAPH C DO400I=1,22 DO500J=1,123 IGRAPH(I,J)=BLANK 500 CONTINUE 400 CONTINUE C C PRODUCE THE HORIZONTAL AXES C DO600J=2,122 IGRAPH(1,J)=HYPHEN IGRAPH(22,J)=HYPHEN 600 CONTINUE DO700J=2,122,10 IGRAPH(1,J)=ALPHAI IGRAPH(22,J)=ALPHAI 700 CONTINUE C C PRODUCE THE VERTICAL AXES C DO800I=2,21 IGRAPH(I,1 )=ALPHAI IGRAPH(I,123)=ALPHAI 800 CONTINUE DO900I=2,21,5 IGRAPH(I,1 )=HYPHEN IGRAPH(I,123)=HYPHEN 900 CONTINUE INC=IHIST IF(IHIST.EQ.4)INC=5 IF(IHIST.EQ.5)INC=10 IF(IHIST.EQ.6)INC=20 C C FORM THE FREQUENCY TABLE FOR THIS PARTICULAR HISTOGRAM C ICOUN2(1)=ICOUNT(1) DO1600I=2,121,INC JMAX=I+INC-1 JSUM=0 DO1700J=I,JMAX JSUM=JSUM+ICOUNT(J) 1700 CONTINUE DO1800J=I,JMAX ICOUN2(J)=JSUM 1800 CONTINUE 1600 CONTINUE C C DETERMINE THE MAXIMUM FREQUENCY C MAXFRE=ICOUN2(1) DO2000I=1,121 IF(ICOUN2(I).GT.MAXFRE)MAXFRE=ICOUN2(I) 2000 CONTINUE C C DETERMINE THE PLOT POSITIONS C AMAXFR=MAXFRE HEIGHT=20.0 DO2100J=1,121 JP1=J+1 IF(MAXFRE.LE.20)MX=ICOUN2(J) IF(MAXFRE.LE.20)GOTO2110 ACOUNT=ICOUN2(J) PROP=ACOUNT/AMAXFR MX=PROP*HEIGHT+0.999 2110 IF(MX.EQ.0)GOTO2150 DO2200I=1,MX IREV=22-I IGRAPH(IREV,JP1)=ALPHAX 2200 CONTINUE 2150 IF(ICOUN2(J).GE.1)IGRAPH(21,JP1)=ALPHAX 2100 CONTINUE C C DETERMINE THE X VALUES TO BE LISTED ON THE LEFT LEFT VERTICAL AXIS C IF(MAXFRE.GE.21)GOTO2250 DO2300I=1,20 IREV=22-I IXLABL(IREV)=I 2300 CONTINUE GOTO2450 2250 DO2400I=1,20 IREV=22-I AI=I PROP=AI/20.0 IXLABL(IREV)=PROP*AMAXFR+0.5 2400 CONTINUE C C WRITE EVERYTHING OUT C 2450 IEVODD=IHIST-2*(IHIST/2) IF(IEVODD.EQ.0)GOTO3050 WRITE(IPR,998) 998 FORMAT(1H1) GOTO3060 3050 WRITE(IPR,999) 999 FORMAT(1H ) 3060 WRITE(IPR,3070)(IGRAPH(1,J),J=1,123) 3070 FORMAT(1H ,6X,123A1) DO3100I=2,21 WRITE(IPR,3080)IXLABL(I),(IGRAPH(I,J),J=1,123) 3080 FORMAT(1H ,I5,1X,123A1) 3100 CONTINUE WRITE(IPR,3070)(IGRAPH(22,J),J=1,123) NUMCLA=(120/INC)+1 TINC=INC CWIDSD=TINC*0.1 CWIDTH=CWIDSD*S TLABLE(7)=XBAR ITLABL(7)=0 DO3200I=1,6 IREV=13-I+1 AI=I TLABLE(I)=XBAR-(7.0-AI)*S TLABLE(IREV)=XBAR+(7.0-AI)*S ITLABL(I)=I-7 ITLABL(IREV)=7-I 3200 CONTINUE WRITE(IPR,3205)(TLABLE(I),I=1,13) WRITE(IPR,3210)(ITLABL(I),I=1,13) WRITE(IPR,3215)NUMOUT WRITE(IPR,3220)NUMCLA,CWIDTH,CWIDSD WRITE(IPR,3225)N 3205 FORMAT(1H ,1X,12F10.4,F9.4) 3210 FORMAT(1H ,13(1X,I7,2X)) 3215 FORMAT(1H ,I5,106H OBSERVATIONS WERE IN EXCESS OF 6 SAMPLE STA 1NDARD DEVIATIONS ABOUT THE SAMPLE MEAN AND SO WERE NOT PLOTTED) 3220 FORMAT(1H ,40HHISTOGRAM THE NUMBER OF CLASSES IS ,I6,8X, 119HTHE CLASS WIDTH IS ,E15.8,3H = ,F7.1,20H STANDARD DEVIATIONS) 3225 FORMAT(1H ,20HTHE SAMPLE SIZE N = ,I7) 1500 CONTINUE RETURN END SUBROUTINE INVXWX(N,K) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT INVXWX EXTERNAL DOT C PURPOSE--THIS SUBROUTINE COMPUTES THE INVERSE OF X'WX C WHICH IS DONE BY COMPUTING THE INVERSE OF R'R (WHERE C R HAS JUST RECENTLY BEEN MODIFIED BEFORE CALLING THIS C SUBROUTINE. THE INPUT R = THE SQUARE ROOT OF C THE DIAGONAL MATRIX D TIMES THE OLD MATRIX R. C THE INVERSE OF X'WX WILL BE IDENTICAL C (EXCEPT FOR THE ABSENCE OF S**2 = THE RESIDUAL C VARIANCE) TO THE COVARIANCE MATRIX OF THE COEFFICIENTS. C THE ONLY REASON THIS SUBROUTINE EXISTS IS FOR THE C CALCULATION OF SUCH COVARIANCES. C UNPIVOTING HAS ALSO BEEN DONE HEREIN SO AS TO UNDO C THE PIVOTING DONE IN THE DECOMPOSITION SUBROUTINE (DECOMP). C THE MATRIX C USED HEREIN IS AN INTERMEDIATE RESULT MATRIX. C X--NOT USED C Q--NOT USED C R--USED AND CHANGED C D--NOT USED C IPIVOT--USED C INVERSION ALGORITHM USED--CHOLESKI DECOMPOSITION C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION Q(10000),R(2500),D(50),IPIVOT(50) COMMON /BLOCK2/ WS(15000) COMMON /BLOCK3/ DUM1(3000),DUM2(3000) EQUIVALENCE (Q(1),WS(1)) EQUIVALENCE (R(1),WS(10001)) EQUIVALENCE (D(1),WS(12501)) EQUIVALENCE (IPIVOT(1),WS(12551)) DIMENSION DUM3(200) C C-----START POINT----------------------------------------------------- C DO 10 I=1,K IM1=I-1 IF(IM1.LT.1)GOTO10 DO15J=1,IM1 IRARG=(I-1)*K+J R(IRARG)=0.0 15 CONTINUE 10 CONTINUE DO30JJ=1,K J=K+1-JJ DO 30 II=1,J I=J+1-II IP1=I+1 IF(IP1.GT.K)GOTO25 DO20L=IP1,K IRARG1=(I-1)*K+L IRARG2=(J-1)*K+L IRARG3=(L-1)*K+J DUM1(L)=R(IRARG1) IF(L.LT.J)DUM2(L)=R(IRARG2) IF(L.EQ.J)DUM2(L)=DUM3(L) IF(L.GT.J)DUM2(L)=R(IRARG3) 20 CONTINUE 25 RI=0.0 IRARG=(I-1)*K+I IF (I.EQ.J) RI=1.0/R(IRARG) ANEGRI=-RI C CALL DOT(DUM1,DUM2,IP1,K,ANEGRI,DOTPRO) C IRARG=(I-1)*K+I DOTPRO=-DOTPRO/R(IRARG) IF(I.EQ.J)DUM3(I)=DOTPRO IRARG=(J-1)*K+I IF(I.LT.J)R(IRARG)=DOTPRO 30 CONTINUE DO35I=1,K IRARG=(I-1)*K+I R(IRARG)=DUM3(I) 35 CONTINUE C C MATRIX C NOW EQUALS THE INVERSE OF R'R. C NOW 'UNPIVOT' ON C AND PUT THE RESULTS BACK INTO R. C DO40I=1,K II=IPIVOT(I) DO40J=1,I JJ=IPIVOT(J) IRARG1=(II-1)*K+JJ IRARG2=(I-1)*K+J IRARG3=(JJ-1)*K+II IF(II.LT.JJ)R(IRARG1)=R(IRARG2) IF(II.EQ.JJ)DUM3(II)=R(IRARG2) IF(II.GT.JJ)R(IRARG3)=R(IRARG2) 40 CONTINUE DO50I=1,K IRARG=(I-1)*K+I R(IRARG)=DUM3(I) 50 CONTINUE RETURN END SUBROUTINE LAMCDF(X,ALAMBA,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT LAMCDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR THE (TUKEY) LAMBDA DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = ALAMBA. C IN GENERAL, THE PROBABILITY DENSITY FUNCTION C FOR THIS DISTRIBUTION IS NOT SIMPLE. C THE PERCENT POINT FUNCTION FOR THIS DISTRIBUTION IS C G(P) = ((P**ALAMBA)-((1-P)**ALAMBA))/ALAMBA C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C --ALAMBA = THE SINGLE PRECISION VALUE OF LAMBDA C (THE TAIL LENGTH PARAMETER). C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF FOR THE TUKEY LAMBDA DISTRIBUTION C WITH TAIL LENGTH PARAMETER = ALAMBA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--FOR ALAMBA NON-POSITIVE, NO RESTRICTIONS ON X. C --FOR ALAMBA POSITIVE, X SHOULD BE BETWEEN (-1/ALAMBA) C AND (+1/ALAMBA), INCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--HASTINGS, MOSTELLER, TUKEY, AND WINDSOR, C 'LOW MOMENTS FOR SMALL SAMPLES: A COMPARATIVE C STUDY OF ORDER STATISTICS', ANNALS OF C MATHEMATICAL STATISTICS, 18, 1947, C PAGES 413-426. C --FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGES 42-44, 53-58. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --MAY 1974. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(ALAMBA.LE.0.0)GOTO90 XMAX=1.0/ALAMBA XMIN=-XMAX IF(X.LT.XMIN.OR.X.GT.XMAX)GOTO50 GOTO90 50 WRITE(IPR,2) WRITE(IPR,46)X IF(X.LT.XMIN)CDF=0.0 IF(X.GT.XMAX)CDF=1.0 RETURN 90 CONTINUE 2 FORMAT(1H ,126H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUMEN 1T TO THE LAMCDF SUBROUTINE IS OUTSIDE THE USUAL +-(1/ALAMBA) INTER 1VAL *****) 46 FORMAT(1H ,35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C IF(ALAMBA.GT.0.0)GOTO110 GOTO120 C 110 XMAX=1.0/ALAMBA XMIN=-XMAX IF(X.LE.XMIN)CDF=0.0 IF(X.GE.XMAX)CDF=1.0 IF(X.LE.XMIN.OR.X.GE.XMAX)RETURN C 120 CONTINUE IF(-0.001.LT.ALAMBA.AND.ALAMBA.LT.0.001)GOTO150 GOTO170 150 IF(X.GE.0.0)GOTO160 CDF=EXP(X)/(1.0+EXP(X)) RETURN 160 CDF=1.0/(1.0+EXP(-X)) RETURN C 170 IF(-0.001.LT.ALAMBA.AND.ALAMBA.LT.0.001)GOTO150 PMIN=0.0 PMID=0.5 PMAX=1.0 PLOWER=PMIN PUPPER=PMAX ICOUNT=0 210 XCALC=(PMID**ALAMBA-(1.0-PMID)**ALAMBA)/ALAMBA IF(XCALC.EQ.X)GOTO240 IF(XCALC.GT.X)GOTO220 PLOWER=PMID PMID=(PMID+PUPPER)/2.0 GOTO230 220 PUPPER=PMID PMID=(PMID+PLOWER)/2.0 230 PDEL=ABS(PMID-PLOWER) ICOUNT=ICOUNT+1 IF(PDEL.LT.0.000001.OR.ICOUNT.GT.30)GOTO240 GOTO210 240 CDF=PMID RETURN C END SUBROUTINE LAMPDF(X,ALAMBA,PDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT LAMPDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY C FUNCTION VALUE FOR THE (TUKEY) LAMBDA DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = ALAMBA. C IN GENERAL, THE PROBABILITY DENSITY FUNCTION C FOR THIS DISTRIBUTION IS NOT SIMPLE. C THE PERCENT POINT FUNCTION FOR THIS DISTRIBUTION IS C G(P) = ((P**ALAMBA)-((1-P)**ALAMBA))/ALAMBA C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE PROBABILITY DENSITY C FUNCTION IS TO BE EVALUATED. C --ALAMBA = THE SINGLE PRECISION VALUE OF LAMBDA C (THE TAIL LENGTH PARAMETER). C OUTPUT ARGUMENTS--PDF = THE SINGLE PRECISION PROBABILITY C DENSITY FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY C FUNCTION VALUE PDF FOR THE TUKEY LAMBDA DISTRIBUTION C WITH TAIL LENGTH PARAMETER = ALAMBA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--FOR ALAMBA NON-POSITIVE, NO RESTRICTIONS ON X. C --FOR ALAMBA POSITIVE, X SHOULD BE BETWEEN (-1/ALAMBA) C AND (+1/ALAMBA), INCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--LAMCDF. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--HASTINGS, MOSTELLER, TUKEY, AND WINDSOR, C 'LOW MOMENTS FOR SMALL SAMPLES: A COMPARATIVE C STUDY OF ORDER STATISTICS', ANNALS OF C MATHEMATICAL STATISTICS, 18, 1947, C PAGES 413-426. C --FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGES 42-44, 53-58. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --AUGUST 1974. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(ALAMBA.LE.0.0)GOTO90 XMAX=1.0/ALAMBA XMIN=-XMAX IF(X.LT.XMIN.OR.X.GT.XMAX)GOTO50 GOTO90 50 WRITE(IPR,2) WRITE(IPR,46)X IF(X.LT.XMIN)PDF=0.0 IF(X.GT.XMAX)PDF=1.0 RETURN 90 CONTINUE 2 FORMAT(1H ,126H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUMEN 1T TO THE LAMPDF SUBROUTINE IS OUTSIDE THE USUAL +-(1/ALAMBA) INTER 1VAL *****) 46 FORMAT(1H ,35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C IF(ALAMBA.GT.0.0)GOTO110 GOTO150 110 XMAX=1.0/ALAMBA XMIN=-XMAX IF(X.GT.XMIN.AND.X.LT.XMAX)GOTO150 IF(X.LT.XMIN.OR.X.GT.XMAX)PDF=0.0 IF(X.EQ.XMIN.AND.ALAMBA.LT.1.0)PDF=0.0 IF(X.EQ.XMAX.AND.ALAMBA.LT.1.0)PDF=0.0 IF(X.EQ.XMIN.AND.ALAMBA.EQ.1.0)PDF=0.5 IF(X.EQ.XMAX.AND.ALAMBA.EQ.1.0)PDF=0.5 IF(X.EQ.XMIN.AND.ALAMBA.GT.1.0)PDF=1.0 IF(X.EQ.XMAX.AND.ALAMBA.GT.1.0)PDF=1.0 RETURN C 150 CALL LAMCDF(X,ALAMBA,CDF) SF =CDF**(ALAMBA-1.0)+(1.0-CDF)**(ALAMBA-1.0) PDF=1.0/SF RETURN C END SUBROUTINE LAMPLT(X,N,ALAMBA) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT LAMPLT C C PURPOSE--THIS SUBROUTINE GENERATES A (TUKEY) LAMBDA DISTRIBUTION C PROBABILITY PLOT C (WITH TAIL LENGTH PARAMETER VALUE = ALAMBA). C IN GENERAL, THE PROBABILITY DENSITY FUNCTION C FOR THIS DISTRIBUTION IS NOT SIMPLE. C THE PERCENT POINT FUNCTION FOR THIS DISTRIBUTION IS C G(P) = ((P**ALAMBA)-((1-P)**ALAMBA)) / ALAMBA C AS USED HEREIN, A PROBABILITY PLOT FOR A DISTRIBUTION C IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS C THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION. C THE LAMBDA PROBABILITY PLOT IS USEFUL IN C GRAPHICALLY TESTING THE COMPOSITE (THAT IS, C LOCATION AND SCALE PARAMETERS NEED NOT BE SPECIFIED) C HYPOTHESIS THAT THE UNDERLYING DISTRIBUTION C FROM WHICH THE DATA HAVE BEEN RANDOMLY DRAWN C IS THE LAMBDA DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = ALAMBA. C IF THE HYPOTHESIS IS TRUE, THE PROBABILITY PLOT C SHOULD BE NEAR-LINEAR. C A MEASURE OF SUCH LINEARITY IS GIVEN BY THE C CALCULATED PROBABILITY PLOT CORRELATION COEFFICIENT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --ALAMBA = THE SINGLE PRECISION VALUE OF LAMBDA C (THE TAIL LENGTH PARAMETER). C OUTPUT--A ONE-PAGE LAMBDA PROBABILITY PLOT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, PLOT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, 'TECHNIQUES FOR TAIL LENGTH ANALYSIS', C PROCEEDINGS OF THE EIGHTEENTH CONFERENCE C ON THE DESIGN OF EXPERIMENTS IN ARMY RESEARCH C DEVELOPMENT AND TESTING (ABERDEEN, MARYLAND, C OCTOBER, 1972), PAGES 425-450. C --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING, C 1967, PAGES 260-308. C --FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY, 1969), PAGES 21-44, 229-231, C PAGES 53-58. C --HASTINGS, MOSTELLER, TUKEY, AND WINDSOR, C 'LOW MOMENTS FOR SMALL SAMPLES: A COMPARATIVE C STUDY OF ORDER STATISTICS', ANNALS OF C MATHEMATICAL STATISTICS, 18, 1947, C PAGES 413-426. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(7500),W(7500) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501)) C IPR=6 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE LAMPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 LAMPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE LAMPLT SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C SORT THE DATA C CALL SORT(X,N,Y) C C GENERATE UNIFORM ORDER STATISTIC MEDIANS C CALL UNIMED(N,W) C C COMPUTE LAMBDA DISTRIBUTION ORDER STATISTIC MEDIANS C DO100I=1,N Q=W(I) IF(-0.001.LT.ALAMBA.AND.ALAMBA.LT.0.001)W(I)=ALOG(Q/(1.0-Q)) IF(-0.001.LT.ALAMBA.AND.ALAMBA.LT.0.001)GOTO100 W(I)=(Q**ALAMBA-(1.0-Q)**ALAMBA)/ALAMBA 100 CONTINUE C C PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS. C COMPUTE THE TAIL LENGTH MEASURE OF THE DISTRIBUTION. C WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION C AND THE SAMPLE SIZE. C CALL PLOT(Y,W,N) IF(-0.001.LT.ALAMBA.AND.ALAMBA.LT.0.001)TAU=1.63473745 IF(-0.001.LT.ALAMBA.AND.ALAMBA.LT.0.001)GOTO150 Q=.9975 PP9975=(Q**ALAMBA-(1.0-Q)**ALAMBA)/ALAMBA Q=.0025 PP0025=(Q**ALAMBA-(1.0-Q)**ALAMBA)/ALAMBA Q=.975 PP975 =(Q**ALAMBA-(1.0-Q)**ALAMBA)/ALAMBA Q=.025 PP025 =(Q**ALAMBA-(1.0-Q)**ALAMBA)/ALAMBA TAU=(PP9975-PP0025)/(PP975-PP025) 150 WRITE(IPR,105)ALAMBA,TAU,N C C COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. C COMPUTE LOCATION AND SCALE ESTIMATES C FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. C THEN WRITE THEM OUT. C SUM1=0.0 DO200I=1,N SUM1=SUM1+Y(I) 200 CONTINUE YBAR=SUM1/AN WBAR=0.0 SUM1=0.0 SUM2=0.0 SUM3=0.0 DO300I=1,N SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM2=SUM2+W(I)*Y(I) SUM3=SUM3+W(I)*W(I) 300 CONTINUE CC=SUM2/SQRT(SUM3*SUM1) YSLOPE=SUM2/SUM3 YINT=YBAR-YSLOPE*WBAR WRITE(IPR,305)CC,YINT,YSLOPE C 105 FORMAT(1H ,38HLAMBDA PROBABILITY PLOT WITH LAMBDA = ,E17.10,1X,7H( 1TAU = ,E15.8,1H),24X,20HTHE SAMPLE SIZE N = ,I7) 305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X, 122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) C RETURN END SUBROUTINE LAMPPF(P,ALAMBA,PPF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT LAMPPF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE FOR THE (TUKEY) LAMBDA DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = ALAMBA. C IN GENERAL, THE PROBABILITY DENSITY FUNCTION C FOR THIS DISTRIBUTION IS NOT SIMPLE. C THE PERCENT POINT FUNCTION FOR THIS DISTRIBUTION IS C G(P) = ((P**ALAMBA)-((1-P)**ALAMBA))/ALAMBA C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 AND 1.0) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C --ALAMBA = THE SINGLE PRECISION VALUE OF LAMBDA C (THE TAIL LENGTH PARAMETER). C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT C FUNCTION VALUE PPF FOR THE TUKEY LAMBDA DISTRIBUTION C WITH TAIL LENGTH PARAMETER = ALAMBA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--IF ALAMBA IS POSITIVE, C THEN P SHOULD BE BETWEEN 0.0 AND 1.0, INCLUSIVELY. C IF ALAMBA IS NON-POSITIVE, C THEN P SHOULD BE BETWEEN 0.0 AND 1.0, EXCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGES 21-44, 229-231, C PAGES 53-58. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --HASTINGS, MOSTELLER, TUKEY, AND WINDSOR, C 'LOW MOMENTS FOR SMALL SAMPLES: A COMPARATIVE C STUDY OF ORDER STATISTICS', ANNALS OF C MATHEMATICAL STATISTICS, 18, 1947, C PAGES 413-426. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(ALAMBA.LE.0.0.AND.P.LE.0.0)GOTO50 IF(ALAMBA.LE.0.0.AND.P.GE.1.0)GOTO50 IF(ALAMBA.GT.0.0.AND.P.LT.0.0)GOTO50 IF(ALAMBA.GT.0.0.AND.P.GT.1.0)GOTO50 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 LAMPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C IF(-0.001.LT.ALAMBA.AND.ALAMBA.LT.0.001)GOTO150 GOTO250 150 PPF=ALOG(P/(1.0-P)) RETURN C 250 PPF= (P**ALAMBA-(1.0-P)**ALAMBA)/ALAMBA RETURN C END SUBROUTINE LAMRAN(N,ALAMBA,ISEED,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT LAMRAN C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE (TUKEY) LAMBDA DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = ALAMBA. C IN GENERAL, THE PROBABILITY DENSITY FUNCTION C FOR THIS DISTRIBUTION IS NOT SIMPLE. C THE PERCENT POINT FUNCTION FOR THIS DISTRIBUTION IS C G(P) = ((P**ALAMBA)-((1-P)**ALAMBA))/ALAMBA C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C --ALAMBA = THE SINGLE PRECISION VALUE OF LAMBDA C (THE TAIL LENGTH PARAMETER). C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE (TUKEY) LAMBDA DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = ALAMBA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--TOCHER, THE ART OF SIMULATION, C 1963, PAGES 14-15. C --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS, C 1964, PAGE 36. C --FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGES 21-44, 53-58. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82.6 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) C C--------------------------------------------------------------------- C CCCCC CHARACTER*4 IFEEDB CCCCC CHARACTER*4 IPRINT C CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW CCCCC COMMON /PRINT/IFEEDB,IPRINT C IPR=6 C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C ALAMB2=ALAMBA IF(N.LT.1)GOTO50 GOTO90 50 WRITE(IPR, 5) WRITE(IPR,47)N RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 LAMRAN SUBROUTINE IS NON-POSITIVE *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C GENERATE N UNIFORM (0,1) RANDOM NUMBERS; C CALL UNIRAN(N,ISEED,X) C C GENERATE N LAMBDA DISTRIBUTION RANDOM NUMBERS C USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD. C DO100I=1,N Q=X(I) IF(-0.001.LT.ALAMB2.AND.ALAMB2.LT.0.001)X(I)=ALOG(Q/(1.0-Q)) IF(-0.001.LT.ALAMB2.AND.ALAMB2.LT.0.001)GOTO100 X(I)=(Q**ALAMB2-(1.0-Q)**ALAMB2)/ALAMB2 100 CONTINUE C RETURN END SUBROUTINE LAMSF(P,ALAMBA,SF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT LAMSF C C PURPOSE--THIS SUBROUTINE COMPUTES THE SPARSITY C FUNCTION VALUE FOR THE (TUKEY) LAMBDA DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = ALAMBA. C IN GENERAL, THE PROBABILITY DENSITY FUNCTION C FOR THIS DISTRIBUTION IS NOT SIMPLE. C THE PERCENT POINT FUNCTION FOR THIS DISTRIBUTION IS C G(P) = ((P**ALAMBA)-((1-P)**ALAMBA))/ALAMBA C NOTE THAT THE SPARSITY FUNCTION OF A DISTRIBUTION C IS THE DERIVATIVE OF THE PERCENT POINT FUNCTION, C AND ALSO IS THE RECIPROCAL OF THE PROBABILITY C DENSITY FUNCTION (BUT IN UNITS OF P RATHER THAN X). C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 AND 1.0) C AT WHICH THE SPARSITY C FUNCTION IS TO BE EVALUATED. C --ALAMBA = THE SINGLE PRECISION VALUE OF LAMBDA C (THE TAIL LENGTH PARAMETER). C OUTPUT ARGUMENTS--SF = THE SINGLE PRECISION C SPARSITY FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION SPARSITY C FUNCTION VALUE SF FOR THE TUKEY LAMBDA DISTRIBUTION C WITH TAIL LENGTH PARAMETER = ALAMBA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--IF ALAMBA IS POSITIVE, C THEN P SHOULD BE BETWEEN 0.0 AND 1.0, INCLUSIVELY. C IF ALAMBA IS NON-POSITIVE, C THEN P SHOULD BE BETWEEN 0.0 AND 1.0, EXCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGES 21-44, 229-231, C PAGES 53-58. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --HASTINGS, MOSTELLER, TUKEY, AND WINDSOR, C 'LOW MOMENTS FOR SMALL SAMPLES: A COMPARATIVE C STUDY OF ORDER STATISTICS', ANNALS OF C MATHEMATICAL STATISTICS, 18, 1947, C PAGES 413-426. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(ALAMBA.LE.0.0.AND.P.LE.0.0)GOTO50 IF(ALAMBA.LE.0.0.AND.P.GE.1.0)GOTO50 IF(ALAMBA.GT.0.0.AND.P.LT.0.0)GOTO50 IF(ALAMBA.GT.0.0.AND.P.GT.1.0)GOTO50 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 LAMSF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C SF=P**(ALAMBA-1.0)+(1.0-P)**(ALAMBA-1.0) C RETURN END SUBROUTINE LGNCDF(X,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT LGNCDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR THE LOGNORMAL C DISTRIBUTION. C THE LOGNORMAL DISTRIBUTION USED C HEREIN HAS MEAN = SQRT(E) = 1.64872127 C AND STANDARD DEVIATION = SQRT(E*(E-1)) = 2.16119742. C THIS DISTRIBUTION IS DEFINED FOR ALL POSITIVE X C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = (1/(X*SQRT(2*PI))) * EXP(-ALOG(X)*ALOG(X)/2) C THE LOGNORMAL DISTRIBUTION USED HEREIN C IS THE DISTRIBUTION OF THE VARIATE X = EXP(Z) WHERE C THE VARIATE Z IS NORMALLY DISTRIBUTED C WITH MEAN = 0 AND STANDARD DEVIATION = 1. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE C AT WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C X SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF FOR THE LOGNORMAL C DISTRIBUTION WITH MEAN = SQRT(E) = 1.64872127 C AND STANDARD DEVIATION = SQRT(E*(E-1)) = 2.16119742. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--X SHOULD BE POSITIVE. C OTHER DATAPAC SUBROUTINES NEEDED--NORCDF. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 112-136. C --CRAMER, MATHEMATICAL METHODS OF STATISTICS, C 1946, PAGES 219-220. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(X.LE.0.0)GOTO50 GOTO90 50 WRITE(IPR,4) WRITE(IPR,46)X CDF=0.0 RETURN 90 CONTINUE 4 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE LGNCDF SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C ARG=ALOG(X) CALL NORCDF(ARG,CDF) C RETURN END SUBROUTINE LGNPLT(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT LGNPLT C C PURPOSE--THIS SUBROUTINE GENERATES A LOGNORMAL C PROBABILITY PLOT. C THE PROTOTYPE LOGNORMAL DISTRIBUTION USED HEREIN C HAS MEAN = SQRT(E) = 1.64872127 C AND STANDARD DEVIATION = SQRT(E*(E-1)) = 2.16119742. C THIS DISTRIBUTION IS DEFINED FOR ALL POSITIVE X C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = (1/(X*SQRT(2*PI))) * EXP(-ALOG(X)*ALOG(X)/2) C THE PROTOTYPE LOGNORMAL DISTRIBUTION USED HEREIN C IS THE DISTRIBUTION OF THE VARIATE X = EXP(Z) WHERE C THE VARIATE Z IS NORMALLY DISTRIBUTED C WITH MEAN = 0 AND STANDARD DEVIATION = 1. C AS USED HEREIN, A PROBABILITY PLOT FOR A DISTRIBUTION C IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS C THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION. C THE LOGNORMAL PROBABILITY PLOT IS USEFUL IN C GRAPHICALLY TESTING THE COMPOSITE (THAT IS, C LOCATION AND SCALE PARAMETERS NEED NOT BE SPECIFIED) C HYPOTHESIS THAT THE UNDERLYING DISTRIBUTION C FROM WHICH THE DATA HAVE BEEN RANDOMLY DRAWN C IS THE LOGNORMAL DISTRIBUTION. C IF THE HYPOTHESIS IS TRUE, THE PROBABILITY PLOT C SHOULD BE NEAR-LINEAR. C A MEASURE OF SUCH LINEARITY IS GIVEN BY THE C CALCULATED PROBABILITY PLOT CORRELATION COEFFICIENT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--A ONE-PAGE LOGNORMAL PROBABILITY PLOT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, NORPPF, PLOT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, EXP. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, 'TECHNIQUES FOR TAIL LENGTH ANALYSIS', C PROCEEDINGS OF THE EIGHTEENTH CONFERENCE C ON THE DESIGN OF EXPERIMENTS IN ARMY RESEARCH C DEVELOPMENT AND TESTING (ABERDEEN, MARYLAND, C OCTOBER, 1972), PAGES 425-450. C --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING, C 1967, PAGES 260-308. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 112-136. C --CRAMER, MATHEMATICAL METHODS OF STATISTICS, C 1946, PAGES 219-220. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(7500),W(7500) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501)) C DATA TAU/2.37134890/ C IPR=6 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE LGNPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 LGNPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE LGNPLT SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C SORT THE DATA C CALL SORT(X,N,Y) C C GENERATE UNIFORM ORDER STATISTIC MEDIANS C CALL UNIMED(N,W) C C COMPUTE LOGNORMAL ORDER STATISTIC MEDIANS C DO100I=1,N Q=W(I) CALL NORPPF(Q,Q) W(I)=EXP(Q) 100 CONTINUE C C PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS. C WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION C AND THE SAMPLE SIZE. C CALL PLOT(Y,W,N) WRITE(IPR,105)TAU,N C C COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. C COMPUTE LOCATION AND SCALE ESTIMATES C FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. C THEN WRITE THEM OUT. C SUM1=0.0 SUM2=0.0 DO200I=1,N SUM1=SUM1+Y(I) SUM2=SUM2+W(I) 200 CONTINUE YBAR=SUM1/AN WBAR=SUM2/AN SUM1=0.0 SUM2=0.0 SUM3=0.0 DO300I=1,N SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 300 CONTINUE CC=SUM2/SQRT(SUM3*SUM1) YSLOPE=SUM2/SUM3 YINT=YBAR-YSLOPE*WBAR WRITE(IPR,305)CC,YINT,YSLOPE C 105 FORMAT(1H ,34HLOGNORMAL PROBABILITY PLOT (TAU = ,E15.8,1H),53X,20H 1THE SAMPLE SIZE N = ,I7) 305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X, 122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) C RETURN END SUBROUTINE LGNPPF(P,PPF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT LGNPPF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE FOR THE LOGNORMAL C DISTRIBUTION. C THE LOGNORMAL DISTRIBUTION USED C HEREIN HAS MEAN = SQRT(E) = 1.64872127 C AND STANDARD DEVIATION = SQRT(E*(E-1)) = 2.16119742. C THIS DISTRIBUTION IS DEFINED FOR ALL POSITIVE X C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = (1/(X*SQRT(2*PI))) * EXP(-ALOG(X)*ALOG(X)/2) C THE LOGNORMAL DISTRIBUTION USED HEREIN C IS THE DISTRIBUTION OF THE VARIATE X = EXP(Z) WHERE C THE VARIATE Z IS NORMALLY DISTRIBUTED C WITH MEAN = 0 AND STANDARD DEVIATION = 1. C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 (EXCLUSIVELY) C AND 1.0 (EXCLUSIVELY)) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT FUNCTION . C VALUE PPF FOR THE LOGNORMAL DISTRIBUTION C WITH MEAN = SQRT(E) = 1.64872127 C AND STANDARD DEVIATION = SQRT(E*(E-1)) = 2.16119742. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C OTHER DATAPAC SUBROUTINES NEEDED--NORPPF. C FORTRAN LIBRARY SUBROUTINES NEEDED--EXP. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 112-136. C --CRAMER, MATHEMATICAL METHODS OF STATISTICS, C 1946, PAGES 219-220. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LE.0.0.OR.P.GE.1.0)GOTO50 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P PPF=0.0 RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 LGNPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C CALL NORPPF(P,PPF) PPF=EXP(PPF) C RETURN END SUBROUTINE LGNRAN(N,ISEED,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT LGNRAN C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE LOGNORMAL DISTRIBUTION. C THE PROTOTYPE LOGNORMAL DISTRIBUTION USED C HEREIN HAS MEAN = SQRT(E) = 1.64872127 C AND STANDARD DEVIATION = SQRT(E*(E-1)) = 2.16119742. C THIS DISTRIBUTION IS DEFINED FOR ALL POSITIVE X C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = (1/(X*SQRT(2*PI))) * EXP(-ALOG(X)*ALOG(X)/2) C THE PROTOTYPE LOGNORMAL DISTRIBUTION USED HEREIN C IS THE DISTRIBUTION OF THE VARIATE X = EXP(Z) WHERE C THE VARIATE Z IS NORMALLY DISTRIBUTED C WITH MEAN = 0 AND STANDARD DEVIATION = 1. C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE LOGNORMAL DISTRIBUTION C WITH MEAN = SQRT(E) = 1.64872127 C AND STANDARD DEVIATION = SQRT(E*(E-1)) = 2.16119742. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG, SQRT, SIN, COS, EXP. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--TOCHER, THE ART OF SIMULATION, C 1963, PAGES 14-15. C --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS, C 1964, PAGE 36. C --CRAMER, MATHEMATICAL METHODS OF STATISTICS, C 1946, PAGES 219-220. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 112-136. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGE 88. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82.6 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --JULY 1976. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) DIMENSION Y(2) C C--------------------------------------------------------------------- C CCCCC CHARACTER*4 IFEEDB CCCCC CHARACTER*4 IPRINT C CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW CCCCC COMMON /PRINT/IFEEDB,IPRINT C IPR=6 C C-----DATA STATEMENTS------------------------------------------------- C DATA PI/3.14159265359/ C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 GOTO90 50 WRITE(IPR, 5) WRITE(IPR,47)N RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 LGNRAN SUBROUTINE IS NON-POSITIVE *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C GENERATE N UNIFORM (0,1) RANDOM NUMBERS; C THEN GENERATE 2 ADDITIONAL UNIFORM (0,1) RANDOM NUMBERS C (TO BE USED BELOW IN FORMING THE N-TH NORMAL C RANDOM NUMBER WHEN THE DESIRED SAMPLE SIZE N C HAPPENS TO BE ODD). C CALL UNIRAN(N,ISEED,X) CALL UNIRAN(2,ISEED,Y) C C GENERATE N NORMAL RANDOM NUMBERS C USING THE BOX-MULLER METHOD. C DO200I=1,N,2 IP1=I+1 U1=X(I) IF(I.EQ.N)GOTO210 U2=X(IP1) GOTO220 210 U2=Y(2) 220 ARG1=-2.0*ALOG(U1) ARG2=2.0*PI*U2 SQRT1=SQRT(ARG1) Z1=SQRT1*COS(ARG2) Z2=SQRT1*SIN(ARG2) X(I)=Z1 IF(I.EQ.N)GOTO200 X(IP1)=Z2 200 CONTINUE C C GENERATE N LOGNORMAL RANDOM NUMBERS C USING THE DEFINITION THAT C A LOGNORMAL VARIATE C EQUALS AN EXPONETIATED NORMAL VARIATE. C DO400I=1,N X(I)=EXP(X(I)) 400 CONTINUE C RETURN END SUBROUTINE LOC(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT LOC C C PURPOSE--THIS SUBROUTINE COMPUTES 4 ESTIMATES OF THE C LOCATION (TYPICAL VALUE, MEASURE OF CENTRAL C TENDANCY) OF THE DATA IN THE INPUT VECTOR X. C THE 4 ESTIMATORS EMPLOYED ARE-- C 1) THE SAMPLE MIDRANGE; C 2) THE SAMPLE MEAN; C 3) THE SAMPLE MIDMEAN; AND C 4) THE SAMPLE MEDIAN. C THE ABOVE 4 ESTIMATORS ARE NEAR-OPTIMAL C ESTIMATORS OF LOCATION C FOR SHORTER-TAILED SYMMETRIC DISTRIBUTIONS, C MODERATE-TAILED DISTRIBUTIONS, C MODERATE-LONG-TAILED DISTRIBUTIONS, C AND LONG-TAILED DISTRIBUTIONS, C RESPECTIVELY. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--1/4 PAGE OF AUTOMATIC OUTPUT C CONSISTING OF THE FOLLOWING 4 C ESTIMATES OF LOCATION C FOR THE DATA IN THE INPUT VECTOR X-- C 1) THE SAMPLE MIDRANGE; C 2) THE SAMPLE MEAN; C 3) THE SAMPLE MIDMEAN; AND C 4) THE SAMPLE MEDIAN. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C OTHER DATAPAC SUBROUTINES NEEDED--SORT. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--DIXON AND MASSEY, PAGES 14, 70, AND 71 C --CROW, JOURNAL OF THE AMERICAN STATISTICAL ASSOCIATION, C PAGES 357 AND 387 C --KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 1, EDITION 2, 1963, PAGE 8. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(15000) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)) C IPR=6 IUPPER=15000 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C XMID=0.0 XMEAN=0.0 XMIDM=0.0 XMED=0.0 IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XMID=X(1) XMEAN=X(1) XMIDM=X(1) XMED=X(1) GOTO301 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE LOC SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 LOC SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE LOC SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C SORT THE DATA, C THEN COMPUTE THE SAMPLE MIDRANGE. C CALL SORT(X,N,Y) XMID=(Y(1)+Y(N))/2.0 C C COMPUTE THE SAMPLE MEAN C SUM=0.0 DO100I=1,N SUM=SUM+Y(I) 100 CONTINUE XMEAN=SUM/AN C C COMPUTE THE SAMPLE MIDMEAN C IFLAG=N-(N/4)*4 AIFLAG=IFLAG IMIN=N/4+1 IMAX=N-IMIN+1 SUM=0.0 SUM=SUM+Y(IMIN)*(4.0-AIFLAG)/4.0 SUM=SUM+Y(IMAX)*(4.0-AIFLAG)/4.0 IMINP1=IMIN+1 IMAXM1=IMAX-1 IF(IMINP1.GT.IMAXM1)GOTO250 DO200I=IMINP1,IMAXM1 SUM=SUM+Y(I) 200 CONTINUE 250 XMIDM=SUM/(AN/2.0) C C COMPUTE THE SAMPLE MEDIAN C IFLAG=N-(N/2)*2 NMID=N/2 NMIDP1=NMID+1 IF(IFLAG.EQ.0)XMED=(Y(NMID)+Y(NMIDP1))/2.0 IF(IFLAG.EQ.1)XMED=Y(NMIDP1) C C WRITE EVERYTHING OUT C 301 DO300I=1,5 WRITE(IPR,999) 300 CONTINUE WRITE(IPR,305) WRITE(IPR,999) WRITE(IPR,310)N WRITE(IPR,999) WRITE(IPR,999) WRITE(IPR,315)XMID WRITE(IPR,320)XMEAN WRITE(IPR,325)XMIDM WRITE(IPR,330)XMED C 305 FORMAT(1H ,30X,35HESTIMATES OF THE LOCATION PARAMETER) 310 FORMAT(1H ,34X,21H(THE SAMPLE SIZE N = ,I5,1H)) 315 FORMAT(1H ,38HTHE SAMPLE MIDRANGE IS ,E15.8) 320 FORMAT(1H ,38HTHE SAMPLE MEAN IS ,E15.8) 325 FORMAT(1H ,38HTHE SAMPLE 25 PERCENT TRIMMED MEAN IS ,E15.8) 330 FORMAT(1H ,38HTHE SAMPLE MEDIAN IS ,E15.8) 999 FORMAT(1H ) C RETURN END SUBROUTINE LOGCDF(X,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT LOGCDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR THE LOGISTIC DISTRIBUTION C WITH MEAN = 0 AND STANDARD DEVIATION = PI/SQRT(3). C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = EXP(X)/(1+EXP(X)). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF. C PRINTING--NONE. C RESTRICTIONS--NONE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--EXP. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 1-21. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --MAY 1974. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS. C NO INPUT ARGUMENT ERRORS POSSIBLE C FOR THIS DISTRIBUTION. C C-----START POINT----------------------------------------------------- C IF(X.GE.0.0)GOTO150 CDF=EXP(X)/(1.0+EXP(X)) RETURN 150 CDF=1.0/(1.0+EXP(-X)) RETURN C END SUBROUTINE LOGPDF(X,PDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT LOGPDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY C FUNCTION VALUE FOR THE LOGISTIC DISTRIBUTION C WITH MEAN = 0 AND STANDARD DEVIATION = PI/SQRT(3). C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = EXP(X)/(1+EXP(X)). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE PROBABILITY DENSITY C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--PDF = THE SINGLE PRECISION PROBABILITY C DENSITY FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY C FUNCTION VALUE PDF. C PRINTING--NONE. C RESTRICTIONS--NONE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--EXP. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 1-21. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS. C NO INPUT ARGUMENT ERRORS POSSIBLE C FOR THIS DISTRIBUTION. C C-----START POINT----------------------------------------------------- C PDF=EXP(X)/((1.0+EXP(X))**2) C RETURN END SUBROUTINE LOGPLT(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT LOGPLT C C PURPOSE--THIS SUBROUTINE GENERATES A LOGISTIC C PROBABILITY PLOT. C THE PROTOTYPE LOGISTIC DISTRIBUTION USED HEREIN C HAS MEAN = 0 AND STANDARD DEVIATION = PI/SQRT(3). C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = EXP(X) / (1+EXP(X)). C AS USED HEREIN, A PROBABILITY PLOT FOR A DISTRIBUTION C IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS C THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION. C THE LOGISTIC PROBABILITY PLOT IS USEFUL IN C GRAPHICALLY TESTING THE COMPOSITE (THAT IS, C LOCATION AND SCALE PARAMETERS NEED NOT BE SPECIFIED) C HYPOTHESIS THAT THE UNDERLYING DISTRIBUTION C FROM WHICH THE DATA HAVE BEEN RANDOMLY DRAWN C IS THE LOGISTIC DISTRIBUTION. C IF THE HYPOTHESIS IS TRUE, THE PROBABILITY PLOT C SHOULD BE NEAR-LINEAR. C A MEASURE OF SUCH LINEARITY IS GIVEN BY THE C CALCULATED PROBABILITY PLOT CORRELATION COEFFICIENT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--A ONE-PAGE LOGISTIC PROBABILITY PLOT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, PLOT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, 'TECHNIQUES FOR TAIL LENGTH ANALYSIS', C PROCEEDINGS OF THE EIGHTEENTH CONFERENCE C ON THE DESIGN OF EXPERIMENTS IN ARMY RESEARCH C DEVELOPMENT AND TESTING (ABERDEEN, MARYLAND, C OCTOBER, 1972), PAGES 425-450. C --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING, C 1967, PAGES 260-308. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 1-21. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(7500),W(7500) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501)) C DATA TAU/1.63473745/ C IPR=6 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE LOGPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 LOGPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE LOGPLT SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C SORT THE DATA C CALL SORT(X,N,Y) C C GENERATE UNIFORM ORDER STATISTIC MEDIANS C CALL UNIMED(N,W) C C COMPUTE LOGISTIC ORDER STATISTIC MEDIANS C DO100I=1,N W(I)=ALOG(W(I)/(1.0-W(I))) 100 CONTINUE C C PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS. C WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION C AND THE SAMPLE SIZE. C CALL PLOT(Y,W,N) WRITE(IPR,105)TAU,N C C COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. C COMPUTE LOCATION AND SCALE ESTIMATES C FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. C THEN WRITE THEM OUT. C SUM1=0.0 DO200I=1,N SUM1=SUM1+Y(I) 200 CONTINUE YBAR=SUM1/AN WBAR=0.0 SUM1=0.0 SUM2=0.0 SUM3=0.0 DO300I=1,N SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM2=SUM2+W(I)*Y(I) SUM3=SUM3+W(I)*W(I) 300 CONTINUE CC=SUM2/SQRT(SUM3*SUM1) YSLOPE=SUM2/SUM3 YINT=YBAR-YSLOPE*WBAR WRITE(IPR,305)CC,YINT,YSLOPE C 105 FORMAT(1H ,33HLOGISTIC PROBABILITY PLOT (TAU = ,E15.8,1H),54X,20HT 1HE SAMPLE SIZE N = ,I7) 305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X, 122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) C RETURN END SUBROUTINE LOGPPF(P,PPF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT LOGPPF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE FOR THE LOGISTIC DISTRIBUTION C WITH MEAN = 0 AND STANDARD DEVIATION = PI/SQRT(3). C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = EXP(X)/(1+EXP(X)). C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 AND 1.0) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT C FUNCTION VALUE PPF. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--P SHOULD BE BETWEEN 0.0 AND 1.0, EXCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--EXP. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGES 21-44, 229-231. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 1-21. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LE.0.0.OR.P.GE.1.0)GOTO50 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 LOGPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C CCCCC CALL QCORR(P,Q) CCCCC PPF=ALOG(P/Q) PPF=ALOG(P/(1.0-P)) C RETURN END SUBROUTINE LOGRAN(N,ISEED,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT LOGRAN C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE LOGISTIC DISTRIBUTION C WITH MEAN = 0 AND STANDARD DEVIATION = PI/SQRT(3). C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = EXP(X)/(1+EXP(X)). C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE LOGISTIC DISTRIBUTION C WITH MEAN = 0 AND STANDARD DEVIATION = PI/SQRT(3). C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--TOCHER, THE ART OF SIMULATION, C 1963, PAGES 14-15. C --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS, C 1964, PAGE 36. C --FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGE 230. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 1-21. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82.6 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) C C--------------------------------------------------------------------- C CCCCC CHARACTER*4 IFEEDB CCCCC CHARACTER*4 IPRINT C CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW CCCCC COMMON /PRINT/IFEEDB,IPRINT C IPR=6 C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 GOTO90 50 WRITE(IPR, 5) WRITE(IPR,47)N RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 LOGRAN SUBROUTINE IS NON-POSITIVE *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C GENERATE N UNIFORM (0,1) RANDOM NUMBERS; C CALL UNIRAN(N,ISEED,X) C C GENERATE N LOGISTIC RANDOM NUMBERS C USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD. C DO100I=1,N X(I)=ALOG(X(I)/(1.0-X(I))) 100 CONTINUE C RETURN END SUBROUTINE LOGSF(P,SF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT LOGSF C C PURPOSE--THIS SUBROUTINE COMPUTES THE SPARSITY C FUNCTION VALUE FOR THE LOGISTIC DISTRIBUTION C WITH MEAN = 0 AND STANDARD DEVIATION = PI/SQRT(3). C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = EXP(X)/(1+EXP(X)). C NOTE THAT THE SPARSITY FUNCTION OF A DISTRIBUTION C IS THE DERIVATIVE OF THE PERCENT POINT FUNCTION, C AND ALSO IS THE RECIPROCAL OF THE PROBABILITY C DENSITY FUNCTION (BUT IN UNITS OF P RATHER THAN X). C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 AND 1.0) C AT WHICH THE SPARSITY C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--SF = THE SINGLE PRECISION C SPARSITY FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION SPARSITY C FUNCTION VALUE SF. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--P SHOULD BE BETWEEN 0.0 AND 1.0, EXCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGES 21-44, 229-231. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 1-21. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LE.0.0.OR.P.GE.1.0)GOTO50 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 LOGSF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C SF=1.0/(P-P*P) C RETURN END SUBROUTINE MAX(X,N,IWRITE,XMAX) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT MAX C C PURPOSE--THIS SUBROUTINE COMPUTES THE C SAMPLE MAXIMUM C OF THE DATA IN THE INPUT VECTOR X. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --IWRITE = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL SUPPRESS C THE PRINTING OF THE C SAMPLE MAXIMUM C AS IT IS COMPUTED; C OR (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0), C LIKE, SAY, 1) WILL CAUSE C THE PRINTING OF THE C SAMPLE MAXIMUM C AT THE TIME IT IS COMPUTED. C OUTPUT ARGUMENTS--XMAX = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE MAXIMUM. C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SAMPLE MAXIMUM. C PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO C INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR C CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--DAVID, ORDER STATISTICS, 1970, PAGE 7. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD XMAX=X(1) GOTO101 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XMAX=X(1) GOTO101 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE MAX SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 MAX SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE MAX SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C XMAX=X(1) DO100I=2,N IF(X(I).GT.XMAX)XMAX=X(I) 100 CONTINUE C 101 IF(IWRITE.EQ.0)RETURN WRITE(IPR,999) WRITE(IPR,105)N,XMAX 105 FORMAT(1H ,26HTHE MAXIMUM OF THE SET OF ,I6,17H OBSERVATIONS IS ,E 115.8) 999 FORMAT(1H ) RETURN END SUBROUTINE MEAN(X,N,IWRITE,XMEAN) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT MEAN C C PURPOSE--THIS SUBROUTINE COMPUTES THE C SAMPLE MEAN C OF THE DATA IN THE INPUT VECTOR X. C THE SAMPLE MEAN = (SUM OF THE OBSERVATIONS)/N. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --IWRITE = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL SUPPRESS C THE PRINTING OF THE C SAMPLE MEAN C AS IT IS COMPUTED; C OR (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0), C LIKE, SAY, 1) WILL CAUSE C THE PRINTING OF THE C SAMPLE MEAN C AT THE TIME IT IS COMPUTED. C OUTPUT ARGUMENTS--XMEAN = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE MEAN. C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SAMPLE MEAN. C PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO C INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR C CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 2, EDITION 1, 1961, PAGE 4. C --MOOD AND GRABLE, INTRODUCTION TO THE THEORY C OF STATISTICS, EDITION 2, 1963, PAGE 146. C --DIXON AND MASSEY, INTRODUCTION TO STATISTICAL C ANALYSIS, EDITION 2, 1957, PAGE 14. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C AN=N IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD XMEAN=X(1) GOTO101 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XMEAN=X(1) GOTO101 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE MEAN SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 MEAN SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE MEAN SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C SUM=0.0 DO100I=1,N SUM=SUM+X(I) 100 CONTINUE XMEAN=SUM/AN C 101 IF(IWRITE.EQ.0)RETURN WRITE(IPR,999) WRITE(IPR,105)N,XMEAN 105 FORMAT(1H ,23HTHE SAMPLE MEAN OF THE ,I6,17H OBSERVATIONS IS ,E15. 18) 999 FORMAT(1H ) RETURN END SUBROUTINE MEDIAN(X,N,IWRITE,XMED) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT MEDIAN C C PURPOSE--THIS SUBROUTINE COMPUTES THE C SAMPLE MEDIAN C OF THE DATA IN THE INPUT VECTOR X. C THE SAMPLE MEDIAN = THAT VALUE SUCH THAT HALF THE C DATA SET IS BELOW IT AND HALF ABOVE IT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --IWRITE = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL SUPPRESS C THE PRINTING OF THE C SAMPLE MEDIAN C AS IT IS COMPUTED; C OR (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0), C LIKE, SAY, 1) WILL CAUSE C THE PRINTING OF THE C SAMPLE MEDIAN C AT THE TIME IT IS COMPUTED. C OUTPUT ARGUMENTS--XMED = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE MEDIAN. C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SAMPLE MEDIAN. C PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO C INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR C CONDITION EXISTS. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 15000. C OTHER DATAPAC SUBROUTINES NEEDED--SORT. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 1, EDITION 2, 1963, PAGE 326. C --KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 2, EDITION 1, 1961, PAGE 49. C --DAVID, ORDER STATISTICS, 1970, PAGE 139. C --SNEDECOR AND COCHRAN, STATISTICAL METHODS, C EDITION 6, 1967, PAGE 123. C --DIXON AND MASSEY, INTRODUCTION TO STATISTICAL C ANALYSIS, EDITION 2, 1957, PAGE 70. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(15000) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)) C IPR=6 IUPPER=15000 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD XMED=X(1) GOTO101 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XMED=X(1) GOTO101 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE MEDIAN SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 MEDIAN SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE MEDIAN SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C CALL SORT(X,N,Y) IFLAG=N-(N/2)*2 NMID=N/2 NMIDP1=NMID+1 IF(IFLAG.EQ.0)XMED=(Y(NMID)+Y(NMIDP1))/2.0 IF(IFLAG.EQ.1)XMED=Y(NMIDP1) C 101 IF(IWRITE.EQ.0)RETURN WRITE(IPR,999) WRITE(IPR,105)N,XMED 105 FORMAT(1H ,25HTHE SAMPLE MEDIAN OF THE ,I6,17H OBSERVATIONS IS ,E1 15.8) 999 FORMAT(1H ) RETURN END SUBROUTINE MIDM(X,N,IWRITE,XMIDM) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT MIDM C C PURPOSE--THIS SUBROUTINE COMPUTES THE C SAMPLE MIDMEAN = THE C SAMPLE 25% (ON EACH SIDE) TRIMMED MEAN C OF THE DATA IN THE INPUT VECTOR X. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --IWRITE = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL SUPPRESS C THE PRINTING OF THE C SAMPLE MIDMEAN C AS IT IS COMPUTED; C OR (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0), C LIKE, SAY, 1) WILL CAUSE C THE PRINTING OF THE C SAMPLE MIDMEAN C AT THE TIME IT IS COMPUTED. C OUTPUT ARGUMENTS--XMIDM = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE MIDMEAN. C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SAMPLE MIDMEAN. C PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO C INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR C CONDITION EXISTS. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 15000. C OTHER DATAPAC SUBROUTINES NEEDED--SORT. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--DAVID, ORDER STATISTICS, 1970, PAGES 129, 136. C --CROW AND SIDDIQUI, 'ROBUST ESTIMATION OF LOCATION', C JOURNAL OF THE AMERICAN STATISTICAL ASSOCIATION, C 1967, PAGES 357, 387. C --FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY, 1969). C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(15000) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)) DATA P1,P2,PERP1,PERP2,PERP3/0.25,0.25,25.0,25.0,50.0/ C IPR=6 IUPPER=15000 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C AN=N IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD XMIDM=X(1) GOTO201 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XMIDM=X(1) GOTO201 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE MIDM SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 MIDM SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE MIDM SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C CALL SORT(X,N,Y) C AN=N NP1=P1*AN+0.0001 ISTART=NP1+1 NP2=P2*AN+0.0001 ISTOP=N-NP2 SUM=0.0 K=0 IF(ISTART.GT.ISTOP)GOTO150 DO100I=ISTART,ISTOP K=K+1 CCCCC SUM=SUM+X(I) SUM=SUM+Y(I) 100 CONTINUE AK=K XMIDM=SUM/AK GOTO170 150 WRITE(IPR,155) 155 FORMAT(1H ,37HINTERNAL ERROR IN MIDM SUBROUTINE--, 1 45HTHE START INDEX IS HIGHER THAN THE STOP INDEX) XMIDM=0.0 RETURN 170 CONTINUE C 201 IF(IWRITE.EQ.0)RETURN WRITE(IPR,999) WRITE(IPR,105)N,XMIDM WRITE(IPR,110)PERP1,NP1 WRITE(IPR,115)PERP2,NP2 WRITE(IPR,120)PERP3,K 105 FORMAT(1H ,26HTHE SAMPLE MIDMEAN OF THE ,I6,13H OBSERVATIONS, 1 4H IS ,E15.8) 110 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) , 1 39HOF THE DATA WERE TRIMMED FROM BELOW) 115 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) , 1 39HOF THE DATA WERE TRIMMED FROM ABOVE) 120 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) , 1 52H OF THE DATA REMAIN IN THE MIDDLE AFTER THE TRIMMING) 999 FORMAT(1H ) C RETURN END SUBROUTINE MIDR(X,N,IWRITE,XMIDR) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT MIDR C C PURPOSE--THIS SUBROUTINE COMPUTES THE C SAMPLE MIDRANGE C OF THE DATA IN THE INPUT VECTOR X. C THE SAMPLE MIDRANGE = (SAMPLE MIN + SAMPLE MAX)/2. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --IWRITE = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL SUPPRESS C THE PRINTING OF THE C SAMPLE MIDRANGE C AS IT IS COMPUTED; C OR (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0), C LIKE, SAY, 1) WILL CAUSE C THE PRINTING OF THE C SAMPLE MIDRANGE C AT THE TIME IT IS COMPUTED. C OUTPUT ARGUMENTS--XMIDR = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE MIDRANGE. C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SAMPLE MIDRANGE. C PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO C INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR C CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 1, EDITION 2, 1963, PAGE 338. C --KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 2, EDITION 1, 1961, PAGE 91. C --DAVID, ORDER STATISTICS, 1970, PAGE 97. C --DIXON AND MASSEY, INTRODUCTION TO STATISTICAL C ANALYSIS, EDITION 2, 1957, PAGE 71. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD XMIDR=X(1) GOTO101 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XMIDR=X(1) GOTO101 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE MIDR SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 MIDR SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE MIDR SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C XMIN=X(1) XMAX=X(1) DO100I=1,N IF(X(I).LT.XMIN)XMIN=X(I) IF(X(I).GT.XMAX)XMAX=X(I) 100 CONTINUE XMIDR=(XMIN+XMAX)/2.0 C 101 IF(IWRITE.EQ.0)RETURN WRITE(IPR,999) WRITE(IPR,105)N,XMIDR 105 FORMAT(1H ,27HTHE SAMPLE MIDRANGE OF THE ,I6,17H OBSERVATIONS IS , 1E22.15) 999 FORMAT(1H ) RETURN END SUBROUTINE MIN(X,N,IWRITE,XMIN) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT MIN C C PURPOSE--THIS SUBROUTINE COMPUTES THE C SAMPLE MINIMUM C OF THE DATA IN THE INPUT VECTOR X. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --IWRITE = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL SUPPRESS C THE PRINTING OF THE C SAMPLE MINIMUM C AS IT IS COMPUTED; C OR (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0), C LIKE, SAY, 1) WILL CAUSE C THE PRINTING OF THE C SAMPLE MINIMUM C AT THE TIME IT IS COMPUTED. C OUTPUT ARGUMENTS--XMIN = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE MINIMUM. C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SAMPLE MINIMUM. C PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO C INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR C CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--DAVID, ORDER STATISTICS, 1970, PAGE 7. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD XMIN=X(1) GOTO101 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XMIN=X(1) GOTO101 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE MIN SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 MIN SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE MIN SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C XMIN=X(1) DO100I=2,N IF(X(I).LT.XMIN)XMIN=X(I) 100 CONTINUE C 101 IF(IWRITE.EQ.0)RETURN WRITE(IPR,999) WRITE(IPR,105)N,XMIN 105 FORMAT(1H ,26HTHE MINIMUM OF THE SET OF ,I6,17H OBSERVATIONS IS ,E 115.8) 999 FORMAT(1H ) RETURN END SUBROUTINE MOVE(X,M,IX1,IY1,Y) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT MOVE C C PURPOSE--THIS SUBROUTINE MOVES (COPIES) M ELEMENTS OF THE C SINGLE PRECISION VECTOR X C (STARTING WITH POSITION IX1) C INTO THE SINGLE PRECISION VECTOR Y C (STARTING WITH POSITION IY1). C THIS ALLOWS THE DATA ANALYST C TO TAKE ANY SUBVECTOR IN X AND PLACE IT C ANYWHERE IN THE VECTOR Y. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C OBSERVATIONS, PART (OR ALL) C OF WHICH IS TO BE MOVED C (COPIED) OVER INTO THE VECTOR Y. C --M = THE INTEGER NUMBER OF ELEMENTS C IN THE VECTOR X TO BE MOVED. C --IX1 = THE INTEGER VALUE WHICH DEFINES C THE POSITION IN THE VECTOR X C OF THE FIRST ELEMENT TO BE MOVED. C --IY1 = THE INTEGER VALUE WHICH DEFINES C THE POSITION IN THE VECTOR Y C WHERE THE FIRST ELEMENT TO BE MOVED C WILL BE PLACED. C OUTPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR C INTO WHICH THE COPIED DATA VALUES C FROM THE VECTOR X WILL BE SEQUENTIALLY C PLACED, STARTING IN POSITION IY1 OF Y. C OUTPUT--THE SINGLE PRECISION VECTOR Y. C IN WHICH THE M ELEMENTS IN POSITIONS C IY1, IY1+1, ... , IY1+M-1 C WILL BE IDENTICAL TO THE M ELEMENTS C IN THE X VECTOR IN POSITIONS C IX1, IX1+1, ... , IX1+M-1. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF M FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--THE ELEMENT IN POSITION IX1 OF THE VECTOR X C IS COPIED INTO POSITION IY1 OF THE VECTOR Y, C THE ELEMENT IN POSITION (IX1+1) OF THE VECTOR X C IS COPIED INTO POSITION (IY1+1) OF THE VECTOR Y, C ... , C THE ELEMENT IN POSITION (IX1+M-1) OF THE VECTOR X C IS COPIED INTO POSITION (IY1+M-1) OF THE VECTOR Y. C COMMENT--THE INPUT VECTOR X REMAINS UNALTERED. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--NOVEMBER 1972. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1),Y(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(M.LT.1)GOTO50 IF(IX1.LT.1)GOTO65 IF(IY1.LT.1)GOTO70 IF(M.EQ.1)GOTO55 HOLD=X(IX1) ISTART=IX1+1 IEND=IX1+M-1 DO60I=ISTART,IEND IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,15) WRITE(IPR,47)M RETURN 55 WRITE(IPR,18) GOTO90 65 WRITE(IPR,25) WRITE(IPR,47)IX1 RETURN 70 WRITE(IPR,35) WRITE(IPR,47)IY1 RETURN 90 CONTINUE 9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE MOVE SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 MOVE SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE MOVE SUBROUTINE HAS THE VALUE 1 *****) 25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 MOVE SUBROUTINE IS NON-POSITIVE *****) 35 FORMAT(1H , 91H***** FATAL ERROR--THE FOURTH INPUT ARGUMENT TO THE 1 MOVE SUBROUTINE IS NON-POSITIVE *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C DO100I=1,M J=IX1-1+I K=IY1-1+I Y(K)=X(J) 100 CONTINUE C RETURN END SUBROUTINE NBCDF(X,P,N,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT NBCDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE AT THE SINGLE PRECISION VALUE X C FOR THE NEGATIVE BINOMIAL DISTRIBUTION C WITH SINGLE PRECISION 'BERNOULLI PROBABILITY' C PARAMETER = P, C AND INTEGER 'NUMBER OF SUCCESSES IN BERNOULLI TRIALS' C PARAMETER = N. C THE NEGATIVE BINOMIAL DISTRIBUTION USED C HEREIN HAS MEAN = N*(1-P)/P C AND STANDARD DEVIATION = SQRT(N*(1-P)/(P*P))). C THIS DISTRIBUTION IS DEFINED FOR C ALL NON-NEGATIVE INTEGER X--X = 0, 1, 2, ... . C THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION C F(X) = C(N+X-1,N) * P**N * (1-P)**X. C WHERE C(N+X-1,N) IS THE COMBINATORIAL FUNCTION C EQUALING THE NUMBER OF COMBINATIONS OF N+X-1 ITEMS C TAKEN N AT A TIME. C THE NEGATIVE BINOMIAL DISTRIBUTION IS THE C DISTRIBUTION OF THE NUMBER OF FAILURES C BEFORE OBTAINING N SUCCESSES IN AN C INDEFINITE SEQUENCE OF BERNOULLI (0,1) C TRIALS WHERE THE PROBABILITY OF SUCCESS C IN A SINGLE TRIAL = P. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE C AT WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C X SHOULD BE NON-NEGATIVE AND C INTEGRAL-VALUED. C --P = THE SINGLE PRECISION VALUE C OF THE 'BERNOULLI PROBABILITY' C PARAMETER FOR THE NEGATIVE BINOMIAL C DISTRIBUTION. C P SHOULD BE BETWEEN C 0.0 (EXCLUSIVELY) AND C 1.0 (EXCLUSIVELY). C --N = THE INTEGER VALUE C OF THE 'NUMBER OF SUCCESSES C IN BERNOULLI TRIALS' PARAMETER. C N SHOULD BE A POSITIVE INTEGER. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF C FOR THE NEGATIVE BINOMIAL DISTRIBUTION C WITH 'BERNOULLI PROBABILITY' PARAMETER = P C AND 'NUMBER OF SUCCESSES IN BERNOULLI TRIALS' C PARAMETER = N. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--X SHOULD BE NON-NEGATIVE AND INTEGRAL-VALUED. C --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C --N SHOULD BE A POSITIVE INTEGER. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DATAN. C MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--NOTE THAT EVEN THOUGH THE INPUT C TO THIS CUMULATIVE C DISTRIBUTION FUNCTION SUBROUTINE C FOR THIS DISCRETE DISTRIBUTION C SHOULD (UNDER NORMAL CIRCUMSTANCES) BE A C DISCRETE INTEGER VALUE, C THE INPUT VARIABLE X IS SINGLE C PRECISION IN MODE. C X HAS BEEN SPECIFIED AS SINGLE C PRECISION SO AS TO CONFORM WITH THE DATAPAC C CONVENTION THAT ALL INPUT ****DATA**** C (AS OPPOSED TO SAMPLE SIZE, FOR EXAMPLE) C VARIABLES TO ALL C DATAPAC SUBROUTINES ARE SINGLE PRECISION. C THIS CONVENTION IS BASED ON THE BELIEF THAT C 1) A MIXTURE OF MODES (FLOATING POINT C VERSUS INTEGER) IS INCONSISTENT AND C AN UNNECESSARY COMPLICATION C IN A DATA ANALYSIS; AND C 2) FLOATING POINT MACHINE ARITHMETIC C (AS OPPOSED TO INTEGER ARITHMETIC) C IS THE MORE NATURAL MODE FOR DOING C DATA ANALYSIS. C REFERENCES--NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 945, FORMULAE 26.5.24 AND C 26.5.28, AND PAGE 929. C --JOHNSON AND KOTZ, DISCRETE C DISTRIBUTIONS, 1969, PAGES 122-142, C ESPECIALLY PAGE 127. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGES 92-95. C --FELLER, AN INTRODUCTION TO PROBABILITY C THEORY AND ITS APPLICATIONS, VOLUME 1, C EDITION 2, 1957, PAGES 155-157, 210. C --KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 130-131. C --WILLIAMSON AND BRETHERTON, TABLES OF C THE NEGATIVE BINOMIAL PROBABILITY C DISTRIBUTION, 1963. C --OWEN, HANDBOOK OF STATISTICAL C TABLES, 1962, PAGE 304. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C C--------------------------------------------------------------------- C DOUBLE PRECISION DX2,PI,ANU1,ANU2,Z,SUM,TERM,AI,COEF1,COEF2,ARG DOUBLE PRECISION COEF DOUBLE PRECISION THETA,SINTH,COSTH,A,B DOUBLE PRECISION DSQRT,DATAN DATA PI/3.14159265358979D0/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C AN=N IF(P.LE.0.0.OR.P.GE.1.0)GOTO50 IF(N.LT.1)GOTO55 IF(X.LT.0.0)GOTO60 INTX=X+0.0001 FINTX=INTX DEL=X-FINTX IF(DEL.LT.0.0)DEL=-DEL IF(DEL.GT.0.001)GOTO65 GOTO90 50 WRITE(IPR,11) WRITE(IPR,46)P CDF=0.0 RETURN 55 WRITE(IPR,25) WRITE(IPR,47)N CDF=0.0 RETURN 60 WRITE(IPR,4) WRITE(IPR,46)X IF(X.LT.0.0)CDF=0.0 RETURN 65 WRITE(IPR,5) WRITE(IPR,46)X 90 CONTINUE 4 FORMAT(1H , 96H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE NBCDF SUBROUTINE IS NEGATIVE *****) 5 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE NBCDF SUBROUTINE IS NON-INTEGRAL *****) 11 FORMAT(1H ,115H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 NBCDF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 NBCDF SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C C EXPRESS THE NEGATIVE BINOMIAL CUMULATIVE DISTRIBUTION C FUNCTION IN TERMS OF THE EQUIVALENT BINOMIAL C CUMULATIVE DISTRIBUTION FUNCTION, C AND THEN OPERATE ON THE LATTER. C INTX=X+0.0001 K=N-1 N2=N+INTX C C EXPRESS THE BINOMIAL CUMULATIVE DISTRIBUTION C FUNCTION IN TERMS OF THE EQUIVALENT F C CUMULATIVE DISTRIBUTION FUNCTION, C AND THEN EVALUATE THE LATTER. C AK=K AN2=N2 DX2=(P/(1.0-P))*((AN2-AK)/(AK+1.0)) NU1=2*(K+1) NU2=2*(N2-K) ANU1=NU1 ANU2=NU2 Z=ANU2/(ANU2+ANU1*DX2) C C DETERMINE IF NU1 AND NU2 ARE EVEN OR ODD C IFLAG1=NU1-2*(NU1/2) IFLAG2=NU2-2*(NU2/2) IF(IFLAG1.EQ.0)GOTO120 IF(IFLAG2.EQ.0)GOTO150 GOTO250 C C DO THE NU1 EVEN AND NU2 EVEN OR ODD CASE C 120 SUM=0.0D0 TERM=1.0D0 IMAX=(NU1-2)/2 IF(IMAX.LE.0)GOTO110 DO100I=1,IMAX AI=I COEF1=2.0D0*(AI-1.0D0) COEF2=2.0D0*AI TERM=TERM*((ANU2+COEF1)/COEF2)*(1.0D0-Z) SUM=SUM+TERM 100 CONTINUE C 110 SUM=SUM+1.0D0 SUM=(Z**(ANU2/2.0D0))*SUM CDF=1.0D0-SUM RETURN C C DO THE NU1 ODD AND NU2 EVEN CASE C 150 SUM=0.0D0 TERM=1.0D0 IMAX=(NU2-2)/2 IF(IMAX.LE.0)GOTO210 DO200I=1,IMAX AI=I COEF1=2.0D0*(AI-1.0D0) COEF2=2.0D0*AI TERM=TERM*((ANU1+COEF1)/COEF2)*Z SUM=SUM+TERM 200 CONTINUE C 210 SUM=SUM+1.0D0 CDF=((1.0D0-Z)**(ANU1/2.0D0))*SUM RETURN C C DO THE NU1 ODD AND NU2 ODD CASE C 250 SUM=0.0D0 TERM=1.0D0 ARG=DSQRT((ANU1/ANU2)*DX2) THETA=DATAN(ARG) SINTH=ARG/DSQRT(1.0D0+ARG*ARG) COSTH=1.0D0/DSQRT(1.0D0+ARG*ARG) IF(NU2.EQ.1)GOTO320 IF(NU2.EQ.3)GOTO310 IMAX=NU2-2 DO300I=3,IMAX,2 AI=I COEF1=AI-1.0D0 COEF2=AI TERM=TERM*(COEF1/COEF2)*(COSTH*COSTH) SUM=SUM+TERM 300 CONTINUE C 310 SUM=SUM+1.0D0 SUM=SUM*SINTH*COSTH C 320 A=(2.0D0/PI)*(THETA+SUM) 350 SUM=0.0D0 TERM=1.0D0 IF(NU1.EQ.1)B=0.0D0 IF(NU1.EQ.1)GOTO450 IF(NU1.EQ.3)GOTO410 IMAX=NU1-3 DO400I=1,IMAX,2 AI=I COEF1=AI COEF2=AI+2.0D0 TERM=TERM*((ANU2+COEF1)/COEF2)*(SINTH*SINTH) SUM=SUM+TERM 400 CONTINUE C 410 SUM=SUM+1.0D0 SUM=SUM*SINTH*(COSTH**N) COEF=1.0D0 IEVODD=NU2-2*(NU2/2) IMIN=3 IF(IEVODD.EQ.0)IMIN=2 IF(IMIN.GT.NU2)GOTO420 DO430I=IMIN,NU2,2 AI=I COEF=((AI-1.0D0)/AI)*COEF 430 CONTINUE C 420 COEF=COEF*ANU2 IF(IEVODD.EQ.0)GOTO440 COEF=COEF*(2.0D0/PI) C 440 B=COEF*SUM C 450 CDF=A-B RETURN C END SUBROUTINE NBPPF(P,PPAR,N,PPF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT NBPPF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE AT THE SINGLE PRECISION VALUE P C FOR THE NEGATIVE BINOMIAL DISTRIBUTION C WITH SINGLE PRECISION 'BERNOULLI PROBABILITY' C PARAMETER = PPAR, C AND INTEGER 'NUMBER OF SUCCESSES IN BERNOULLI TRIALS' C PARAMETER = N. C THE NEGATIVE BINOMIAL DISTRIBUTION USED C HEREIN HAS MEAN = N*(1-PPAR)/PPAR C AND STANDARD DEVIATION = SQRT(N*(1-PPAR)/(PPAR*PPAR))). C THIS DISTRIBUTION IS DEFINED FOR C ALL NON-NEGATIVE INTEGER X--X = 0, 1, 2, ... . C THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION C F(X) = C(N+X-1,N) * PPAR**N * (1-PPAR)**X. C WHERE C(N+X-1,N) IS THE COMBINATORIAL FUNCTION C EQUALING THE NUMBER OF COMBINATIONS OF N+X-1 ITEMS C TAKEN N AT A TIME. C THE NEGATIVE BINOMIAL DISTRIBUTION IS THE C DISTRIBUTION OF THE NUMBER OF FAILURES C BEFORE OBTAINING N SUCCESSES IN AN C INDEFINITE SEQUENCE OF BERNOULLI (0,1) C TRIALS WHERE THE PROBABILITY OF SUCCESS C IN A SINGLE TRIAL = PPAR. C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 (INCLUSIVELY) C AND 1.0 (EXCLUSIVELY)) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C --PPAR = THE SINGLE PRECISION VALUE C OF THE 'BERNOULLI PROBABILITY' C PARAMETER FOR THE NEGATIVE BINOMIAL C DISTRIBUTION. C PPAR SHOULD BE BETWEEN C 0.0 (EXCLUSIVELY) AND C 1.0 (EXCLUSIVELY). C --N = THE INTEGER VALUE C OF THE 'NUMBER OF SUCCESSES C IN BERNOULLI TRIALS' PARAMETER. C N SHOULD BE A POSITIVE INTEGER. C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT . C FUNCTION VALUE PPF C FOR THE NEGATIVE BINOMIAL DISTRIBUTION C WITH 'BERNOULLI PROBABILITY' PARAMETER = PPAR C AND 'NUMBER OF SUCCESSES IN BERNOULLI TRIALS' C PARAMETER = N. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--PPAR SHOULD BE BETWEEN 0.0 (EXCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C --N SHOULD BE A POSITIVE INTEGER. C --P SHOULD BE BETWEEN 0.0 (INCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C OTHER DATAPAC SUBROUTINES NEEDED--NORPPF, NBCDF. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, EXP, ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION AND DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--NOTE THAT EVEN THOUGH THE OUTPUT C FROM THIS DISCRETE DISTRIBUTION C PERCENT POINT FUNCTION C SUBROUTINE MUST NECESSARILY BE A C DISCRETE INTEGER VALUE, C THE OUTPUT VARIABLE PPF IS SINGLE C PRECISION IN MODE. C PPF HAS BEEN SPECIFIED AS SINGLE C PRECISION SO AS TO CONFORM WITH THE DATAPAC C CONVENTION THAT ALL OUTPUT VARIABLES FROM ALL C DATAPAC SUBROUTINES ARE SINGLE PRECISION. C THIS CONVENTION IS BASED ON THE BELIEF THAT C 1) A MIXTURE OF MODES (FLOATING POINT C VERSUS INTEGER) IS INCONSISTENT AND C AN UNNECESSARY COMPLICATION C IN A DATA ANALYSIS; AND C 2) FLOATING POINT MACHINE ARITHMETIC C (AS OPPOSED TO INTEGER ARITHMETIC) C IS THE MORE NATURAL MODE FOR DOING C DATA ANALYSIS. C REFERENCES--JOHNSON AND KOTZ, DISCRETE C DISTRIBUTIONS, 1969, PAGES 122-142, C ESPECIALLY PAGE 127, FORMULA 22. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGES 92-95. C --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 929. C --FELLER, AN INTRODUCTION TO PROBABILITY C THEORY AND ITS APPLICATIONS, VOLUME 1, C EDITION 2, 1957, PAGES 155-157, 210. C --KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 130-131. C --WILLIAMSON AND BRETHERTON, TABLES OF C THE NEGATIVE BINOMIAL PROBABILITY C DISTRIBUTION, 1963. C --OWEN, HANDBOOK OF STATISTICAL C TABLES, 1962, PAGE 304. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C C--------------------------------------------------------------------- C DOUBLE PRECISION DPPAR C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LT.0.0.OR.P.GE.1.0)GOTO50 IF(PPAR.LE.0.0.OR.PPAR.GE.1.0)GOTO55 IF(N.LT.1)GOTO60 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P PPF=0.0 RETURN 55 WRITE(IPR,11) WRITE(IPR,46)PPAR PPF=0.0 RETURN 60 WRITE(IPR,25) WRITE(IPR,47)N PPF=0.0 RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 NBPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 11 FORMAT(1H ,115H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 NBPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 NBPPF SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N DPPAR=PPAR PPF=0.0 IX0=0 IX1=0 IX2=0 P0=0.0 P1=0.0 P2=0.0 C C TREAT CERTAIN SPECIAL CASES IMMEDIATELY-- C 1) P = 0.0 C 2) P = 0.5 AND PPAR = 0.5 C 3) PPF = 0 C IF(P.EQ.0.0)GOTO110 IF(P.EQ.0.5.AND.PPAR.EQ.0.5)GOTO130 PF0=DPPAR**N IF(P.LE.PF0)GOTO110 GOTO190 110 PPF=0.0 RETURN 130 PPF=N-1 RETURN 190 CONTINUE C C DETERMINE AN INITIAL APPROXIMATION TO THE NEGATIVE BINOMIAL C PERCENT POINT BY USE OF THE HYPERBOLIC ARCSIN C TRANSFORMATION OF THE NEGATIVE BINOMIAL C TO APPROXIMATE NORMALITY. C (SEE JOHNSON AND KOTZ, DISCRETE DISTRIBUTIONS, C PAGE 127, FORMULA 22). C AMEAN=AN*(1.0-PPAR)/PPAR SD=SQRT(AN*(1.0-PPAR)/(PPAR*PPAR)) ARG=SQRT((AMEAN+0.375)/(AN-0.75)) ARCSH=ALOG(ARG+SQRT(ARG*ARG+1.0)) YMEAN=(SQRT(AN-0.5))*ARCSH YSD=0.5 CALL NORPPF(P,ZPPF) YPPF=YMEAN+ZPPF*YSD ARG=YPPF/SQRT(AN-0.5) E=EXP(ARG) SINH=(E-1.0/E)/2.0 X2=-0.375+(AN-0.75)*SINH*SINH X2=X2+0.5 IX2=X2 C C CHECK AND MODIFY (IF NECESSARY) THIS INITIAL C ESTIMATE OF THE PERCENT POINT C TO ASSURE THAT IT BE NON-NEGATIVE. C IF(IX2.LT.0)IX2=0 C C DETERMINE UPPER AND LOWER BOUNDS ON THE DESIRED C PERCENT POINT BY ITERATING OUT (BOTH BELOW AND ABOVE) C FROM THE ORIGINAL APPROXIMATION AT STEPS C OF 1 STANDARD DEVIATION. C THE RESULTING BOUNDS WILL BE AT MOST C 1 STANDARD DEVIATION APART. C IX0=0 IX1=10**10 ISD=SD+1.0 X2=IX2 CALL NBCDF(X2,PPAR,N,P2) C IF(P2.LT.P)GOTO210 GOTO250 C 210 IX0=IX2 DO220I=1,100000 IX2=IX0+ISD IF(IX2.GE.IX1)GOTO275 X2=IX2 CALL NBCDF(X2,PPAR,N,P2) IF(P2.GE.P)GOTO230 IX0=IX2 220 CONTINUE WRITE(IPR,249) WRITE(IPR,222) GOTO950 230 IX1=IX2 GOTO275 C 250 IX1=IX2 DO260I=1,100000 IX2=IX1-ISD IF(IX2.LE.IX0)GOTO275 X2=IX2 CALL NBCDF(X2,PPAR,N,P2) IF(P2.LT.P)GOTO270 IX1=IX2 260 CONTINUE WRITE(IPR,249) WRITE(IPR,262) GOTO950 270 IX0=IX2 C 275 IF(IX0.EQ.IX1)GOTO280 GOTO295 280 IF(IX0.EQ.0)GOTO285 IF(IX0.EQ.N)GOTO290 WRITE(IPR,249) WRITE(IPR,282) GOTO950 285 IX1=IX1+1 GOTO295 290 IX0=IX0-1 295 CONTINUE C C COMPUTE NEGATIVE BINOMIAL PROBABILITIES FOR THE C DERIVED LOWER AND UPPER BOUNDS. C X0=IX0 X1=IX1 CALL NBCDF(X0,PPAR,N,P0) CALL NBCDF(X1,PPAR,N,P1) C C CHECK THE PROBABILITIES FOR PROPER ORDERING C IF(P0.LT.P.AND.P.LE.P1)GOTO490 IF(P0.EQ.P)GOTO410 IF(P1.EQ.P)GOTO420 IF(P0.GT.P1)GOTO430 IF(P0.GT.P)GOTO440 IF(P1.LT.P)GOTO450 WRITE(IPR,249) WRITE(IPR,401) GOTO950 410 PPF=IX0 RETURN 420 PPF=IX1 RETURN 430 WRITE(IPR,249) WRITE(IPR,431) GOTO950 440 WRITE(IPR,249) WRITE(IPR,441) GOTO950 450 WRITE(IPR,249) WRITE(IPR,451) GOTO950 490 CONTINUE C C THE STOPPING CRITERION IS THAT THE LOWER BOUND C AND UPPER BOUND ARE EXACTLY 1 UNIT APART. C CHECK TO SEE IF IX1 = IX0 + 1; C IF SO, THE ITERATIONS ARE COMPLETE; C IF NOT, THEN BISECT, COMPUTE PROBABILIIES, C CHECK PROBABILITIES, AND CONTINUE ITERATING C UNTIL IX1 = IX0 + 1. C 300 IX0P1=IX0+1 IF(IX1.EQ.IX0P1)GOTO690 IX2=(IX0+IX1)/2 IF(IX2.EQ.IX0)GOTO610 IF(IX2.EQ.IX1)GOTO620 X2=IX2 CALL NBCDF(X2,PPAR,N,P2) IF(P0.LT.P2.AND.P2.LT.P1)GOTO630 IF(P2.LE.P0)GOTO640 IF(P2.GE.P1)GOTO650 610 WRITE(IPR,249) WRITE(IPR,611) GOTO950 620 WRITE(IPR,249) WRITE(IPR,611) GOTO950 630 IF(P2.LE.P)GOTO635 IX1=IX2 P1=P2 GOTO300 635 IX0=IX2 P0=P2 GOTO300 640 WRITE(IPR,249) WRITE(IPR,641) GOTO950 650 WRITE(IPR,249) WRITE(IPR,651) GOTO950 690 PPF=IX1 IF(P0.EQ.P)PPF=IX0 RETURN C 950 WRITE(IPR,240)IX0,P0 WRITE(IPR,241)IX1,P1 WRITE(IPR,242)IX2,P2 WRITE(IPR,244)P WRITE(IPR,245)PPAR,N RETURN C 222 FORMAT(1H ,43HNO UPPER BOUND FOUND AFTER 10**7 ITERATIONS) 240 FORMAT(1H ,7HIX0 = ,I8,10X,5HP0 = ,F14.7) 241 FORMAT(1H ,7HIX1 = ,I8,10X,5HP1 = ,F14.7) 242 FORMAT(1H ,7HIX2 = ,I8,10X,5HP2 = ,F14.7) 244 FORMAT(1H ,7HP = ,F14.7) 245 FORMAT(1H ,7HPPAR = ,F14.7,10X,5HN = ,I8) 249 FORMAT(1H ,47H***** INTERNAL ERROR IN NBPPF SUBROUTINE *****) 262 FORMAT(1H ,43HNO LOWER BOUND FOUND AFTER 10**7 ITERATIONS) 282 FORMAT(1H ,31HLOWER AND UPPER BOUND IDENTICAL) 401 FORMAT(1H ,39HIMPOSSIBLE BRANCH CONDITION ENCOUNTERED) 431 FORMAT(1H ,42HLOWER BOUND PROBABILITY (P0) GREATER THAN , 1 28HUPPER BOUND PROBABILITY (P1)) 441 FORMAT(1H ,42HLOWER BOUND PROBABILITY (P0) GREATER THAN , 1 21HINPUT PROBABILITY (P)) 451 FORMAT(1H ,42HUPPER BOUND PROBABILITY (P1) LESS THAN , 1 21HINPUT PROBABILITY (P)) 611 FORMAT(1H ,39HBISECTION VALUE (X2) = LOWER BOUND (X0)) 621 FORMAT(1H ,39HBISECTION VALUE (X2) = UPPER BOUND (X1)) 641 FORMAT(1H ,33HBISECTION VALUE PROBABILITY (P2) , 1 38HLESS THAN LOWER BOUND PROBABILITY (P0)) 651 FORMAT(1H ,33HBISECTION VALUE PROBABILITY (P2) , 1 41HGREATER THAN UPPER BOUND PROBABILITY (P1)) C END SUBROUTINE NBRAN(N,P,NPAR,ISTART,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT NBRAN C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE NEGATIVE BINOMIAL DISTRIBUTION C WITH SINGLE PRECISION 'BERNOULLI PROBABILITY' C PARAMETER = P, C AND INTEGER 'NUMBER OF SUCCESSES IN BERNOULLI TRIALS' C PARAMETER = NPAR. C THE NEGATIVE BINOMIAL DISTRIBUTION USED C HEREIN HAS MEAN = NPAR*(1-P)/P C AND STANDARD DEVIATION = SQRT(NPAR*(1-P)/(P*P))). C THIS DISTRIBUTION IS DEFINED FOR C ALL NON-NEGATIVE INTEGER X--X = 0, 1, 2, ... . C THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION C F(X) = C(NPAR+X-1,NPAR) * P**NPAR * (1-P)**X. C WHERE C(NPAR+X-1,NPAR) IS THE COMBINATORIAL FUNCTION C EQUALING THE NUMBER OF COMBINATIONS OF NPAR+X-1 ITEMS C TAKEN NPAR AT A TIME. C THE NEGATIVE BINOMIAL DISTRIBUTION IS THE C DISTRIBUTION OF THE NUMBER OF FAILURES C BEFORE OBTAINING NPAR SUCCESSES IN AN C INDEFINITE SEQUENCE OF BERNOULLI (0,1) C TRIALS WHERE THE PROBABILITY OF SUCCESS C IN A SINGLE TRIAL = P. C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C --P = THE SINGLE PRECISION VALUE C OF THE 'BERNOULLI PROBABILITY' C PARAMETER FOR THE NEGATIVE BINOMIAL C DISTRIBUTION. C P SHOULD BE BETWEEN C 0.0 (EXCLUSIVELY) AND C 1.0 (EXCLUSIVELY). C --NPAR = THE INTEGER VALUE C OF THE 'NUMBER OF SUCCESSES C IN BERNOULLI TRIALS' PARAMETER. C NPAR SHOULD BE A POSITIVE INTEGER. C --ISTART = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL START THE C GENERATOR OVER AND HENCE C PRODUCE THE SAME RANDOM SAMPLE C OVER AND OVER AGAIN C UPON SUCCESSIVE CALLS TO C THIS SUBROUTINE WITHIN A RUN; OR C (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0, C LIKE, SAY, 1) WILL ALLOW C THE GENERATOR TO CONTINUE C FROM WHERE IT STOPPED C AND HENCE PRODUCE DIFFERENT C RANDOM SAMPLES UPON C SUCCESSIVE CALLS TO C THIS SUBROUTINE WITHIN A RUN. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE NEGATIVE BINOMIAL DISTRIBUTION C WITH 'BERNOULLI PROBABILITY' PARAMETER = P C AND 'NUMBER OF SUCCESSES IN BERNOULLI TRIALS' C PARAMETER = NPAR. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C --NPAR SHOULD BE A POSITIVE INTEGER. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN, BINRAN, GEORAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--NOTE THAT EVEN THOUGH THE OUTPUT C FROM THIS DISCRETE RANDOM NUMBER C GENERATOR MUST NECESSARILY BE A C SEQUENCE OF ***INTEGER*** VALUES, C THE OUTPUT VECTOR X IS SINGLE C PRECISION IN MODE. C X HAS BEEN SPECIFIED AS SINGLE C PRECISION SO AS TO CONFORM WITH THE DATAPAC C CONVENTION THAT ALL OUTPUT VECTORS FROM ALL C DATAPAC SUBROUTINES ARE SINGLE PRECISION. C THIS CONVENTION IS BASED ON THE BELIEF THAT C 1) A MIXTURE OF MODES (FLOATING POINT C VERSUS INTEGER) IS INCONSISTENT AND C AN UNNECESSARY COMPLICATION C IN A DATA ANALYSIS; AND C 2) FLOATING POINT MACHINE ARITHMETIC C (AS OPPOSED TO INTEGER ARITHMETIC) C IS THE MORE NATURAL MODE FOR DOING C DATA ANALYSIS. C REFERENCES--HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGE 95. C --JOHNSON AND KOTZ, DISCRETE C DISTRIBUTIONS, 1969, PAGES 122-142. C --FELLER, AN INTRODUCTION TO PROBABILITY C THEORY AND ITS APPLICATIONS, VOLUME 1, C EDITION 2, 1957, PAGES 155-157, 210. C --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 929. C --KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 130-131. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(P.LE.0.0.OR.P.GE.1.0)GOTO55 IF(NPAR.LT.1)GOTO60 GOTO90 50 WRITE(IPR, 5) WRITE(IPR,47)N RETURN 55 WRITE(IPR,11) WRITE(IPR,46)P RETURN 60 WRITE(IPR,25) WRITE(IPR,47)NPAR RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 BINRAN SUBROUTINE IS NON-POSITIVE *****) 11 FORMAT(1H ,115H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 BINRAN SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 BINRAN SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C CALL UNIRAN(1,ISTART,G) C C CHECK ON THE MAGNITUDE OF P, C AND BRANCH TO THE FASTER C GENERATION METHOD ACCORDINGLY. C IF(P.LT.0.1)GOTO450 C C IF P IS MODERATE OR LARGE, C GENERATE N NEGATIVE BINOMIAL NUMBERS C USING THE FACT THAT THE C WAITING TIME FOR NPAR SUCCESSES IN C BERNOULLI TRIALS HAS A C NEGATIVE BINOMIAL DISTRIBUTION. C DO100I=1,N ISUM=0 J=1 150 CALL BINRAN(1,P,1,1,B) IB=B+0.5 ISUM=ISUM+IB IF(ISUM.EQ.NPAR)GOTO250 J=J+1 GOTO150 250 X(I)=J 100 CONTINUE RETURN C C IF P IS SMALL, C GENERATE N NEGATIVE BINOMIAL NUMBERS C BY USING THE FACT THAT THE SUM C OF GEOMETRIC VARIATES IS A C NEGATIVE BINOMIAL VARIATE. C 450 DO500I=1,N ISUM=0 DO600J=1,NPAR CALL GEORAN(1,P,1,G) IG=G+0.5 ISUM=ISUM+IG 600 CONTINUE X(I)=ISUM 500 CONTINUE RETURN C END SUBROUTINE NORCDF(X,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT NORCDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR THE NORMAL (GAUSSIAN) C DISTRIBUTION WITH MEAN = 0 AND STANDARD DEVIATION = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = (1/SQRT(2*PI))*EXP(-X*X/2). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF. C PRINTING--NONE. C RESTRICTIONS--NONE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--EXP. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 932, FORMULA 26.2.17. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 40-111. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DATA B1,B2,B3,B4,B5,P/.319381530,-0.356563782,1.781477937,-1.82125 15978,1.330274429,.2316419/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS. C NO INPUT ARGUMENT ERRORS POSSIBLE C FOR THIS DISTRIBUTION. C C-----START POINT----------------------------------------------------- C Z=X IF(X.LT.0.0)Z=-Z T=1.0/(1.0+P*Z) CDF=1.0-((0.39894228040143 )*EXP(-0.5*Z*Z))*(B1*T+B2*T**2+B3*T**3 1+B4*T**4+B5*T**5) IF(X.LT.0.0)CDF=1.0-CDF C RETURN END SUBROUTINE NOROUT(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT NOROUT C C PURPOSE--THIS SUBROUTINE PERFORMS A NORMAL OUTLIER ANALYSIS C ON THE DATA IN THE INPUT VECTOR X. C THIS ANALYSIS CONSISTS OF-- C 1) VARIOUS NORMAL OUTLIER STATISTICS; C 2) VARIOUS PARTIAL SAMPLE MEANS C 3) VARIOUS PARTIAL SAMPLE STANDARD DEVIATIONS; C 4) THE FIRST 40 AND LAST 40 ORDERED OBSERVATIONS; C 5) A LINE PLOT; AND C 6) A NORMAL PROBABILITY PLOT. C WHEN THE FIRST 40 AND LAST 40 ORDERED OBSERVATIONS C ARE PRINTED OUT, ALSO INCLUDED FOR EACH C OF THE 40+40 = 80 LISTED DATA VALUES C IS THE CORRESPONDING RESIDUAL ABOUT C THE (FULL) SAMPLE MEAN, C THE STANDARDIZED RESIDUAL, C THE NORMAL N(0,1) VALUE FOR THE STANDARDIZED C RESIDUAL, C AND THE POSITION NUMBER C IN THE ORIGINAL DATA VECTOR X. C THIS LAST PIECE OF INFORMATION ALLOWS C THE DATA ANALYST TO EASILY LOCATE C BACK IN THE ORIGINAL DATA VECTOR . C A SUSPECTED OUTLIER OR OTHERWISE C INTERESTING OBSERVATION. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--4 PAGES OF AUTOMATIC PRINTOUT-- C 1) VARIOUS NORMAL OUTLIER STATISTICS; C 2) VARIOUS PARTIAL SAMPLE MEANS C 3) VARIOUS PARTIAL SAMPLE STANDARD DEVIATIONS; C 4) THE FIRST 40 AND LAST 40 ORDERED OBSERVATIONS; C 5) A LINE PLOT; AND C 6) A NORMAL PROBABILITY PLOT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C OTHER DATAPAC SUBROUTINES NEEDED--SORTP, NORCDF, NORPLT, C SORT, UNIMED, NORPPF, PLOT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C WRITE OUT THE FIRST 40 AND LAST 40 ORDERED OBSERVATIONS, C INCLUDING THEIR RESIDUALS ABOUT THE (FULL) SAMPLE MEAN, C THE STANDARDIZED RESIDUALS, C THE NORMAL N(0,1) CUMULATIVE DISTRIBUTION FUNCTION VALUE C OF THE STANDARDIZED RESIDUAL, AND C THE POSITION NUMBER IN THE ORIGINAL DATA VECTOR X. C REFERENCES--GRUBBS, TECHNOMETRICS, 1969, PAGES 1-21 C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX CHARACTER*4 ILINE1 CHARACTER*4 ILINE2 C DIMENSION X(1) DIMENSION Y(7500),XPOS(7500) DIMENSION ILINE1(130),ILINE2(130) DIMENSION XLINE(13) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(XPOS(1),WS(7501)) C DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/ C IPR=6 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD RETURN 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE NOROUT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 NOROUT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE NOROUT SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C NM1=N-1 NM2=N-2 NM3=N-3 NM4=N-4 NM5=N-5 AN=N ANM1=NM1 ANM2=NM2 ANM3=NM3 ANM4=NM4 ANM5=NM5 C C SORT THE DATA AND ALSO CARRY ALONG THE OBSERVATION NUMBER--THAT IS, C THE POSITION IN THE ORIGINAL DATA SET OF THE I-TH ORDER STATISTIC C CALL SORTP(X,N,Y,XPOS) C C COMPUTE PARTIAL SAMPLE MEANS C SUM=0.0 DO100I=3,NM2 SUM=SUM+Y(I) 100 CONTINUE XB23=SUM/ANM4 XB13=(SUM+Y(2))/ANM3 XB24=(SUM+Y(NM1))/ANM3 XB3=(SUM+Y(1)+Y(2))/ANM2 XB2=(SUM+Y(NM1)+Y(N))/ANM2 XB14=(SUM+Y(2)+Y(NM1))/ANM2 XB4=(SUM+Y(1)+Y(2)+Y(NM1))/ANM1 XB1=(SUM+Y(2)+Y(NM1)+Y(N))/ANM1 XB=(SUM+Y(1)+Y(2)+Y(NM1)+Y(N))/AN C C COMPUTE PARTIAL SUMS OF SQUARED DEVIATIONS C ABOUT THE PARTIAL SAMPLE MEANS C SSQ=0.0 SSQ1=0.0 SSQ4=0.0 SSQ14=0.0 SSQ2=0.0 SSQ3=0.0 SSQ24=0.0 SSQ13=0.0 SSQ23=0.0 DO210I=1,N SSQ=SSQ+(Y(I)-XB)**2 210 CONTINUE DO220I=2,N SSQ1=SSQ1+(Y(I)-XB1)**2 220 CONTINUE DO230I=1,NM1 SSQ4=SSQ4+(Y(I)-XB4)**2 230 CONTINUE DO240I=2,NM1 SSQ14=SSQ14+(Y(I)-XB14)**2 240 CONTINUE DO250I=3,N SSQ2=SSQ2+(Y(I)-XB2)**2 250 CONTINUE DO260I=1,NM2 SSQ3=SSQ3+(Y(I)-XB3)**2 260 CONTINUE DO270I=3,NM1 SSQ24=SSQ24+(Y(I)-XB24)**2 270 CONTINUE DO280I=2,NM2 SSQ13=SSQ13+(Y(I)-XB13)**2 280 CONTINUE DO290I=3,NM2 SSQ23=SSQ23+(Y(I)-XB23)**2 290 CONTINUE C C COMPUTE PARTIAL SAMPLE STANDARD DEVIATIONS C S=SQRT(SSQ/ANM1) S1=SQRT(SSQ1/ANM2) S4=SQRT(SSQ4/ANM2) S14=SQRT(SSQ14/ANM3) S2=SQRT(SSQ2/ANM3) S3=SQRT(SSQ3/ANM3) S24=SQRT(SSQ24/ANM4) S13=SQRT(SSQ13/ANM4) S23=SQRT(SSQ23/ANM5) C C COMPUTE OUTLIER STATISTICS C OMIT NO OBSERVATIONS, TEST FOR X(1) ST1=(XB-Y(1))/S C OMIT NO OBSERVATIONS, TEST FOR X(N) ST2=(Y(N)-XB)/S C OMIT NO OBSERVATIONS, TEST FOR X(1) AND X(N) SIMULTANEOUSLY ST3=(Y(N)-Y(1))/S C OMIT X(1), TEST FOR X(2) ST4=SSQ2/SSQ C OMIT X(N), TEST FOR X(N-1) ST5=SSQ3/SSQ C OMIT X(1) AND X(N), TEST FOR X(2) ST6=(XB14-Y(2))/S14 C OMIT X(1) AND X(N), TEST FOR X(N-1) ST7=(Y(NM1)-XB14)/S14 C OMIT X(1) AND X(N), TEST FOR X(2) AND X(N-1) ST8=(Y(NM1)-Y(2))/S14 SUM4=0.0 DO300I=2,NM2 SUM4=SUM4+(Y(I)-XB14)**4 300 CONTINUE ST9=(AN-2.0)*SUM4/(SSQ14**2) ST9=ST9+3.0 C C COMPUTE THE LINE PLOT WHICH SHOWS THE DISTRIBUTION OF THE OBSERVED C VALUES IN TERMS OF MULTIPLES OF SAMPLE STANDARD DEVIATIONS AWAY FROM C THE SAMPLE MEAN C DO1000I=1,130 ILINE1(I)=BLANK ILINE2(I)=BLANK 1000 CONTINUE ICOUNT=0 DO1100I=1,N MX=10.0*(((X(I)-XB )/S)+6.0)+0.5 MX=MX+7 IF(MX.LT. 7.OR.MX.GT.127)ICOUNT=ICOUNT+1 IF(MX.LT. 7.OR.MX.GT.127)GOTO1100 ILINE1(MX)=ALPHAX 1100 CONTINUE DO1200I=7,127 ILINE2(I)=HYPHEN 1200 CONTINUE DO1300I=7,127,10 ILINE2(I)=ALPHAI 1300 CONTINUE XLINE(7)=XB DO1400I=1,6 IREV=13-I+1 AI=I XLINE(I)=XB -(7.0-AI)*S XLINE(IREV)=XB +(7.0-AI)*S 1400 CONTINUE C C WRITE EVERYTHING OUT C C WRITE OUT THE OUTLIER STATISTICS C WRITE(IPR,998) WRITE(IPR,3010) WRITE(IPR,999) WRITE(IPR,3020)N WRITE(IPR,999) WRITE(IPR,3023) DO3025I=1,6 WRITE(IPR,999) 3025 CONTINUE WRITE(IPR,3030) WRITE(IPR,999) WRITE(IPR,999) WRITE(IPR,3040) WRITE(IPR,3041) WRITE(IPR,999) WRITE(IPR,3051)ST1,N WRITE(IPR,3052)ST2,N WRITE(IPR,3053)ST3,N WRITE(IPR,3054)ST4,N WRITE(IPR,3055)ST5,N WRITE(IPR,3056)ST6,NM2 WRITE(IPR,3057)ST7,NM2 WRITE(IPR,3058)ST8,NM2 WRITE(IPR,3059)ST9,NM2 DO3070I=1,10 WRITE(IPR,999) 3070 CONTINUE C C WRITE OUT THE PARTIAL SAMPLE MEANS C AND THE PARTIAL SAMPLE STANDARD DEVIATIONS. C WRITE(IPR,3110) WRITE(IPR,999) WRITE(IPR,999) WRITE(IPR,3120) WRITE(IPR,3121) WRITE(IPR,999) WRITE(IPR,3131)XB ,S WRITE(IPR,3132)XB1 ,S1 WRITE(IPR,3133)XB4 ,S4 WRITE(IPR,3134)XB14,S14 WRITE(IPR,3135)XB2,S2 WRITE(IPR,3136)XB3,S3 WRITE(IPR,3137)XB24,S24 WRITE(IPR,3138)XB13,S13 WRITE(IPR,3139)XB23,S23 C C WRITE OUT THE FIRST 40 AND LAST 40 ORDERED OBSERVATIONS, C INCLUDING THEIR RESIDUALS ABOUT THE (FULL) SAMPLE MEAN, C THE STANDARDIZED RESIDUALS, C THE NORMAL N(0,1) CUMULATIVE DISTRIBUTION FUNCTION VALUE C OF THE STANDARDIZED RESIDUAL, AND C THE POSITION NUMBER IN THE ORIGINAL DATA VECTOR X. C WRITE(IPR,998) WRITE(IPR,3210) WRITE(IPR,999) WRITE(IPR,999) WRITE(IPR,3220) WRITE(IPR,3221) WRITE(IPR,3222) WRITE(IPR,3223) WRITE(IPR,999) IF(N.LE.80)GOTO3225 DO3226I=1,80 IF(I.LE.40)J=I IF(I.GE.41)J=I+N-80 RES=Y(J)-XB STRES=RES/S CALL NORCDF(STRES,CDF) WRITE(IPR,3231)J,Y(J),RES,STRES,CDF,XPOS(J) IFLAG=I-(I/10)*10 IF(IFLAG.EQ.0)WRITE(IPR,999) 3226 CONTINUE GOTO3227 3225 DO3230I=1,N RES=Y(I)-XB STRES=RES/S CALL NORCDF(STRES,CDF) WRITE(IPR,3231)I,Y(I),RES,STRES,CDF,XPOS(I) IFLAG=I-(I/10)*10 IF(IFLAG.EQ.0)WRITE(IPR,999) 3230 CONTINUE 3227 DO3240I=1,10 WRITE(IPR,999) 3240 CONTINUE C C WRITE OUT THE LINE PLOT SHOWING THE DEVIATIONS C OF THE OBSERVATIONS ABOUT THE (FULL) SAMPLE MEAN C IN TERMS OF MULTIPLES OF THE (FULL) SAMPLE STANDARD C DEVIATION. C WRITE(IPR,3310) WRITE(IPR,999) WRITE(IPR,999) WRITE(IPR,3321)(ILINE1(I),I=1,130) WRITE(IPR,3321)(ILINE2(I),I=1,130) WRITE(IPR,3323) WRITE(IPR,3326)(XLINE(I),I=1,13) WRITE(IPR,999) WRITE(IPR,3324)ICOUNT C C WRITE OUT A NORMAL PROBABILITY PLOT C CALL NORPLT(Y,N) C 998 FORMAT(1H1) 999 FORMAT(1H ) 3010 FORMAT(1H ,48X,23HNORMAL OUTLIER ANALYSIS) 3020 FORMAT(1H ,46X,21H(THE SAMPLE SIZE N = ,I5,1H)) 3023 FORMAT(1H ,39X,50HREFERENCE--GRUBBS, TECHNOMETRICS, 1969, PAGES 1- 121) 3030 FORMAT(1H ,49X,18HOUTLIER STATISTICS) 3040 FORMAT(1H ,114H OMIT TEST FORM 1 VALUE PSEUDO-SAMPLE SIZE TABLE) 3041 FORMAT(1H ,116HAS AN OUTLIER AS AN OUTLIER OF STATIST 1IC OF STATISTIC FOR TABLE LOOK-UP REFERENCE) 3051 FORMAT(1H ,65H NONE X(1) (XBAR - X(1)) 1/S ,F8.4,15H N = ,I5,31H GRUBBS, TECH., 19 169, P. 4) 3052 FORMAT(1H ,65H NONE X(N) (X(N) - XBAR) 1/S ,F8.4,15H N = ,I5,31H GRUBBS, TECH., 19 169, P. 4) 3053 FORMAT(1H ,65H NONE X(1) AND X(N) RANGE/S 1 ,F8.4,15H N = ,I5,31H GRUBBS, TECH., 19 169, P. 8) 3054 FORMAT(1H ,65H X(1) X(2) SSQD(1,2)/SS 1QD ,F8.4,15H N = ,I5,31H GRUBBS, TECH., 19 169, P. 11) 3055 FORMAT(1H ,65H X(N) X(N-1) SSQD(N-1,N)/S 1SQD ,F8.4,15H N = ,I5,31H GRUBBS, TECH., 19 169, P. 11) 3056 FORMAT(1H ,65HX(1) AND X(N) X(2) (XBAR(1,N) - X(2) 1)/S(1,N) ,F8.4,15H N-2 = ,I5,31H GRUBBS, TECH., 19 169, P. 4) 3057 FORMAT(1H ,65HX(1) AND X(N) X(N-1) (X(N-1) - XBAR(1,N 1))/S(1,N) ,F8.4,15H N-2 = ,I5,31H GRUBBS, TECH., 19 169, P. 4) 3058 FORMAT(1H ,65HX(1) AND X(N) X(2) AND X(N-1) RANGE(1,N)/S(1 1,N) ,F8.4,15H N-2 = ,I5,31H GRUBBS, TECH., 19 169, P. 8) 3059 FORMAT(1H ,65HX(1) AND X(N) X(2) AND X(N-1) SAMPLE KURTOSIS 1(1,N) ,F8.4,15H N-2 = ,I5,31H GRUBBS, TECH., 19 169, P. 14) 3110 FORMAT(1H ,30X,59HPARTIAL SAMPLE MEANS AND PARTIAL SAMPLE STANDARD 1 DEVIATIONS) 3120 FORMAT(1H ,65H OMIT PARTIAL SAMPLE P 1ARTIAL SAMPLE) 3121 FORMAT(1H ,67H AS AN OUTLIER MEAN STA 1NDARD DEVIATION) 3131 FORMAT(1H ,29H NONE ,E15.8,5X,E15.8) 3132 FORMAT(1H ,29H X(1) ,E15.8,5X,E15.8) 3133 FORMAT(1H ,29H X(N) ,E15.8,5X,E15.8) 3134 FORMAT(1H ,29H X(1) AND X(N) ,E15.8,5X,E15.8) 3135 FORMAT(1H ,29H X(1) AND X(2) ,E15.8,5X,E15.8) 3136 FORMAT(1H ,29H X(N-1) AND X(N) ,E15.8,5X,E15.8) 3137 FORMAT(1H ,29H X(1), X(2), AND X(N) ,E15.8,5X,E15.8) 3138 FORMAT(1H ,29H X(1), X(N-1), AND X(N) ,E15.8,5X,E15.8) 3139 FORMAT(1H ,29HX(1), X(2), X(N-1), AND X(N) ,E15.8,5X,E15.8) 3210 FORMAT(1H ,130HORDER STATISTICS, RESIDUALS ABOUT THE SAMPLE MEAN, 1STANDARDIZED RESIDUALS, AND NORMAL(0,1) CUMULATIVE DISTRIBUTION FU 1NCTION VALUES) 3220 FORMAT(1H ,95H INDEX ORDERED RESIDUALS STANDA 1RDIZED NORMAL(0,1) OBSERVATION) 3221 FORMAT(1H ,92H OBSERVATIONS ABOUT THE RESID 1UALS CDF VALUES OF THE NUMBER) 3222 FORMAT(1H ,76H SAMPLE MEAN 1 STANDARDIZED) 3223 FORMAT(1H ,74H 1 RESIDUALS) 3231 FORMAT(1H ,I5,4X,E15.8,1X,E15.8,7X,F7.2,11X,F8.5,11X,F7.0) 3310 FORMAT(1H ,131HLINE PLOT SHOWING THE DISTRIBUTION OF THE OBSERVATI 1ONS ABOUT THE SAMPLE MEAN IN TERMS OF MULTIPLES OF THE SAMPLE STAN 1DARD DEVIATION) 3321 FORMAT(1H ,130A1) 3323 FORMAT(1H , 127H -6 -5 -4 -3 -2 1 -1 0 1 2 3 4 1 5 6) 3324 FORMAT(1H ,10X,I5,105H OBSERVATIONS WERE IN EXCESS OF 6 SAMPLE STA 1NDARD DEVIATIONS FROM THE SAMPLE MEAN AND SO WERE NOT PLOTTED) 3326 FORMAT(1H ,13F10.4) C RETURN END SUBROUTINE NORPDF(X,PDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT NORPDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY C FUNCTION VALUE FOR THE NORMAL (GAUSSIAN) C DISTRIBUTION WITH MEAN = 0 AND STANDARD DEVIATION = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = (1/SQRT(2*PI))*EXP(-X*X/2). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE PROBABILITY DENSITY C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--PDF = THE SINGLE PRECISION PROBABILITY C DENSITY FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY C FUNCTION VALUE PDF. C PRINTING--NONE. C RESTRICTIONS--NONE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--EXP. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 40-111. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DATA C/.3989422804/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS. C NO INPUT ARGUMENT ERRORS POSSIBLE C FOR THIS DISTRIBUTION. C C-----START POINT----------------------------------------------------- C PDF=C*EXP(-(X*X)/2.0) C RETURN END SUBROUTINE NORPLT(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT NORPLT C C PURPOSE--THIS SUBROUTINE GENERATES A NORMAL (GAUSSIAN) C PROBABILITY PLOT. C THE PROTOTYPE NORMAL DISTRIBUTION USED HEREIN C HAS MEAN = 0 AND STANDARD DEVIATION = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = (1/SQRT(2*PI)) * EXP(-X*X/2). C AS USED HEREIN, A PROBABILITY PLOT FOR A DISTRIBUTION C IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS C THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION. C THE NORMAL PROBABILITY PLOT IS USEFUL IN C GRAPHICALLY TESTING THE COMPOSITE (THAT IS, C LOCATION AND SCALE PARAMETERS NEED NOT BE SPECIFIED) C HYPOTHESIS THAT THE UNDERLYING DISTRIBUTION C FROM WHICH THE DATA HAVE BEEN RANDOMLY DRAWN C IS THE NORMAL DISTRIBUTION. C IF THE HYPOTHESIS IS TRUE, THE PROBABILITY PLOT C SHOULD BE NEAR-LINEAR. C A MEASURE OF SUCH LINEARITY IS GIVEN BY THE C CALCULATED PROBABILITY PLOT CORRELATION COEFFICIENT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--A ONE-PAGE NORMAL PROBABILITY PLOT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, NORPPF, PLOT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, 'TECHNIQUES FOR TAIL LENGTH ANALYSIS', C PROCEEDINGS OF THE EIGHTEENTH CONFERENCE C ON THE DESIGN OF EXPERIMENTS IN ARMY RESEARCH C DEVELOPMENT AND TESTING (ABERDEEN, MARYLAND, C OCTOBER, 1972), PAGES 425-450. C --FILLIBEN, 'THE PROBABILITY PLOT CORRELATION COEFFICIENT C TEST FOR NORMALITY', TECHNOMETRICS, 1975, PAGES 111-117. C --RYAN AND JOINER, 'NORMAL PROBABILITY PLOTS AND TESTS C FOR NORMALITY' PENNSYLVANIA C STATE UNIVERSITY REPORT. C --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING, C 1967, PAGES 260-308. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 40-111. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(7500),W(7500) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501)) C DATA TAU/1.43218641/ C IPR=6 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE NORPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 NORPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE NORPLT SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C SORT THE DATA C CALL SORT(X,N,Y) C C GENERATE UNIFORM ORDER STATISTIC MEDIANS C CALL UNIMED(N,W) C C COMPUTE NORMAL ORDER STATISTIC MEDIANS C DO100I=1,N CALL NORPPF(W(I),W(I)) 100 CONTINUE C C PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS. C WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION C AND THE SAMPLE SIZE. C CALL PLOT(Y,W,N) WRITE(IPR,105)TAU,N C C COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. C COMPUTE LOCATION AND SCALE ESTIMATES C FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. C THEN WRITE THEM OUT. C SUM1=0.0 DO200I=1,N SUM1=SUM1+Y(I) 200 CONTINUE YBAR=SUM1/AN WBAR=0.0 SUM1=0.0 SUM2=0.0 SUM3=0.0 DO300I=1,N SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM2=SUM2+W(I)*Y(I) SUM3=SUM3+W(I)*W(I) 300 CONTINUE CC=SUM2/SQRT(SUM3*SUM1) YSLOPE=SUM2/SUM3 YINT=YBAR-YSLOPE*WBAR WRITE(IPR,305)CC,YINT,YSLOPE C 105 FORMAT(1H ,31HNORMAL PROBABILITY PLOT (TAU = ,E15.8,1H),56X,20HTHE 1 SAMPLE SIZE N = ,I7) 305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X, 122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) C RETURN END SUBROUTINE NORPPF(P,PPF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT NORPPF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE FOR THE NORMAL (GAUSSIAN) C DISTRIBUTION WITH MEAN = 0 AND STANDARD DEVIATION = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = (1/SQRT(2*PI))*EXP(-X*X/2). C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 AND 1.0) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT C FUNCTION VALUE PPF. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--P SHOULD BE BETWEEN 0.0 AND 1.0, EXCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--ODEH AND EVANS, THE PERCENTAGE POINTS C OF THE NORMAL DISTRIBUTION, ALGORTIHM 70, C APPLIED STATISTICS, 1974, PAGES 96-97. C --EVANS, ALGORITHMS FOR MINIMAL DEGREE C POLYNOMIAL AND RATIONAL APPROXIMATION, C M. SC. THESIS, 1972, UNIVERSITY C OF VICTORIA, B. C., CANADA. C --HASTINGS, APPROXIMATIONS FOR DIGITAL C COMPUTERS, 1955, PAGES 113, 191, 192. C --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 933, FORMULA 26.2.23. C --FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGES 21-44, 229-231. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 40-111. C --THE KELLEY STATISTICAL TABLES, 1948. C --OWEN, HANDBOOK OF STATISTICAL TABLES, C 1962, PAGES 3-16. C --PEARSON AND HARTLEY, BIOMETRIKA TABLES C FOR STATISTICIANS, VOLUME 1, 1954, C PAGES 104-113. C COMMENTS--THE CODING AS PRESENTED BELOW C IS ESSENTIALLY IDENTICAL TO THAT C PRESENTED BY ODEH AND EVANS C AS ALGORTIHM 70 OF APPLIED STATISTICS. C THE PRESENT AUTHOR HAS MODIFIED THE C ORIGINAL ODEH AND EVANS CODE WITH ONLY C MINOR STYLISTIC CHANGES. C --AS POINTED OUT BY ODEH AND EVANS C IN APPLIED STATISTICS, C THEIR ALGORITHM REPRESENTES A C SUBSTANTIAL IMPROVEMENT OVER THE C PREVIOUSLY EMPLOYED C HASTINGS APPROXIMATION FOR THE C NORMAL PERCENT POINT FUNCTION-- C THE ACCURACY OF APPROXIMATION C BEING IMPROVED FROM 4.5*(10**-4) C TO 1.5*(10**-8). C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --OCTOBER 1976. C C--------------------------------------------------------------------- C DATA P0,P1,P2,P3,P4 1/-.322232431088,-1.0, 1 -.342242088547,-.204231210245E-1, 1 -.453642210148E-4/ DATA Q0,Q1,Q2,Q3,Q4 1/.993484626060E-1,.588581570495, 1 .531103462366,.103537752850, 1 .38560700634E-2/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LE.0.0.OR.P.GE.1.0)GOTO50 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 NORPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C IF(P.NE.0.5)GOTO150 PPF=0.0 RETURN C 150 R=P IF(P.GT.0.5)R=1.0-R T=SQRT(-2.0*ALOG(R)) ANUM=((((T*P4+P3)*T+P2)*T+P1)*T+P0) ADEN=((((T*Q4+Q3)*T+Q2)*T+Q1)*T+Q0) PPF=T+(ANUM/ADEN) IF(P.LT.0.5)PPF=-PPF RETURN C END SUBROUTINE NORRAN(N,ISEED,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT NORRAN C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE THE NORMAL (GAUSSIAN) C DISTRIBUTION WITH MEAN = 0 AND STANDARD DEVIATION = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = (1/SQRT(2*PI))*EXP(-X*X/2). C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE NORMAL DISTRIBUTION C WITH MEAN = 0 AND STANDARD DEVIATION = 1. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG, SQRT, SIN, COS. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C METHOD--BOX-MULLER ALGORITHM. C REFERENCES--BOX AND MULLER, 'A NOTE ON THE GENERATION C OF RANDOM NORMAL DEVIATES', JOURNAL OF THE C ASSOCIATION FOR COMPUTING MACHINERY, 1958, C PAGES 610-611. C --TOCHER, THE ART OF SIMULATION, C 1963, PAGES 33-34. C --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS, C 1964, PAGE 39. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 40-111. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82.6 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --JULY 1976. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) DIMENSION Y(2) C C--------------------------------------------------------------------- C CCCCC CHARACTER*4 IFEEDB CCCCC CHARACTER*4 IPRINT C CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW CCCCC COMMON /PRINT/IFEEDB,IPRINT C IPR=6 C C-----DATA STATEMENTS------------------------------------------------- C DATA PI/3.14159265359/ C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 GOTO90 50 WRITE(IPR, 5) WRITE(IPR,47)N RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 NORRAN SUBROUTINE IS NON-POSITIVE *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C GENERATE N UNIFORM (0,1) RANDOM NUMBERS; C THEN GENERATE 2 ADDITIONAL UNIFORM (0,1) RANDOM NUMBERS C (TO BE USED BELOW IN FORMING THE N-TH NORMAL C RANDOM NUMBER WHEN THE DESIRED SAMPLE SIZE N C HAPPENS TO BE ODD). C CALL UNIRAN(N,ISEED,X) CALL UNIRAN(2,ISEED,Y) C C GENERATE N NORMAL RANDOM NUMBERS C USING THE BOX-MULLER METHOD. C DO200I=1,N,2 IP1=I+1 U1=X(I) IF(I.EQ.N)GOTO210 U2=X(IP1) GOTO220 210 U2=Y(2) 220 ARG1=-2.0*ALOG(U1) ARG2=2.0*PI*U2 SQRT1=SQRT(ARG1) Z1=SQRT1*COS(ARG2) Z2=SQRT1*SIN(ARG2) X(I)=Z1 IF(I.EQ.N)GOTO200 X(IP1)=Z2 200 CONTINUE C RETURN END SUBROUTINE NORSF(P,SF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT NORSF C C PURPOSE--THIS SUBROUTINE COMPUTES THE SPARSITY C FUNCTION VALUE FOR THE NORMAL (GAUSSIAN) C DISTRIBUTION WITH MEAN = 0 AND STANDARD DEVIATION = 1. C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = (1/SQRT(2*PI))*EXP(-X*X/2). C NOTE THAT THE SPARSITY FUNCTION OF A DISTRIBUTION C IS THE DERIVATIVE OF THE PERCENT POINT FUNCTION, C AND ALSO IS THE RECIPROCAL OF THE PROBABILITY C DENSITY FUNCTION (BUT IN UNITS OF P RATHER THAN X). C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 AND 1.0) C AT WHICH THE SPARSITY C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--SF = THE SINGLE PRECISION C SPARSITY FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION SPARSITY C FUNCTION VALUE SF. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--P SHOULD BE BETWEEN 0.0 AND 1.0, EXCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--NORPPF. C FORTRAN LIBRARY SUBROUTINES NEEDED--EXP. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGES 21-44, 229-231. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 40-111. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DATA C/.3989422804/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LE.0.0.OR.P.GE.1.0)GOTO50 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 NORSF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C CALL NORPPF(P,PPF) PDF=C*EXP(-(PPF*PPF)/2.0) SF=1.0/PDF C RETURN END SUBROUTINE PARCDF(X,GAMMA,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PARCDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR THE PARETO C DISTRIBUTION WITH SINGLE PRECISION C TAIL LENGTH PARAMETER = GAMMA. C THE PARETO DISTRIBUTION USED C HEREIN IS DEFINED FOR ALL X GREATER THAN C OR EQUAL TO 1, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = GAMMA / (X**(GAMMA+1)). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE C AT WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C X SHOULD BE GREATER THAN C OR EQUAL TO 1. C --GAMMA = THE SINGLE PRECISION VALUE C OF THE TAIL LENGTH PARAMETER. C GAMMA SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF FOR THE PARETO C DISTRIBUTION WITH TAIL LENGTH PARAMETER VALUE = GAMMA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--GAMMA SHOULD BE POSITIVE. C --X SHOULD BE GREATER THAN C OR EQUAL TO 1. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 233-249. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGE 102. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(X.LT.1.0)GOTO50 IF(GAMMA.LE.0.0)GOTO55 GOTO90 50 WRITE(IPR,4) WRITE(IPR,46)X CDF=0.0 RETURN 55 WRITE(IPR,15) WRITE(IPR,46)GAMMA CDF=0.0 RETURN 90 CONTINUE 4 FORMAT(1H ,101H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE PARCDF SUBROUTINE IS LESS THAN 1.0 *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 PARCDF SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C CDF=1.0-(X**(-GAMMA)) C RETURN END SUBROUTINE PARPLT(X,N,GAMMA) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PARPLT C C PURPOSE--THIS SUBROUTINE GENERATES A PARETO C PROBABILITY PLOT C (WITH TAIL LENGTH PARAMETER VALUE = GAMMA). C THE PROTOTYPE PARETO DISTRIBUTION USED C HEREIN IS DEFINED FOR ALL X EQUAL TO C OR GREATER THAN 1, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = GAMMA / (X**(GAMMA+1)). C AS USED HEREIN, A PROBABILITY PLOT FOR A DISTRIBUTION C IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS C THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION. C THE PARETO PROBABILITY PLOT IS USEFUL IN C GRAPHICALLY TESTING THE COMPOSITE (THAT IS, C LOCATION AND SCALE PARAMETERS NEED NOT BE SPECIFIED) C HYPOTHESIS THAT THE UNDERLYING DISTRIBUTION C FROM WHICH THE DATA HAVE BEEN RANDOMLY DRAWN C IS THE PARETO DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = GAMMA. C IF THE HYPOTHESIS IS TRUE, THE PROBABILITY PLOT C SHOULD BE NEAR-LINEAR. C A MEASURE OF SUCH LINEARITY IS GIVEN BY THE C CALCULATED PROBABILITY PLOT CORRELATION COEFFICIENT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --GAMMA = THE SINGLE PRECISION VALUE OF THE C TAIL LENGTH PARAMETER. C GAMMA SHOULD BE POSITIVE. C OUTPUT--A ONE-PAGE PARETO PROBABILITY PLOT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C --GAMMA SHOULD BE POSITIVE. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, PLOT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, 'TECHNIQUES FOR TAIL LENGTH ANALYSIS', C PROCEEDINGS OF THE EIGHTEENTH CONFERENCE C ON THE DESIGN OF EXPERIMENTS IN ARMY RESEARCH C DEVELOPMENT AND TESTING (ABERDEEN, MARYLAND, C OCTOBER, 1972), PAGES 425-450. C --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING, C 1967, PAGES 260-308. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 233-249. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(7500),W(7500) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501)) C IPR=6 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 IF(GAMMA.LE.0.0)GOTO60 HOLD=X(1) DO65I=2,N IF(X(I).NE.HOLD)GOTO90 65 CONTINUE WRITE(IPR, 9)HOLD RETURN 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 60 WRITE(IPR,25) WRITE(IPR,46)GAMMA RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE PARPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 PARPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE PARPLT SUBROUTINE HAS THE VALUE 1 *****) 25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 PARPLT SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C SORT THE DATA C CALL SORT(X,N,Y) C C GENERATE UNIFORM ORDER STATISTIC MEDIANS C CALL UNIMED(N,W) C C COMPUTE PARETO DISTRIBUTION ORDER STATISTIC MEDIANS C DO100I=1,N W(I)=(1.0-W(I))**(-1.0/GAMMA) 100 CONTINUE C C PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS. C COMPUTE THE TAIL LENGTH MEASURE OF THE DISTRIBUTION. C WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION C AND THE SAMPLE SIZE. C CALL PLOT(Y,W,N) Q=.9975 PP9975=(1.0-Q)**(-1.0/GAMMA) Q=.0025 PP0025=(1.0-Q)**(-1.0/GAMMA) Q=.975 PP975 =(1.0-Q)**(-1.0/GAMMA) Q=.025 PP025 =(1.0-Q)**(-1.0/GAMMA) TAU=(PP9975-PP0025)/(PP975-PP025) WRITE(IPR,105)GAMMA,TAU,N C C COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. C COMPUTE LOCATION AND SCALE ESTIMATES C FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. C THEN WRITE THEM OUT. C SUM1=0.0 SUM2=0.0 DO200I=1,N SUM1=SUM1+Y(I) SUM2=SUM2+W(I) 200 CONTINUE YBAR=SUM1/AN WBAR=SUM2/AN SUM1=0.0 SUM2=0.0 SUM3=0.0 DO300I=1,N SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 300 CONTINUE CC=SUM2/SQRT(SUM3*SUM1) YSLOPE=SUM2/SUM3 YINT=YBAR-YSLOPE*WBAR WRITE(IPR,305)CC,YINT,YSLOPE C 105 FORMAT(1H ,50HPARETO PROBABILITY PLOT WITH EXPONENT PARAMETER = , 1E17.10,1X,7H(TAU = ,E15.8,1H),11X,20HTHE SAMPLE SIZE N = ,I7) 305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X, 122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) C RETURN END SUBROUTINE PARPPF(P,GAMMA,PPF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PARPPF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE FOR THE PARETO C DISTRIBUTION WITH SINGLE PRECISION C TAIL LENGTH PARAMETER = GAMMA. C THE PARETO DISTRIBUTION USED C HEREIN IS DEFINED FOR ALL X GREATER THAN C OR EQUAL TO 1, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = GAMMA / (X**(GAMMA+1)). C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 (INCLUSIVELY) C AND 1.0 (EXCLUSIVELY)) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C --GAMMA = THE SINGLE PRECISION VALUE C OF THE TAIL LENGTH PARAMETER. C GAMMA SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT FUNCTION . C VALUE PPF FOR THE PARETO DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = GAMMA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--GAMMA SHOULD BE POSITIVE. C --P SHOULD BE BETWEEN 0.0 (INCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 233-249. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGE 102. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LT.0.0.OR.P.GE.1.0)GOTO50 IF(GAMMA.LE.0.0)GOTO55 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P PPF=0.0 RETURN 55 WRITE(IPR,15) WRITE(IPR,46)GAMMA PPF=0.0 RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 PARPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 PARPPF SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C PPF=(1.0-P)**(-1.0/GAMMA) C RETURN END SUBROUTINE PARRAN(N,GAMMA,ISEED,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PARRAN C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE PARETO DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = GAMMA. C THE PROTOTYPE PARETO DISTRIBUTION USED C HEREIN IS DEFINED FOR ALL X GREATER THAN C OR EQUAL TO 1, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = GAMMA / (X**(GAMMA+1)). C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C --GAMMA = THE SINGLE PRECISION VALUE OF THE C TAIL LENGTH PARAMETER. C GAMMA SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE PARETO DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = GAMMA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C --GAMMA SHOULD BE POSITIVE. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--TOCHER, THE ART OF SIMULATION, C 1963, PAGES 14-15. C --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS, C 1964, PAGE 36. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 233-249. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGE 104. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82.6 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) C C--------------------------------------------------------------------- C CCCCC CHARACTER*4 IFEEDB CCCCC CHARACTER*4 IPRINT C CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW CCCCC COMMON /PRINT/IFEEDB,IPRINT C IPR=6 C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(GAMMA.LE.0.0)GOTO60 GOTO90 50 WRITE(IPR, 5) WRITE(IPR,47)N RETURN 60 WRITE(IPR,15) WRITE(IPR,46)GAMMA RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 PARRAN SUBROUTINE IS NON-POSITIVE *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 PARRAN SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C GENERATE N UNIFORM (0,1) RANDOM NUMBERS; C CALL UNIRAN(N,ISEED,X) C C GENERATE N PARETO DISTRIBUTION RANDOM NUMBERS C USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD. C DO100I=1,N X(I)=(1.0-X(I))**(-1.0/GAMMA) 100 CONTINUE C RETURN END SUBROUTINE PLOT(Y,X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PLOT C C PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT C OF Y(I) VERSUS X(I). C INPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED VERTICALLY. C --X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED HORIZONTALLY. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR Y. C OUTPUT--A ONE-PAGE PRINTER PLOT OF Y(I) VERSUS X(I). C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (Y) C OR THE HORIZONTAL AXIS VECTOR (X) WHICH ARE C EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE C PLOTTED. C THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM C OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y C (OR X) ARE 'MISSING DATA', OR WHEN WE PURPOSELY C WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y C (OR X) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT C WANT CERTAIN ELEMENTS IN Y (OR X) TO BE PLOTTED). C TO CAUSE SPECIFIC ELEMENTS IN Y (OR X) TO BE C IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND C (BY, FOR EXAMPLE, USE OF THE REPLAC SUBROUTINE) C BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND C THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOT C SUBROUTINE. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --OCTOBER 1974. C UPDATED --NOVEMBER 1974. C UPDATED --JANUARY 1975. C UPDATED --JULY 1975. C UPDATED --SEPTEMBER 1975. C UPDATED --OCTOBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C UPDATED --FEBRUARY 1977. C C--------------------------------------------------------------------- C CHARACTER*4 IGRAPH CHARACTER*4 SBNAM1,SBNAM2 CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL DIMENSION Y(1) DIMENSION X(1) DIMENSION YLABLE(11) COMMON /BLOCK1/ IGRAPH(55,130) C DATA SBNAM1,SBNAM2/'PLOT',' '/ DATA ALPH11,ALPH12/'FIRS','T '/ DATA ALPH21,ALPH22/'SECO','ND '/ DATA ALPH31,ALPH32/'THIR','D '/ DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/ DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/ C IPR=6 CUTOFF=(10.0**10)-1000.0 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C WRITE(IPR,998) IF(N.LT.1)GOTO52 GOTO54 52 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,20)N WRITE(IPR,5) RETURN 54 CONTINUE IF(N.EQ.1)GOTO56 GOTO58 56 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,22)N WRITE(IPR,5) RETURN 58 CONTINUE C HOLD=Y(1) DO60I=2,N IF(Y(I).NE.HOLD)GOTO62 60 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 62 CONTINUE HOLD=X(1) DO64I=2,N IF(X(I).NE.HOLD)GOTO66 64 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 66 CONTINUE C DO76I=1,N IF(Y(I).LT.CUTOFF)GOTO78 76 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 78 CONTINUE DO80I=1,N IF(X(I).LT.CUTOFF)GOTO82 80 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 82 CONTINUE C N2=0 DO96I=1,N IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF)GOTO98 GOTO96 98 N2=N2+1 IF(N2.GE.2)GOTO99 96 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22 WRITE(IPR,19)SBNAM1,SBNAM2 WRITE(IPR,40) WRITE(IPR,41)N2 WRITE(IPR,5) RETURN 99 CONTINUE C 5 FORMAT(1H ,'**************************************************', 1'********************') 10 FORMAT(1H ,' FATAL ERROR ') 15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4, 1' SUBROUTINE') 18 FORMAT(1H ,'THE ',A4,A4,', AND ',A4,A4) 19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE') 20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,1H)) 22 FORMAT(1H ,'HAS THE VALUE 1') 30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8) 32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF') 33 FORMAT(1H ,'VALUE OF ',E15.8) 40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 1' EXCLUDED FROM THE PLOT.') 41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.') C C-----START POINT----------------------------------------------------- C C DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS C DO200I=1,N IF(Y(I).GE.CUTOFF)GOTO200 IF(X(I).GE.CUTOFF)GOTO200 YMIN=Y(I) YMAX=Y(I) GOTO250 200 CONTINUE 250 DO300I=1,N IF(Y(I).GE.CUTOFF)GOTO300 IF(X(I).GE.CUTOFF)GOTO300 IF(Y(I).LT.YMIN)YMIN=Y(I) IF(Y(I).GT.YMAX)YMAX=Y(I) 300 CONTINUE DO400I=1,9 AIM1=I-1 YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN) 400 CONTINUE C C DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS C DETERMINE XMIN, XMAX, XMID, X25 (=THE 25% POINT), AND C X75 (=THE 75% POINT) C DO600I=1,N IF(Y(I).GE.CUTOFF)GOTO600 IF(X(I).GE.CUTOFF)GOTO600 XMIN=X(I) XMAX=X(I) GOTO650 600 CONTINUE 650 DO700I=1,N IF(Y(I).GE.CUTOFF)GOTO700 IF(X(I).GE.CUTOFF)GOTO700 IF(X(I).LT.XMIN)XMIN=X(I) IF(X(I).GT.XMAX)XMAX=X(I) 700 CONTINUE XMID=(XMIN+XMAX)/2.0 X25=0.75*XMIN+0.25*XMAX X75=0.25*XMIN+0.75*XMAX C C BLANK OUT THE GRAPH C DO1100I=1,45 DO1200J=1,109 IGRAPH(I,J)=BLANK 1200 CONTINUE 1100 CONTINUE C C PRODUCE THE VERTICAL AXES C DO1300I=3,43 IGRAPH(I,5)=ALPHAI IGRAPH(I,109)=ALPHAI 1300 CONTINUE DO1400I=3,43,5 IGRAPH(I,5)=HYPHEN IGRAPH(I,109)=HYPHEN 1400 CONTINUE IGRAPH(3,1)=EQUAL IGRAPH(3,2)=ALPHAM IGRAPH(3,3)=ALPHAA IGRAPH(3,4)=ALPHAX IGRAPH(23,1)=EQUAL IGRAPH(23,2)=ALPHAM IGRAPH(23,3)=ALPHAI IGRAPH(23,4)=ALPHAD IGRAPH(43,1)=EQUAL IGRAPH(43,2)=ALPHAM IGRAPH(43,3)=ALPHAI IGRAPH(43,4)=ALPHAN C C PRODUCE THE HORIZONTAL AXES C DO1500J=7,107 IGRAPH(1,J)=HYPHEN IGRAPH(45,J)=HYPHEN 1500 CONTINUE DO1600J=7,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1600 CONTINUE DO1700J=20,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1700 CONTINUE C C DETERMINE THE (X,Y) PLOT POSITIONS C RATIOY=40.0/(YMAX-YMIN) RATIOX=100.0/(XMAX-XMIN) DO1800I=1,N IF(Y(I).GE.CUTOFF)GOTO1800 IF(X(I).GE.CUTOFF)GOTO1800 MX=RATIOX*(X(I)-XMIN)+0.5 MX=MX+7 MY=RATIOY*(Y(I)-YMIN)+0.5 MY=43-MY IGRAPH(MY,MX)=ALPHAX 1800 CONTINUE C C WRITE OUT THE GRAPH C DO2100I=1,45 IP2=I+2 IFLAG=IP2-(IP2/5)*5 K=IP2/5 IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109) IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109) 2100 CONTINUE WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX C 2105 FORMAT(1H ,20X,109A1) 2106 FORMAT(1H ,F20.7,109A1) 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7) 998 FORMAT(1H1) C RETURN END SUBROUTINE PLOT10(Y,X,CHAR,N,YMIN,YMAX,XMIN,XMAX, CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. 1 D,DMIN,DMAX,YAXID,XAXID,PLCHID) DLL_EXPORT PLOT10 C C PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT C OF Y(I) VERSUS X(I): C 1) WITH SPECIAL PLOT CHARACTERS; C 2) WITH THE VERTICAL (Y) AXIS MIN AND MAX C AND THE HORIZONTAL (X) AXIS MIN AND MAX C VALUES SPECIFIED BY THE DATA ANALYST; C 3) WITH ONLY THOSE POINTS (X(I),Y(I)) PLOTTED C FOR WHICH THE CORRESPONDING VALUE OF D(I) C IS BETWEEN THE SPECIFIED VALUES OF DMIN AND DMAX; AND C 3) WITH HOLLARITH LABELS (AT MOST 6 CHARACTERS) C FOR THE VERTICAL AXIS VARIABLE, C THE HORIZONTAL AXIS VARIABLE, AND C THE PLOTTING CHARACTER VARIABLE C ALSO BEING PROVIDED BY THE DATA ANALYST. C C THE 'SPECIAL PLOTTING CHARACTER' CAPABILITY C ALLOWS THE DATA ANALYST TO INCORPORATE INFORMATION C FROM A THIRD VARIABLE (ASIDE FROM Y AND X) INTO C THE PLOT. C THE PLOT CHARACTER USED AT THE I-TH PLOTTING C POSITION (THAT IS, AT THE COORDINATE (X(I),Y(I))) C WILL BE C 1 IF CHAR(I) IS BETWEEN 0.5 AND 1.5 C 2 IF CHAR(I) IS BETWEEN 1.5 AND 2.5 C . C . C . C 9 IF CHAR(I) IS BETWEEN 8.5 AND 9.5 C 0 IF CHAR(I) IS BETWEEN 9.5 AND 10.5 C A IF CHAR(I) IS BETWEEN 10.5 AND 11.5 C B IF CHAR(I) IS BETWEEN 11.5 AND 12.5 C C IF CHAR(I) IS BETWEEN 12.5 AND 13.5 C . C . C . C W IF CHAR(I) IS BETWEEN 32.5 AND 33.5 C X IF CHAR(I) IS BETWEEN 33.5 AND 34.5 C Y IF CHAR(I) IS BETWEEN 34.5 AND 35.5 C Z IF CHAR(I) IS BETWEEN 35.5 AND 36.5 C X IF CHAR(I) IS ANY VALUE OUTSIDE THE RANGE C 0.5 TO 36.5. C C THE USE OF THE YMIN, YMAX, XMIN, AND XMAX C SPECIFICATIONS ALLOWS THE DATA ANALYST C TO CONTROL FULLY THE PLOT AXIS LIMITS, C SO AS, FOR EXAMPLE, TO ZERO-IN ON AN C INTERESTING SUB-REGION OF A PREVIOUS PLOT. C C THE USE OF THE SUBSET DEFINTION VECTOR D C GIVES THE DATA ANALYST THE CAPABILITY OF C PLOTTING SUBSETS OF THE DATA, C WHERE THE SUBSET IS DEFINED C BY VALUES IN THE VECTOR D. C C THE USE OF HOLLARITH IDENTIFYING LABELS C ALLOWS THE DATA ANALYST TO AUTOMATICALLY C HAVE THE PLOTS LABELED. THIS IS PARTICULARLY C USEFUL IN A LARGE ANALYSIS WHEN MANY C PLOTS ARE BEING GENERATED. C C INPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED VERTICALLY. C --X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED HORIZONTALLY. C --CHAR = THE SINGLE PRECISION VECTOR OF C OBSERVATIONS WHICH CONTROL THE C VALUE OF EACH INDIVIDUAL PLOT C CHARACTER. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR Y. C --YMIN = THE SINGLE PRECISION VALUE OF C DESIRED MINIMUM FOR THE VERTICAL AXIS. C --YMAX = THE SINGLE PRECISION VALUE OF C DESIRED MAXIMUM FOR THE VERTICAL AXIS. C --XMIN = THE SINGLE PRECISION VALUE OF C DESIRED MINIMUM FOR THE HORIZONTAL AXIS. C --XMAX = THE SINGLE PRECISION VALUE OF C DESIRED MAXIMUM FOR THE HORIZONTAL AXIS. C --D = THE SINGLE PRECISION VECTOR C WHICH 'DEFINES' THE VARIOUS C POSSIBLE SUBSETS. C --DMIN = THE SINGLE PRECISION VALUE C WHICH DEFINES THE LOWER BOUND C (INCLUSIVELY) OF THE PARTICULAR C SUBSET OF INTEREST TO BE PLOTTED. C --DMAX = THE SINGLE PRECISION VALUE C WHICH DEFINES THE UPPER BOUND C (INCLUSIVELY) OF THE PARTICULAR C SUBSET OF INTEREST TO BE PLOTTED. C --YAXID = THE HOLLARITH VALUE C (AT MOST 6 CHARACTERS) C OF THE DESIRED LABEL FOR THE C VERTICAL AXIS VARIABLE. C --XAXID = THE HOLLARITH VALUE C (AT MOST 6 CHARACTERS) C OF THE DESIRED LABEL FOR THE C HORIZONTAL AXIS VARIABLE. C --PLCHID = THE HOLLARITH VALUE C (AT MOST 6 CHARACTERS) C OF THE DESIRED LABEL FOR THE C PLOTTING CHARACTER VARIABLE. C OUTPUT--A ONE-PAGE PRINTER PLOT OF Y(I) VERSUS X(I), C WITH SPECIAL PLOT CHARACTERS, C WITH SPECIFIED AXIS LIMITS, C FOR ONLY OF A SPECIFIED SUBSET OF THE DATA, AND C WITH SPECIFIED LABELS. C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (Y) C WHICH ARE SMALLER THAN YMIN OR LARGER THAN YMAX, C OR VALUES IN THE HORIZONTAL AXIS VECTOR (X) C WHICH ARE SMALLER THAN XMIN OR LARGER THAN XMAX C WILL NOT BE PLOTTED. C --FOR A GIVEN DUMMY INDEX I, C IF D(I) IS SMALLER THAN DMIN OR LARGER THAN DMAX, C THEN THE CORRESPONDING POINT (X(I),Y(I)) C WILL NOT BE PLOTTED. C --VALUES IN THE VERTICAL AXIS VECTOR (Y), C THE HORIZONTAL AXIS VECTOR (X), C OR THE PLOT CHARACTER VECTOR (CHAR) WHICH ARE C EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE C PLOTTED. C THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM C OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y C (OR X, OR CHAR) ARE 'MISSING DATA', OR WHEN WE PURPOSELY C WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y C (OR X, OR CHAR) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT C WANT CERTAIN ELEMENTS IN Y (OR X, OR CHAR) TO BE C PLOTTED). C TO CAUSE SPECIFIC ELEMENTS IN Y (OR X, OR CHAR) TO BE C IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND C (BY, FOR EXAMPLE, USE OF THE REPLAC SUBROUTINE) C BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND C THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTC C SUBROUTINE. C REFERENCES--FILLIBEN, 'STATISTICAL ANALYSIS OF INTERLAB C FATIGUE TIME DATA', UNPUBLISHED MANUSCRIPT C (AVAILABLE FROM AUTHOR) C PRESENTED AT THE 'COMPUTER-ASSISTED DATA C ANALYSIS' SESSION AT THE NATIONAL MEETING C OF THE AMERICAN STATISTICAL ASSOCIATION, C NEW YORK CITY, DECEMBER 27-30, 1973. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--JANUARY 1974. C UPDATED --OCTOBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C UPDATED --FEBRUARY 1977. C UPDATED --JUNE 1977. C C--------------------------------------------------------------------- C CHARACTER*4 IGRAPH CHARACTER*4 IPLOTC CHARACTER*4 SBNAM1,SBNAM2 CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 CHARACTER*4 ALPH41,ALPH42,ALPH91,ALPH92 CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL C DIMENSION Y(1) DIMENSION X(1) DIMENSION D(1) DIMENSION CHAR(1) DIMENSION YLABLE(11) DIMENSION IPLOTC(37) COMMON /BLOCK1/ IGRAPH(55,130) C DATA SBNAM1,SBNAM2/'PLOT','10 '/ DATA ALPH11,ALPH12/'FIRS','T '/ DATA ALPH21,ALPH22/'SECO','ND '/ DATA ALPH31,ALPH32/'THIR','D '/ DATA ALPH41,ALPH42/'FOUR','TH '/ DATA ALPH91,ALPH92/'FIFT','H '/ DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/ DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/ DATA IPLOTC(1),IPLOTC(2),IPLOTC(3),IPLOTC(4),IPLOTC(5), 1IPLOTC(6),IPLOTC(7),IPLOTC(8),IPLOTC(9),IPLOTC(10), 1IPLOTC(11),IPLOTC(12),IPLOTC(13),IPLOTC(14),IPLOTC(15), 1IPLOTC(16),IPLOTC(17),IPLOTC(18),IPLOTC(19),IPLOTC(20), 1IPLOTC(21),IPLOTC(22),IPLOTC(23),IPLOTC(24),IPLOTC(25), 1IPLOTC(26),IPLOTC(27),IPLOTC(28),IPLOTC(29),IPLOTC(30), 1IPLOTC(31),IPLOTC(32),IPLOTC(33),IPLOTC(34),IPLOTC(35), 1IPLOTC(36),IPLOTC(37) 1/'1','2','3','4','5','6','7','8','9','0','A','B','C','D','E','F', 1'G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V', 1'W','X','Y','Z','X'/ C IPR=6 CUTOFF=(10.0**10)-1000.0 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C WRITE(IPR,998) IF(N.LT.1)GOTO52 GOTO54 52 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,20)N WRITE(IPR,5) RETURN 54 CONTINUE IF(N.EQ.1)GOTO56 GOTO58 56 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,22)N WRITE(IPR,5) RETURN 58 CONTINUE C HOLD=Y(1) DO60I=2,N IF(Y(I).NE.HOLD)GOTO62 60 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 62 CONTINUE HOLD=X(1) DO64I=2,N IF(X(I).NE.HOLD)GOTO66 64 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 66 CONTINUE HOLD=CHAR(1) DO68I=2,N IF(CHAR(I).NE.HOLD)GOTO70 68 CONTINUE WRITE(IPR,5) WRITE(IPR,11) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) 70 CONTINUE HOLD=D(1) DO72I=2,N IF(D(I).NE.HOLD)GOTO74 72 CONTINUE WRITE(IPR,5) WRITE(IPR,11) WRITE(IPR,15)ALPH91,ALPH92,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) 74 CONTINUE C DO76I=1,N IF(Y(I).LT.CUTOFF)GOTO78 76 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 78 CONTINUE DO80I=1,N IF(X(I).LT.CUTOFF)GOTO82 80 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 82 CONTINUE DO84I=1,N IF(CHAR(I).LT.CUTOFF)GOTO86 84 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 86 CONTINUE DO88I=1,N IF(D(I).LT.CUTOFF)GOTO90 88 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH91,ALPH92,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 90 CONTINUE C DO92I=1,N IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)GOTO94 92 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH91,ALPH92,SBNAM1,SBNAM2 WRITE(IPR,34) WRITE(IPR,35)DMIN,DMAX WRITE(IPR,36) WRITE(IPR,5) RETURN 94 CONTINUE C N2=0 DO96I=1,N IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF.AND.CHAR(I).LT.CUTOFF.AND. 1D(I).LT.CUTOFF)GOTO98 GOTO96 98 IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)N2=N2+1 IF(N2.GE.2)GOTO99 96 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32, 1ALPH91,ALPH92 WRITE(IPR,19)SBNAM1,SBNAM2 WRITE(IPR,40) WRITE(IPR,41)N2 WRITE(IPR,5) RETURN 99 CONTINUE C 5 FORMAT(1H ,'**************************************************', 1'********************') 10 FORMAT(1H ,' FATAL ERROR ') 11 FORMAT(1H ,' NON-FATAL DIAGNOSTIC ') 15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4, 1' SUBROUTINE') 18 FORMAT(1H ,'THE ',A4,A4,', ',A4,A4,', ',A4,A4,', AND ',A4,A4) 19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE') 20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,')') 22 FORMAT(1H ,'HAS THE VALUE 1') 30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8) 32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF') 33 FORMAT(1H ,'VALUE OF ',E15.8) 34 FORMAT(1H ,'HAS ALL ELEMENTS OUTSIDE THE INTERVAL') 35 FORMAT(1H ,'(',E15.8,',',E15.8,')',' AS DEFINED BY') 36 FORMAT(1H ,'THE TENTH AND ELEVENTH INPUT ARGUMENTS.') 40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 1' EXCLUDED FROM THE PLOT.') 41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.') C C-----START POINT----------------------------------------------------- C C DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS C DO400I=1,9 AIM1=I-1 YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN) 400 CONTINUE C C DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS C DETERMINE XMID, X25 (=THE 25% POINT), AND C X75 (=THE 75% POINT) C XMID=(XMIN+XMAX)/2.0 X25=0.75*XMIN+0.25*XMAX X75=0.25*XMIN+0.75*XMAX C C BLANK OUT THE GRAPH C DO1100I=1,45 DO1200J=1,109 IGRAPH(I,J)=BLANK 1200 CONTINUE 1100 CONTINUE C C PRODUCE THE VERTICAL AXES C DO1300I=3,43 IGRAPH(I,5)=ALPHAI IGRAPH(I,109)=ALPHAI 1300 CONTINUE DO1400I=3,43,5 IGRAPH(I,5)=HYPHEN IGRAPH(I,109)=HYPHEN 1400 CONTINUE IGRAPH(3,1)=EQUAL IGRAPH(3,2)=ALPHAM IGRAPH(3,3)=ALPHAA IGRAPH(3,4)=ALPHAX IGRAPH(23,1)=EQUAL IGRAPH(23,2)=ALPHAM IGRAPH(23,3)=ALPHAI IGRAPH(23,4)=ALPHAD IGRAPH(43,1)=EQUAL IGRAPH(43,2)=ALPHAM IGRAPH(43,3)=ALPHAI IGRAPH(43,4)=ALPHAN C C PRODUCE THE HORIZONTAL AXES C DO1500J=7,107 IGRAPH(1,J)=HYPHEN IGRAPH(45,J)=HYPHEN 1500 CONTINUE DO1600J=7,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1600 CONTINUE DO1700J=20,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1700 CONTINUE C C DETERMINE THE (X,Y) PLOT POSITIONS C RATIOY=40.0/(YMAX-YMIN) RATIOX=100.0/(XMAX-XMIN) DO1800I=1,N IF(Y(I).GE.CUTOFF)GOTO1800 IF(X(I).GE.CUTOFF)GOTO1800 IF(CHAR(I).GE.CUTOFF)GOTO1800 IF(Y(I).LT.YMIN.OR.Y(I).GT.YMAX)GOTO1800 IF(X(I).LT.XMIN.OR.X(I).GT.XMAX)GOTO1800 IF(D(I).LT.DMIN)GOTO1800 IF(D(I).GT.DMAX)GOTO1800 MX=RATIOX*(X(I)-XMIN)+0.5 MX=MX+7 MY=RATIOY*(Y(I)-YMIN)+0.5 MY=43-MY IARG=37 IF(0.5.LT.CHAR(I).AND.CHAR(I).LT.36.5)IARG=CHAR(I)+0.5 IGRAPH(MY,MX)=IPLOTC(IARG) 1800 CONTINUE C C WRITE OUT THE GRAPH C DO2100I=1,45 IP2=I+2 IFLAG=IP2-(IP2/5)*5 K=IP2/5 IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109) IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109) 2100 CONTINUE WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX WRITE(IPR,2115)YAXID,XAXID,PLCHID WRITE(IPR,2116)N C 2105 FORMAT(1H ,20X,109A1) 2106 FORMAT(1H ,F20.7,109A1) 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7) 2115 FORMAT(1H ,9X,A4,A4,' (VERTICAL AXIS) VERSUS ',A4,A4, 1' (HORIZONTAL AXIS) ',20X,'THE PLOTTING CHARACTER IS ',A4,A4) 2116 FORMAT(1H ,83X,'THE NUMBER OF OBSERVATIONS PLOTTED IS ',I8) 998 FORMAT(1H1) C RETURN END SUBROUTINE PLOT6(Y,X,N,YMIN,YMAX,XMIN,XMAX) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PLOT6 C C PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT C OF Y(I) VERSUS X(I): C 1) WITH THE VERTICAL (Y) AXIS MIN AND MAX C AND THE HORIZONTAL (X) AXIS MIN AND MAX C VALUES SPECIFIED BY THE DATA ANALYST. C C THE USE OF THE YMIN, YMAX, XMIN, AND XMAX C SPECIFICATIONS ALLOWS THE DATA ANALYST C TO CONTROL FULLY THE PLOT AXIS LIMITS, C SO AS, FOR EXAMPLE, TO ZERO-IN ON AN C INTERESTING SUB-REGION OF A PREVIOUS PLOT. C C INPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED VERTICALLY. C --X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED HORIZONTALLY. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR Y. C --YMIN = THE SINGLE PRECISION VALUE OF C DESIRED MINIMUM FOR THE VERTICAL AXIS. C --YMAX = THE SINGLE PRECISION VALUE OF C DESIRED MAXIMUM FOR THE VERTICAL AXIS. C --XMIN = THE SINGLE PRECISION VALUE OF C DESIRED MINIMUM FOR THE HORIZONTAL AXIS. C --XMAX = THE SINGLE PRECISION VALUE OF C DESIRED MAXIMUM FOR THE HORIZONTAL AXIS. C OUTPUT--A ONE-PAGE PRINTER PLOT OF Y(I) VERSUS X(I), C WITH SPECIFIED AXIS LIMITS. C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (Y) C WHICH ARE SMALLER THAN YMIN OR LARGER THAN YMAX, C OR VALUES IN THE HORIZONTAL AXIS VECTOR (X) C WHICH ARE SMALLER THAN XMIN OR LARGER THAN XMAX C WILL NOT BE PLOTTED. C --VALUES IN THE VERTICAL AXIS VECTOR (Y) C OR THE HORIZONTAL AXIS VECTOR (X) WHICH ARE C EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE C PLOTTED. C THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM C OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y C (OR X) ARE 'MISSING DATA', OR WHEN WE PURPOSELY C WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y C (OR X) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT C WANT CERTAIN ELEMENTS IN Y (OR X) TO BE PLOTTED). C TO CAUSE SPECIFIC ELEMENTS IN Y (OR X) TO BE C IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND C (BY, FOR EXAMPLE, USE OF THE REPLAC SUBROUTINE) C BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND C THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOT C SUBROUTINE. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --OCTOBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C UPDATED --FEBRUARY 1977. C UPDATED --JUNE 1977. C C--------------------------------------------------------------------- C CHARACTER*4 IGRAPH CHARACTER*4 SBNAM1,SBNAM2 CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL C DIMENSION Y(1) DIMENSION X(1) DIMENSION YLABLE(11) COMMON /BLOCK1/ IGRAPH(55,130) C DATA SBNAM1,SBNAM2/'PLOT','6 '/ DATA ALPH11,ALPH12/'FIRS','T '/ DATA ALPH21,ALPH22/'SECO','ND '/ DATA ALPH31,ALPH32/'THIR','D '/ DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/ DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/ C IPR=6 CUTOFF=(10.0**10)-1000.0 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C WRITE(IPR,998) IF(N.LT.1)GOTO52 GOTO54 52 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,20)N WRITE(IPR,5) RETURN 54 CONTINUE IF(N.EQ.1)GOTO56 GOTO58 56 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,22)N WRITE(IPR,5) RETURN 58 CONTINUE C HOLD=Y(1) DO60I=2,N IF(Y(I).NE.HOLD)GOTO62 60 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 62 CONTINUE HOLD=X(1) DO64I=2,N IF(X(I).NE.HOLD)GOTO66 64 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 66 CONTINUE C DO76I=1,N IF(Y(I).LT.CUTOFF)GOTO78 76 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 78 CONTINUE DO80I=1,N IF(X(I).LT.CUTOFF)GOTO82 80 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 82 CONTINUE C N2=0 DO96I=1,N IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF)GOTO98 GOTO96 98 N2=N2+1 IF(N2.GE.2)GOTO99 96 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22 WRITE(IPR,19)SBNAM1,SBNAM2 WRITE(IPR,40) WRITE(IPR,41)N2 WRITE(IPR,5) RETURN 99 CONTINUE C 5 FORMAT(1H ,'**************************************************', 1'********************') 10 FORMAT(1H ,' FATAL ERROR ') 15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4, 1' SUBROUTINE') 18 FORMAT(1H ,'THE ',A4,A4,', AND ',A4,A4) 19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE') 20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,1H)) 22 FORMAT(1H ,'HAS THE VALUE 1') 30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8) 32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF') 33 FORMAT(1H ,'VALUE OF ',E15.8) 40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 1' EXCLUDED FROM THE PLOT.') 41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.') C C-----START POINT----------------------------------------------------- C C DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS C DO400I=1,9 AIM1=I-1 YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN) 400 CONTINUE C C DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS C DETERMINE XMID, X25 (=THE 25% POINT), AND C X75 (=THE 75% POINT) C XMID=(XMIN+XMAX)/2.0 X25=0.75*XMIN+0.25*XMAX X75=0.25*XMIN+0.75*XMAX C C BLANK OUT THE GRAPH C DO1100I=1,45 DO1200J=1,109 IGRAPH(I,J)=BLANK 1200 CONTINUE 1100 CONTINUE C C PRODUCE THE VERTICAL AXES C DO1300I=3,43 IGRAPH(I,5)=ALPHAI IGRAPH(I,109)=ALPHAI 1300 CONTINUE DO1400I=3,43,5 IGRAPH(I,5)=HYPHEN IGRAPH(I,109)=HYPHEN 1400 CONTINUE IGRAPH(3,1)=EQUAL IGRAPH(3,2)=ALPHAM IGRAPH(3,3)=ALPHAA IGRAPH(3,4)=ALPHAX IGRAPH(23,1)=EQUAL IGRAPH(23,2)=ALPHAM IGRAPH(23,3)=ALPHAI IGRAPH(23,4)=ALPHAD IGRAPH(43,1)=EQUAL IGRAPH(43,2)=ALPHAM IGRAPH(43,3)=ALPHAI IGRAPH(43,4)=ALPHAN C C PRODUCE THE HORIZONTAL AXES C DO1500J=7,107 IGRAPH(1,J)=HYPHEN IGRAPH(45,J)=HYPHEN 1500 CONTINUE DO1600J=7,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1600 CONTINUE DO1700J=20,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1700 CONTINUE C C DETERMINE THE (X,Y) PLOT POSITIONS C RATIOY=40.0/(YMAX-YMIN) RATIOX=100.0/(XMAX-XMIN) DO1800I=1,N IF(Y(I).GE.CUTOFF)GOTO1800 IF(X(I).GE.CUTOFF)GOTO1800 IF(Y(I).LT.YMIN.OR.Y(I).GT.YMAX)GOTO1800 IF(X(I).LT.XMIN.OR.X(I).GT.XMAX)GOTO1800 MX=RATIOX*(X(I)-XMIN)+0.5 MX=MX+7 MY=RATIOY*(Y(I)-YMIN)+0.5 MY=43-MY IGRAPH(MY,MX)=ALPHAX 1800 CONTINUE C C WRITE OUT THE GRAPH C DO2100I=1,45 IP2=I+2 IFLAG=IP2-(IP2/5)*5 K=IP2/5 IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109) IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109) 2100 CONTINUE WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX C 2105 FORMAT(1H ,20X,109A1) 2106 FORMAT(1H ,F20.7,109A1) 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7) 998 FORMAT(1H1) C RETURN END SUBROUTINE PLOT7(Y,X,CHAR,N,YMIN,YMAX,XMIN,XMAX) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PLOT7 C C PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT C OF Y(I) VERSUS X(I): C 1) WITH SPECIAL PLOT CHARACTERS; AND C 2) WITH THE VERTICAL (Y) AXIS MIN AND MAX C AND THE HORIZONTAL (X) AXIS MIN AND MAX C VALUES SPECIFIED BY THE DATA ANALYST. C C THE 'SPECIAL PLOTTING CHARACTER' CAPABILITY C ALLOWS THE DATA ANALYST TO INCORPORATE INFORMATION C FROM A THIRD VARIABLE (ASIDE FROM Y AND X) INTO C THE PLOT. C THE PLOT CHARACTER USED AT THE I-TH PLOTTING C POSITION (THAT IS, AT THE COORDINATE (X(I),Y(I))) C WILL BE C 1 IF CHAR(I) IS BETWEEN 0.5 AND 1.5 C 2 IF CHAR(I) IS BETWEEN 1.5 AND 2.5 C . C . C . C 9 IF CHAR(I) IS BETWEEN 8.5 AND 9.5 C 0 IF CHAR(I) IS BETWEEN 9.5 AND 10.5 C A IF CHAR(I) IS BETWEEN 10.5 AND 11.5 C B IF CHAR(I) IS BETWEEN 11.5 AND 12.5 C C IF CHAR(I) IS BETWEEN 12.5 AND 13.5 C . C . C . C W IF CHAR(I) IS BETWEEN 32.5 AND 33.5 C X IF CHAR(I) IS BETWEEN 33.5 AND 34.5 C Y IF CHAR(I) IS BETWEEN 34.5 AND 35.5 C Z IF CHAR(I) IS BETWEEN 35.5 AND 36.5 C X IF CHAR(I) IS ANY VALUE OUTSIDE THE RANGE C 0.5 TO 36.5. C C THE USE OF THE YMIN, YMAX, XMIN, AND XMAX C SPECIFICATIONS ALLOWS THE DATA ANALYST C TO CONTROL FULLY THE PLOT AXIS LIMITS, C SO AS, FOR EXAMPLE, TO ZERO-IN ON AN C INTERESTING SUB-REGION OF A PREVIOUS PLOT. C C INPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED VERTICALLY. C --X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED HORIZONTALLY. C --CHAR = THE SINGLE PRECISION VECTOR OF C OBSERVATIONS WHICH CONTROL THE C VALUE OF EACH INDIVIDUAL PLOT C CHARACTER. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR Y. C --YMIN = THE SINGLE PRECISION VALUE OF C DESIRED MINIMUM FOR THE VERTICAL AXIS. C --YMAX = THE SINGLE PRECISION VALUE OF C DESIRED MAXIMUM FOR THE VERTICAL AXIS. C --XMIN = THE SINGLE PRECISION VALUE OF C DESIRED MINIMUM FOR THE HORIZONTAL AXIS. C --XMAX = THE SINGLE PRECISION VALUE OF C DESIRED MAXIMUM FOR THE HORIZONTAL AXIS. C OUTPUT--A ONE-PAGE PRINTER PLOT OF Y(I) VERSUS X(I), C WITH SPECIAL PLOT CHARACTERS, C AND WITH SPECIFIED AXIS LIMITS. C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (Y) C WHICH ARE SMALLER THAN YMIN OR LARGER THAN YMAX, C OR VALUES IN THE HORIZONTAL AXIS VECTOR (X) C WHICH ARE SMALLER THAN XMIN OR LARGER THAN XMAX C WILL NOT BE PLOTTED. C --VALUES IN THE VERTICAL AXIS VECTOR (Y), C THE HORIZONTAL AXIS VECTOR (X), C OR THE PLOT CHARACTER VECTOR (CHAR) WHICH ARE C EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE C PLOTTED. C THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM C OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y C (OR X, OR CHAR) ARE 'MISSING DATA', OR WHEN WE PURPOSELY C WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y C (OR X, OR CHAR) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT C WANT CERTAIN ELEMENTS IN Y (OR X, OR CHAR) TO BE C PLOTTED). C TO CAUSE SPECIFIC ELEMENTS IN Y (OR X, OR CHAR) TO BE C IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND C (BY, FOR EXAMPLE, USE OF THE REPLAC SUBROUTINE) C BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND C THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTC C SUBROUTINE. C REFERENCES--FILLIBEN, 'STATISTICAL ANALYSIS OF INTERLAB C FATIGUE TIME DATA', UNPUBLISHED MANUSCRIPT C (AVAILABLE FROM AUTHOR) C PRESENTED AT THE 'COMPUTER-ASSISTED DATA C ANALYSIS' SESSION AT THE NATIONAL MEETING C OF THE AMERICAN STATISTICAL ASSOCIATION, C NEW YORK CITY, DECEMBER 27-30, 1973. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --JUNE 1974. C UPDATED --OCTOBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C UPDATED --FEBRUARY 1977. C UPDATED --JUNE 1977. C C--------------------------------------------------------------------- C CHARACTER*4 IGRAPH CHARACTER*4 IPLOTC CHARACTER*4 SBNAM1,SBNAM2 CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 CHARACTER*4 ALPH41,ALPH42 CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL C DIMENSION Y(1) DIMENSION X(1) DIMENSION CHAR(1) DIMENSION YLABLE(11) DIMENSION IPLOTC(37) COMMON /BLOCK1/ IGRAPH(55,130) C DATA SBNAM1,SBNAM2/'PLOT','7 '/ DATA ALPH11,ALPH12/'FIRS','T '/ DATA ALPH21,ALPH22/'SECO','ND '/ DATA ALPH31,ALPH32/'THIR','D '/ DATA ALPH41,ALPH42/'FOUR','TH '/ DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/ DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/ DATA IPLOTC(1),IPLOTC(2),IPLOTC(3),IPLOTC(4),IPLOTC(5), 1IPLOTC(6),IPLOTC(7),IPLOTC(8),IPLOTC(9),IPLOTC(10), 1IPLOTC(11),IPLOTC(12),IPLOTC(13),IPLOTC(14),IPLOTC(15), 1IPLOTC(16),IPLOTC(17),IPLOTC(18),IPLOTC(19),IPLOTC(20), 1IPLOTC(21),IPLOTC(22),IPLOTC(23),IPLOTC(24),IPLOTC(25), 1IPLOTC(26),IPLOTC(27),IPLOTC(28),IPLOTC(29),IPLOTC(30), 1IPLOTC(31),IPLOTC(32),IPLOTC(33),IPLOTC(34),IPLOTC(35), 1IPLOTC(36),IPLOTC(37) 1/'1','2','3','4','5','6','7','8','9','0','A','B','C','D','E','F', 1'G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V', 1'W','X','Y','Z','X'/ C IPR=6 CUTOFF=(10.0**10)-1000.0 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C WRITE(IPR,998) IF(N.LT.1)GOTO52 GOTO54 52 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,20)N WRITE(IPR,5) RETURN 54 CONTINUE IF(N.EQ.1)GOTO56 GOTO58 56 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,22)N WRITE(IPR,5) RETURN 58 CONTINUE C HOLD=Y(1) DO60I=2,N IF(Y(I).NE.HOLD)GOTO62 60 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 62 CONTINUE HOLD=X(1) DO64I=2,N IF(X(I).NE.HOLD)GOTO66 64 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 66 CONTINUE HOLD=CHAR(1) DO68I=2,N IF(CHAR(I).NE.HOLD)GOTO70 68 CONTINUE WRITE(IPR,5) WRITE(IPR,11) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) 70 CONTINUE C DO76I=1,N IF(Y(I).LT.CUTOFF)GOTO78 76 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 78 CONTINUE DO80I=1,N IF(X(I).LT.CUTOFF)GOTO82 80 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 82 CONTINUE DO84I=1,N IF(CHAR(I).LT.CUTOFF)GOTO86 84 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 86 CONTINUE C N2=0 DO96I=1,N IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF.AND.CHAR(I).LT.CUTOFF)GOTO98 GOTO96 98 N2=N2+1 IF(N2.GE.2)GOTO99 96 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 WRITE(IPR,19)SBNAM1,SBNAM2 WRITE(IPR,40) WRITE(IPR,41)N2 WRITE(IPR,5) RETURN 99 CONTINUE C 5 FORMAT(1H ,'**************************************************', 1'********************') 10 FORMAT(1H ,' FATAL ERROR ') 11 FORMAT(1H ,' NON-FATAL DIAGNOSTIC ') 15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4, 1' SUBROUTINE') 18 FORMAT(1H ,'THE ',A4,A4,', ',A4,A4,', AND ',A4,A4) 19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE') 20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,')') 22 FORMAT(1H ,'HAS THE VALUE 1') 30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8) 32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF') 33 FORMAT(1H ,'VALUE OF ',E15.8) 40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 1' EXCLUDED FROM THE PLOT.') 41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.') C C-----START POINT----------------------------------------------------- C C DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS C DO400I=1,9 AIM1=I-1 YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN) 400 CONTINUE C C DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS C DETERMINE XMID, X25 (=THE 25% POINT), AND C X75 (=THE 75% POINT) C XMID=(XMIN+XMAX)/2.0 X25=0.75*XMIN+0.25*XMAX X75=0.25*XMIN+0.75*XMAX C C BLANK OUT THE GRAPH C DO1100I=1,45 DO1200J=1,109 IGRAPH(I,J)=BLANK 1200 CONTINUE 1100 CONTINUE C C PRODUCE THE VERTICAL AXES C DO1300I=3,43 IGRAPH(I,5)=ALPHAI IGRAPH(I,109)=ALPHAI 1300 CONTINUE DO1400I=3,43,5 IGRAPH(I,5)=HYPHEN IGRAPH(I,109)=HYPHEN 1400 CONTINUE IGRAPH(3,1)=EQUAL IGRAPH(3,2)=ALPHAM IGRAPH(3,3)=ALPHAA IGRAPH(3,4)=ALPHAX IGRAPH(23,1)=EQUAL IGRAPH(23,2)=ALPHAM IGRAPH(23,3)=ALPHAI IGRAPH(23,4)=ALPHAD IGRAPH(43,1)=EQUAL IGRAPH(43,2)=ALPHAM IGRAPH(43,3)=ALPHAI IGRAPH(43,4)=ALPHAN C C PRODUCE THE HORIZONTAL AXES C DO1500J=7,107 IGRAPH(1,J)=HYPHEN IGRAPH(45,J)=HYPHEN 1500 CONTINUE DO1600J=7,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1600 CONTINUE DO1700J=20,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1700 CONTINUE C C DETERMINE THE (X,Y) PLOT POSITIONS C RATIOY=40.0/(YMAX-YMIN) RATIOX=100.0/(XMAX-XMIN) DO1800I=1,N IF(Y(I).GE.CUTOFF)GOTO1800 IF(X(I).GE.CUTOFF)GOTO1800 IF(CHAR(I).GE.CUTOFF)GOTO1800 IF(Y(I).LT.YMIN.OR.Y(I).GT.YMAX)GOTO1800 IF(X(I).LT.XMIN.OR.X(I).GT.XMAX)GOTO1800 MX=RATIOX*(X(I)-XMIN)+0.5 MX=MX+7 MY=RATIOY*(Y(I)-YMIN)+0.5 MY=43-MY IARG=37 IF(0.5.LT.CHAR(I).AND.CHAR(I).LT.36.5)IARG=CHAR(I)+0.5 IGRAPH(MY,MX)=IPLOTC(IARG) 1800 CONTINUE C C WRITE OUT THE GRAPH C DO2100I=1,45 IP2=I+2 IFLAG=IP2-(IP2/5)*5 K=IP2/5 IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109) IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109) 2100 CONTINUE WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX C 2105 FORMAT(1H ,20X,109A1) 2106 FORMAT(1H ,F20.7,109A1) 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7) 998 FORMAT(1H1) C RETURN END SUBROUTINE PLOT8(Y,X,CHAR,N,YMIN,YMAX,XMIN,XMAX, 1 D,DMIN,DMAX) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PLOT8 C C PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT C OF Y(I) VERSUS X(I): C 1) WITH SPECIAL PLOT CHARACTERS; C 2) WITH THE VERTICAL (Y) AXIS MIN AND MAX C AND THE HORIZONTAL (X) AXIS MIN AND MAX C VALUES SPECIFIED BY THE DATA ANALYST; AND C 3) WITH ONLY THOSE POINTS (X(I),Y(I)) PLOTTED C FOR WHICH THE CORRESPONDING VALUE OF D(I) C IS BETWEEN THE SPECIFIED VALUES OF DMIN AND DMAX. C C THE 'SPECIAL PLOTTING CHARACTER' CAPABILITY C ALLOWS THE DATA ANALYST TO INCORPORATE INFORMATION C FROM A THIRD VARIABLE (ASIDE FROM Y AND X) INTO C THE PLOT. C THE PLOT CHARACTER USED AT THE I-TH PLOTTING C POSITION (THAT IS, AT THE COORDINATE (X(I),Y(I))) C WILL BE C 1 IF CHAR(I) IS BETWEEN 0.5 AND 1.5 C 2 IF CHAR(I) IS BETWEEN 1.5 AND 2.5 C . C . C . C 9 IF CHAR(I) IS BETWEEN 8.5 AND 9.5 C 0 IF CHAR(I) IS BETWEEN 9.5 AND 10.5 C A IF CHAR(I) IS BETWEEN 10.5 AND 11.5 C B IF CHAR(I) IS BETWEEN 11.5 AND 12.5 C C IF CHAR(I) IS BETWEEN 12.5 AND 13.5 C . C . C . C W IF CHAR(I) IS BETWEEN 32.5 AND 33.5 C X IF CHAR(I) IS BETWEEN 33.5 AND 34.5 C Y IF CHAR(I) IS BETWEEN 34.5 AND 35.5 C Z IF CHAR(I) IS BETWEEN 35.5 AND 36.5 C X IF CHAR(I) IS ANY VALUE OUTSIDE THE RANGE C 0.5 TO 36.5. C C THE USE OF THE YMIN, YMAX, XMIN, AND XMAX C SPECIFICATIONS ALLOWS THE DATA ANALYST C TO CONTROL FULLY THE PLOT AXIS LIMITS, C SO AS, FOR EXAMPLE, TO ZERO-IN ON AN C INTERESTING SUB-REGION OF A PREVIOUS PLOT. C C THE USE OF THE SUBSET DEFINTION VECTOR D C GIVES THE DATA ANALYST THE CAPABILITY OF C PLOTTING SUBSETS OF THE DATA, C WHERE THE SUBSET IS DEFINED C BY VALUES IN THE VECTOR D. C C INPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED VERTICALLY. C --X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED HORIZONTALLY. C --CHAR = THE SINGLE PRECISION VECTOR OF C OBSERVATIONS WHICH CONTROL THE C VALUE OF EACH INDIVIDUAL PLOT C CHARACTER. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR Y. C --YMIN = THE SINGLE PRECISION VALUE OF C DESIRED MINIMUM FOR THE VERTICAL AXIS. C --YMAX = THE SINGLE PRECISION VALUE OF C DESIRED MAXIMUM FOR THE VERTICAL AXIS. C --XMIN = THE SINGLE PRECISION VALUE OF C DESIRED MINIMUM FOR THE HORIZONTAL AXIS. C --XMAX = THE SINGLE PRECISION VALUE OF C DESIRED MAXIMUM FOR THE HORIZONTAL AXIS. C --D = THE SINGLE PRECISION VECTOR C WHICH 'DEFINES' THE VARIOUS C POSSIBLE SUBSETS. C --DMIN = THE SINGLE PRECISION VALUE C WHICH DEFINES THE LOWER BOUND C (INCLUSIVELY) OF THE PARTICULAR C SUBSET OF INTEREST TO BE PLOTTED. C --DMAX = THE SINGLE PRECISION VALUE C WHICH DEFINES THE UPPER BOUND C (INCLUSIVELY) OF THE PARTICULAR C SUBSET OF INTEREST TO BE PLOTTED. C OUTPUT--A ONE-PAGE PRINTER PLOT OF Y(I) VERSUS X(I), C WITH SPECIAL PLOT CHARACTERS, C WITH SPECIFIED AXIS LIMITS, C AND ONLY FOR A SPECIFIED SUBSET OF THE DATA. C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (Y) C WHICH ARE SMALLER THAN YMIN OR LARGER THAN YMAX, C OR VALUES IN THE HORIZONTAL AXIS VECTOR (X) C WHICH ARE SMALLER THAN XMIN OR LARGER THAN XMAX C WILL NOT BE PLOTTED. C --FOR A GIVEN DUMMY INDEX I, C IF D(I) IS SMALLER THAN DMIN OR LARGER THAN DMAX, C THEN THE CORRESPONDING POINT (X(I),Y(I)) C WILL NOT BE PLOTTED. C --VALUES IN THE VERTICAL AXIS VECTOR (Y), C THE HORIZONTAL AXIS VECTOR (X), C OR THE PLOT CHARACTER VECTOR (CHAR) WHICH ARE C EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE C PLOTTED. C THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM C OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y C (OR X, OR CHAR) ARE 'MISSING DATA', OR WHEN WE PURPOSELY C WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y C (OR X, OR CHAR) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT C WANT CERTAIN ELEMENTS IN Y (OR X, OR CHAR) TO BE C PLOTTED). C TO CAUSE SPECIFIC ELEMENTS IN Y (OR X, OR CHAR) TO BE C IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND C (BY, FOR EXAMPLE, USE OF THE REPLAC SUBROUTINE) C BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND C THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTC C SUBROUTINE. C REFERENCES--FILLIBEN, 'STATISTICAL ANALYSIS OF INTERLAB C FATIGUE TIME DATA', UNPUBLISHED MANUSCRIPT C (AVAILABLE FROM AUTHOR) C PRESENTED AT THE 'COMPUTER-ASSISTED DATA C ANALYSIS' SESSION AT THE NATIONAL MEETING C OF THE AMERICAN STATISTICAL ASSOCIATION, C NEW YORK CITY, DECEMBER 27-30, 1973. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--JANUARY 1974. C UPDATED --OCTOBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C UPDATED --FEBRUARY 1977. C UPDATED --JUNE 1977. C C--------------------------------------------------------------------- C CHARACTER*4 IGRAPH CHARACTER*4 IPLOTC CHARACTER*4 SBNAM1,SBNAM2 CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 CHARACTER*4 ALPH41,ALPH42,ALPH91,ALPH92 CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL C DIMENSION Y(1) DIMENSION X(1) DIMENSION D(1) DIMENSION CHAR(1) DIMENSION YLABLE(11) DIMENSION IPLOTC(37) COMMON /BLOCK1/ IGRAPH(55,130) C DATA SBNAM1,SBNAM2/'PLOT','8 '/ DATA ALPH11,ALPH12/'FIRS','T '/ DATA ALPH21,ALPH22/'SECO','ND '/ DATA ALPH31,ALPH32/'THIR','D '/ DATA ALPH41,ALPH42/'FOUR','TH '/ DATA ALPH91,ALPH92/'NINT','H '/ DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/ DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/ DATA IPLOTC(1),IPLOTC(2),IPLOTC(3),IPLOTC(4),IPLOTC(5), 1IPLOTC(6),IPLOTC(7),IPLOTC(8),IPLOTC(9),IPLOTC(10), 1IPLOTC(11),IPLOTC(12),IPLOTC(13),IPLOTC(14),IPLOTC(15), 1IPLOTC(16),IPLOTC(17),IPLOTC(18),IPLOTC(19),IPLOTC(20), 1IPLOTC(21),IPLOTC(22),IPLOTC(23),IPLOTC(24),IPLOTC(25), 1IPLOTC(26),IPLOTC(27),IPLOTC(28),IPLOTC(29),IPLOTC(30), 1IPLOTC(31),IPLOTC(32),IPLOTC(33),IPLOTC(34),IPLOTC(35), 1IPLOTC(36),IPLOTC(37) 1/'1','2','3','4','5','6','7','8','9','0','A','B','C','D','E','F', 1'G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V', 1'W','X','Y','Z','X'/ C IPR=6 CUTOFF=(10.0**10)-1000.0 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C WRITE(IPR,998) IF(N.LT.1)GOTO52 GOTO54 52 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,20)N WRITE(IPR,5) RETURN 54 CONTINUE IF(N.EQ.1)GOTO56 GOTO58 56 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,22)N WRITE(IPR,5) RETURN 58 CONTINUE C HOLD=Y(1) DO60I=2,N IF(Y(I).NE.HOLD)GOTO62 60 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 62 CONTINUE HOLD=X(1) DO64I=2,N IF(X(I).NE.HOLD)GOTO66 64 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 66 CONTINUE HOLD=CHAR(1) DO68I=2,N IF(CHAR(I).NE.HOLD)GOTO70 68 CONTINUE WRITE(IPR,5) WRITE(IPR,11) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) 70 CONTINUE HOLD=D(1) DO72I=2,N IF(D(I).NE.HOLD)GOTO74 72 CONTINUE WRITE(IPR,5) WRITE(IPR,11) WRITE(IPR,15)ALPH91,ALPH92,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) 74 CONTINUE C DO76I=1,N IF(Y(I).LT.CUTOFF)GOTO78 76 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 78 CONTINUE DO80I=1,N IF(X(I).LT.CUTOFF)GOTO82 80 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 82 CONTINUE DO84I=1,N IF(CHAR(I).LT.CUTOFF)GOTO86 84 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 86 CONTINUE DO88I=1,N IF(D(I).LT.CUTOFF)GOTO90 88 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH91,ALPH92,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 90 CONTINUE C DO92I=1,N IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)GOTO94 92 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH91,ALPH92,SBNAM1,SBNAM2 WRITE(IPR,34) WRITE(IPR,35)DMIN,DMAX WRITE(IPR,36) WRITE(IPR,5) RETURN 94 CONTINUE C N2=0 DO96I=1,N IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF.AND.CHAR(I).LT.CUTOFF.AND. 1D(I).LT.CUTOFF)GOTO98 GOTO96 98 IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)N2=N2+1 IF(N2.GE.2)GOTO99 96 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32, 1ALPH91,ALPH92 WRITE(IPR,19)SBNAM1,SBNAM2 WRITE(IPR,40) WRITE(IPR,41)N2 WRITE(IPR,5) RETURN 99 CONTINUE C 5 FORMAT(1H ,'**************************************************', 1'********************') 10 FORMAT(1H ,' FATAL ERROR ') 11 FORMAT(1H ,' NON-FATAL DIAGNOSTIC ') 15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4, 1' SUBROUTINE') 18 FORMAT(1H ,'THE ',A4,A4,', ',A4,A4,', ',A4,A4,', AND ',A4,A4) 19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE') 20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,')') 22 FORMAT(1H ,'HAS THE VALUE 1') 30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8) 32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF') 33 FORMAT(1H ,'VALUE OF ',E15.8) 34 FORMAT(1H ,'HAS ALL ELEMENTS OUTSIDE THE INTERVAL') 35 FORMAT(1H ,'(',E15.8,',',E15.8,')',' AS DEFINED BY') 36 FORMAT(1H ,'THE FIFTH AND SIXTH INPUT ARGUMENTS.') 40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 1' EXCLUDED FROM THE PLOT.') 41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.') C C-----START POINT----------------------------------------------------- C C DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS C DO400I=1,9 AIM1=I-1 YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN) 400 CONTINUE C C DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS C DETERMINE XMID, X25 (=THE 25% POINT), AND C X75 (=THE 75% POINT) C XMID=(XMIN+XMAX)/2.0 X25=0.75*XMIN+0.25*XMAX X75=0.25*XMIN+0.75*XMAX C C BLANK OUT THE GRAPH C DO1100I=1,45 DO1200J=1,109 IGRAPH(I,J)=BLANK 1200 CONTINUE 1100 CONTINUE C C PRODUCE THE VERTICAL AXES C DO1300I=3,43 IGRAPH(I,5)=ALPHAI IGRAPH(I,109)=ALPHAI 1300 CONTINUE DO1400I=3,43,5 IGRAPH(I,5)=HYPHEN IGRAPH(I,109)=HYPHEN 1400 CONTINUE IGRAPH(3,1)=EQUAL IGRAPH(3,2)=ALPHAM IGRAPH(3,3)=ALPHAA IGRAPH(3,4)=ALPHAX IGRAPH(23,1)=EQUAL IGRAPH(23,2)=ALPHAM IGRAPH(23,3)=ALPHAI IGRAPH(23,4)=ALPHAD IGRAPH(43,1)=EQUAL IGRAPH(43,2)=ALPHAM IGRAPH(43,3)=ALPHAI IGRAPH(43,4)=ALPHAN C C PRODUCE THE HORIZONTAL AXES C DO1500J=7,107 IGRAPH(1,J)=HYPHEN IGRAPH(45,J)=HYPHEN 1500 CONTINUE DO1600J=7,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1600 CONTINUE DO1700J=20,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1700 CONTINUE C C DETERMINE THE (X,Y) PLOT POSITIONS C RATIOY=40.0/(YMAX-YMIN) RATIOX=100.0/(XMAX-XMIN) DO1800I=1,N IF(Y(I).GE.CUTOFF)GOTO1800 IF(X(I).GE.CUTOFF)GOTO1800 IF(CHAR(I).GE.CUTOFF)GOTO1800 IF(Y(I).LT.YMIN.OR.Y(I).GT.YMAX)GOTO1800 IF(X(I).LT.XMIN.OR.X(I).GT.XMAX)GOTO1800 IF(D(I).LT.DMIN)GOTO1800 IF(D(I).GT.DMAX)GOTO1800 MX=RATIOX*(X(I)-XMIN)+0.5 MX=MX+7 MY=RATIOY*(Y(I)-YMIN)+0.5 MY=43-MY IARG=37 IF(0.5.LT.CHAR(I).AND.CHAR(I).LT.36.5)IARG=CHAR(I)+0.5 IGRAPH(MY,MX)=IPLOTC(IARG) 1800 CONTINUE C C WRITE OUT THE GRAPH C DO2100I=1,45 IP2=I+2 IFLAG=IP2-(IP2/5)*5 K=IP2/5 IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109) IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109) 2100 CONTINUE WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX C 2105 FORMAT(1H ,20X,109A1) 2106 FORMAT(1H ,F20.7,109A1) 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7) 998 FORMAT(1H1) C RETURN END SUBROUTINE PLOT9(Y,X,CHAR,N,YMIN,YMAX,XMIN,XMAX, 1 YAXID,XAXID,PLCHID) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PLOT9 C C PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT C OF Y(I) VERSUS X(I): C 1) WITH SPECIAL PLOT CHARACTERS; C 2) WITH THE VERTICAL (Y) AXIS MIN AND MAX C AND THE HORIZONTAL (X) AXIS MIN AND MAX C VALUES SPECIFIED BY THE DATA ANALYST; AND C 3) WITH HOLLARITH LABELS (AT MOST 6 CHARACTERS) C FOR THE VERTICAL AXIS VARIABLE, C THE HORIZONTAL AXIS VARIABLE, AND C THE PLOTTING CHARACTER VARIABLE C ALSO BEING PROVIDED BY THE DATA ANALYST. C C THE 'SPECIAL PLOTTING CHARACTER' CAPABILITY C ALLOWS THE DATA ANALYST TO INCORPORATE INFORMATION C FROM A THIRD VARIABLE (ASIDE FROM Y AND X) INTO C THE PLOT. C THE PLOT CHARACTER USED AT THE I-TH PLOTTING C POSITION (THAT IS, AT THE COORDINATE (X(I),Y(I))) C WILL BE C 1 IF CHAR(I) IS BETWEEN 0.5 AND 1.5 C 2 IF CHAR(I) IS BETWEEN 1.5 AND 2.5 C . C . C . C 9 IF CHAR(I) IS BETWEEN 8.5 AND 9.5 C 0 IF CHAR(I) IS BETWEEN 9.5 AND 10.5 C A IF CHAR(I) IS BETWEEN 10.5 AND 11.5 C B IF CHAR(I) IS BETWEEN 11.5 AND 12.5 C C IF CHAR(I) IS BETWEEN 12.5 AND 13.5 C . C . C . C W IF CHAR(I) IS BETWEEN 32.5 AND 33.5 C X IF CHAR(I) IS BETWEEN 33.5 AND 34.5 C Y IF CHAR(I) IS BETWEEN 34.5 AND 35.5 C Z IF CHAR(I) IS BETWEEN 35.5 AND 36.5 C X IF CHAR(I) IS ANY VALUE OUTSIDE THE RANGE C 0.5 TO 36.5. C C THE USE OF THE YMIN, YMAX, XMIN, AND XMAX C SPECIFICATIONS ALLOWS THE DATA ANALYST C TO CONTROL FULLY THE PLOT AXIS LIMITS, C SO AS, FOR EXAMPLE, TO ZERO-IN ON AN C INTERESTING SUB-REGION OF A PREVIOUS PLOT. C C THE USE OF HOLLARITH IDENTIFYING LABELS C ALLOWS THE DATA ANALYST TO AUTOMATICALLY C HAVE THE PLOTS LABELED. THIS IS PARTICULARLY C USEFUL IN A LARGE ANALYSIS WHEN MANY C PLOTS ARE BEING GENERATED. C C INPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED VERTICALLY. C --X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED HORIZONTALLY. C --CHAR = THE SINGLE PRECISION VECTOR OF C OBSERVATIONS WHICH CONTROL THE C VALUE OF EACH INDIVIDUAL PLOT C CHARACTER. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR Y. C --YMIN = THE SINGLE PRECISION VALUE OF C DESIRED MINIMUM FOR THE VERTICAL AXIS. C --YMAX = THE SINGLE PRECISION VALUE OF C DESIRED MAXIMUM FOR THE VERTICAL AXIS. C --XMIN = THE SINGLE PRECISION VALUE OF C DESIRED MINIMUM FOR THE HORIZONTAL AXIS. C --XMAX = THE SINGLE PRECISION VALUE OF C DESIRED MAXIMUM FOR THE HORIZONTAL AXIS. C --YAXID = THE HOLLARITH VALUE C (AT MOST 6 CHARACTERS) C OF THE DESIRED LABEL FOR THE C VERTICAL AXIS VARIABLE. C --XAXID = THE HOLLARITH VALUE C (AT MOST 6 CHARACTERS) C OF THE DESIRED LABEL FOR THE C HORIZONTAL AXIS VARIABLE. C --PLCHID = THE HOLLARITH VALUE C (AT MOST 6 CHARACTERS) C OF THE DESIRED LABEL FOR THE C PLOTTING CHARACTER VARIABLE. C OUTPUT--A ONE-PAGE PRINTER PLOT OF Y(I) VERSUS X(I), C WITH SPECIAL PLOT CHARACTERS, C WITH SPECIFIED AXIS LIMITS, C AND WITH SPECIFIED LABELS. C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (Y) C WHICH ARE SMALLER THAN YMIN OR LARGER THAN YMAX, C OR VALUES IN THE HORIZONTAL AXIS VECTOR (X) C WHICH ARE SMALLER THAN XMIN OR LARGER THAN XMAX C WILL NOT BE PLOTTED. C --VALUES IN THE VERTICAL AXIS VECTOR (Y), C THE HORIZONTAL AXIS VECTOR (X), C OR THE PLOT CHARACTER VECTOR (CHAR) WHICH ARE C EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE C PLOTTED. C THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM C OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y C (OR X, OR CHAR) ARE 'MISSING DATA', OR WHEN WE PURPOSELY C WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y C (OR X, OR CHAR) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT C WANT CERTAIN ELEMENTS IN Y (OR X, OR CHAR) TO BE C PLOTTED). C TO CAUSE SPECIFIC ELEMENTS IN Y (OR X, OR CHAR) TO BE C IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND C (BY, FOR EXAMPLE, USE OF THE REPLAC SUBROUTINE) C BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND C THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTC C SUBROUTINE. C REFERENCES--FILLIBEN, 'STATISTICAL ANALYSIS OF INTERLAB C FATIGUE TIME DATA', UNPUBLISHED MANUSCRIPT C (AVAILABLE FROM AUTHOR) C PRESENTED AT THE 'COMPUTER-ASSISTED DATA C ANALYSIS' SESSION AT THE NATIONAL MEETING C OF THE AMERICAN STATISTICAL ASSOCIATION, C NEW YORK CITY, DECEMBER 27-30, 1973. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --JUNE 1974. C UPDATED --OCTOBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C UPDATED --FEBRUARY 1977. C UPDATED --JUNE 1977. C C--------------------------------------------------------------------- C CHARACTER*4 IGRAPH CHARACTER*4 IPLOTC CHARACTER*4 SBNAM1,SBNAM2 CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 CHARACTER*4 ALPH41,ALPH42 CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL C DIMENSION Y(1) DIMENSION X(1) DIMENSION CHAR(1) DIMENSION YLABLE(11) DIMENSION IPLOTC(37) COMMON /BLOCK1/ IGRAPH(55,130) C DATA SBNAM1,SBNAM2/'PLOT','9 '/ DATA ALPH11,ALPH12/'FIRS','T '/ DATA ALPH21,ALPH22/'SECO','ND '/ DATA ALPH31,ALPH32/'THIR','D '/ DATA ALPH41,ALPH42/'FOUR','TH '/ DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/ DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/ DATA IPLOTC(1),IPLOTC(2),IPLOTC(3),IPLOTC(4),IPLOTC(5), 1IPLOTC(6),IPLOTC(7),IPLOTC(8),IPLOTC(9),IPLOTC(10), 1IPLOTC(11),IPLOTC(12),IPLOTC(13),IPLOTC(14),IPLOTC(15), 1IPLOTC(16),IPLOTC(17),IPLOTC(18),IPLOTC(19),IPLOTC(20), 1IPLOTC(21),IPLOTC(22),IPLOTC(23),IPLOTC(24),IPLOTC(25), 1IPLOTC(26),IPLOTC(27),IPLOTC(28),IPLOTC(29),IPLOTC(30), 1IPLOTC(31),IPLOTC(32),IPLOTC(33),IPLOTC(34),IPLOTC(35), 1IPLOTC(36),IPLOTC(37) 1/'1','2','3','4','5','6','7','8','9','0','A','B','C','D','E','F', 1'G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V', 1'W','X','Y','Z','X'/ C IPR=6 CUTOFF=(10.0**10)-1000.0 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C WRITE(IPR,998) IF(N.LT.1)GOTO52 GOTO54 52 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,20)N WRITE(IPR,5) RETURN 54 CONTINUE IF(N.EQ.1)GOTO56 GOTO58 56 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,22)N WRITE(IPR,5) RETURN 58 CONTINUE C HOLD=Y(1) DO60I=2,N IF(Y(I).NE.HOLD)GOTO62 60 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 62 CONTINUE HOLD=X(1) DO64I=2,N IF(X(I).NE.HOLD)GOTO66 64 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 66 CONTINUE HOLD=CHAR(1) DO68I=2,N IF(CHAR(I).NE.HOLD)GOTO70 68 CONTINUE WRITE(IPR,5) WRITE(IPR,11) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) 70 CONTINUE C DO76I=1,N IF(Y(I).LT.CUTOFF)GOTO78 76 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 78 CONTINUE DO80I=1,N IF(X(I).LT.CUTOFF)GOTO82 80 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 82 CONTINUE DO84I=1,N IF(CHAR(I).LT.CUTOFF)GOTO86 84 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 86 CONTINUE C N2=0 DO96I=1,N IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF.AND.CHAR(I).LT.CUTOFF)GOTO98 GOTO96 98 N2=N2+1 IF(N2.GE.2)GOTO99 96 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 WRITE(IPR,19)SBNAM1,SBNAM2 WRITE(IPR,40) WRITE(IPR,41)N2 WRITE(IPR,5) RETURN 99 CONTINUE C 5 FORMAT(1H ,'**************************************************', 1'********************') 10 FORMAT(1H ,' FATAL ERROR ') 11 FORMAT(1H ,' NON-FATAL DIAGNOSTIC ') 15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4, 1' SUBROUTINE') 18 FORMAT(1H ,'THE ',A4,A4,', ',A4,A4,', AND ',A4,A4) 19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE') 20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,')') 22 FORMAT(1H ,'HAS THE VALUE 1') 30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8) 32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF') 33 FORMAT(1H ,'VALUE OF ',E15.8) 40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 1' EXCLUDED FROM THE PLOT.') 41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.') C C-----START POINT----------------------------------------------------- C C DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS C DO400I=1,9 AIM1=I-1 YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN) 400 CONTINUE C C DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS C DETERMINE XMID, X25 (=THE 25% POINT), AND C X75 (=THE 75% POINT) C XMID=(XMIN+XMAX)/2.0 X25=0.75*XMIN+0.25*XMAX X75=0.25*XMIN+0.75*XMAX C C BLANK OUT THE GRAPH C DO1100I=1,45 DO1200J=1,109 IGRAPH(I,J)=BLANK 1200 CONTINUE 1100 CONTINUE C C PRODUCE THE VERTICAL AXES C DO1300I=3,43 IGRAPH(I,5)=ALPHAI IGRAPH(I,109)=ALPHAI 1300 CONTINUE DO1400I=3,43,5 IGRAPH(I,5)=HYPHEN IGRAPH(I,109)=HYPHEN 1400 CONTINUE IGRAPH(3,1)=EQUAL IGRAPH(3,2)=ALPHAM IGRAPH(3,3)=ALPHAA IGRAPH(3,4)=ALPHAX IGRAPH(23,1)=EQUAL IGRAPH(23,2)=ALPHAM IGRAPH(23,3)=ALPHAI IGRAPH(23,4)=ALPHAD IGRAPH(43,1)=EQUAL IGRAPH(43,2)=ALPHAM IGRAPH(43,3)=ALPHAI IGRAPH(43,4)=ALPHAN C C PRODUCE THE HORIZONTAL AXES C DO1500J=7,107 IGRAPH(1,J)=HYPHEN IGRAPH(45,J)=HYPHEN 1500 CONTINUE DO1600J=7,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1600 CONTINUE DO1700J=20,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1700 CONTINUE C C DETERMINE THE (X,Y) PLOT POSITIONS C RATIOY=40.0/(YMAX-YMIN) RATIOX=100.0/(XMAX-XMIN) DO1800I=1,N IF(Y(I).GE.CUTOFF)GOTO1800 IF(X(I).GE.CUTOFF)GOTO1800 IF(CHAR(I).GE.CUTOFF)GOTO1800 IF(Y(I).LT.YMIN.OR.Y(I).GT.YMAX)GOTO1800 IF(X(I).LT.XMIN.OR.X(I).GT.XMAX)GOTO1800 MX=RATIOX*(X(I)-XMIN)+0.5 MX=MX+7 MY=RATIOY*(Y(I)-YMIN)+0.5 MY=43-MY IARG=37 IF(0.5.LT.CHAR(I).AND.CHAR(I).LT.36.5)IARG=CHAR(I)+0.5 IGRAPH(MY,MX)=IPLOTC(IARG) 1800 CONTINUE C C WRITE OUT THE GRAPH C DO2100I=1,45 IP2=I+2 IFLAG=IP2-(IP2/5)*5 K=IP2/5 IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109) IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109) 2100 CONTINUE WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX C WRITE(IPR,2115)YAXID,XAXID,PLCHID WRITE(IPR,2116)N 2105 FORMAT(1H ,20X,109A1) 2106 FORMAT(1H ,F20.7,109A1) 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7) 2115 FORMAT(1H ,9X,A4,A4,' (VERTICAL AXIS) VERSUS ',A4,A4, 1' (HORIZONTAL AXIS)',20X,'THE PLOTTING CHARACTER IS ',A4,A4) 2116 FORMAT(1H ,83X,'THE NUMBER OF OBSERVATIONS PLOTTED IS ',I8) 998 FORMAT(1H1) C RETURN END SUBROUTINE PLOTC(Y,X,CHAR,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PLOTC C C PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT C OF Y(I) VERSUS X(I) WITH SPECIAL PLOTTING C CHARACTERS. C THIS 'SPECIAL PLOTTING CHARACTER' CAPABILITY C ALLOWS THE DATA ANALYST TO INCORPORATE INFORMATION C FROM A THIRD VARIABLE (ASIDE FROM Y AND X) INTO C THE PLOT. C THE PLOT CHARACTER USED AT THE I-TH PLOTTING C POSITION (THAT IS, AT THE COORDINATE (X(I),Y(I))) C WILL BE C 1 IF CHAR(I) IS BETWEEN 0.5 AND 1.5 C 2 IF CHAR(I) IS BETWEEN 1.5 AND 2.5 C . C . C . C 9 IF CHAR(I) IS BETWEEN 8.5 AND 9.5 C 0 IF CHAR(I) IS BETWEEN 9.5 AND 10.5 C A IF CHAR(I) IS BETWEEN 10.5 AND 11.5 C B IF CHAR(I) IS BETWEEN 11.5 AND 12.5 C C IF CHAR(I) IS BETWEEN 12.5 AND 13.5 C . C . C . C W IF CHAR(I) IS BETWEEN 32.5 AND 33.5 C X IF CHAR(I) IS BETWEEN 33.5 AND 34.5 C Y IF CHAR(I) IS BETWEEN 34.5 AND 35.5 C Z IF CHAR(I) IS BETWEEN 35.5 AND 36.5 C X IF CHAR(I) IS ANY VALUE OUTSIDE THE RANGE C 0.5 TO 36.5. C INPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED VERTICALLY. C --X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED HORIZONTALLY. C --CHAR = THE SINGLE PRECISION VECTOR OF C OBSERVATIONS WHICH CONTROL THE C VALUE OF EACH INDIVIDUAL PLOT C CHARACTER. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR Y. C OUTPUT--A ONE-PAGE PRINTER PLOT OF Y(I) VERSUS X(I) C WITH SPECIAL PLOT CHARACTERS. C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (Y), C THE HORIZONTAL AXIS VECTOR (X), C OR THE PLOT CHARACTER VECTOR (CHAR) WHICH ARE C EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE C PLOTTED. C THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM C OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y C (OR X, OR CHAR) ARE 'MISSING DATA', OR WHEN WE PURPOSELY C WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y C (OR X, OR CHAR) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT C WANT CERTAIN ELEMENTS IN Y (OR X, OR CHAR) TO BE C PLOTTED). C TO CAUSE SPECIFIC ELEMENTS IN Y (OR X, OR CHAR) TO BE C IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND C (BY, FOR EXAMPLE, USE OF THE REPLAC SUBROUTINE) C BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND C THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTC C SUBROUTINE. C REFERENCES--FILLIBEN, 'STATISTICAL ANALYSIS OF INTERLAB C FATIGUE TIME DATA', UNPUBLISHED MANUSCRIPT C (AVAILABLE FROM AUTHOR) C PRESENTED AT THE 'COMPUTER-ASSISTED DATA C ANALYSIS' SESSION AT THE NATIONAL MEETING C OF THE AMERICAN STATISTICAL ASSOCIATION, C NEW YORK CITY, DECEMBER 27-30, 1973. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--OCTOBER 1974. C UPDATED --NOVEMBER 1974. C UPDATED --JANUARY 1975. C UPDATED --JULY 1975. C UPDATED --SEPTEMBER 1975. C UPDATED --OCTOBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C UPDATED --FEBRUARY 1977. C C--------------------------------------------------------------------- C CHARACTER*4 IGRAPH CHARACTER*4 IPLOTC CHARACTER*4 SBNAM1,SBNAM2 CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 CHARACTER*4 ALPH41,ALPH42 CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL C DIMENSION Y(1) DIMENSION X(1) DIMENSION CHAR(1) DIMENSION YLABLE(11) DIMENSION IPLOTC(37) COMMON /BLOCK1/ IGRAPH(55,130) C DATA SBNAM1,SBNAM2/'PLOT','C '/ DATA ALPH11,ALPH12/'FIRS','T '/ DATA ALPH21,ALPH22/'SECO','ND '/ DATA ALPH31,ALPH32/'THIR','D '/ DATA ALPH41,ALPH42/'FOUR','TH '/ DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/ DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/ DATA IPLOTC(1),IPLOTC(2),IPLOTC(3),IPLOTC(4),IPLOTC(5), 1IPLOTC(6),IPLOTC(7),IPLOTC(8),IPLOTC(9),IPLOTC(10), 1IPLOTC(11),IPLOTC(12),IPLOTC(13),IPLOTC(14),IPLOTC(15), 1IPLOTC(16),IPLOTC(17),IPLOTC(18),IPLOTC(19),IPLOTC(20), 1IPLOTC(21),IPLOTC(22),IPLOTC(23),IPLOTC(24),IPLOTC(25), 1IPLOTC(26),IPLOTC(27),IPLOTC(28),IPLOTC(29),IPLOTC(30), 1IPLOTC(31),IPLOTC(32),IPLOTC(33),IPLOTC(34),IPLOTC(35), 1IPLOTC(36),IPLOTC(37) 1/'1','2','3','4','5','6','7','8','9','0','A','B','C','D','E','F', 1'G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V', 1'W','X','Y','Z','X'/ C IPR=6 CUTOFF=(10.0**10)-1000.0 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C WRITE(IPR,998) IF(N.LT.1)GOTO52 GOTO54 52 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,20)N WRITE(IPR,5) RETURN 54 CONTINUE IF(N.EQ.1)GOTO56 GOTO58 56 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,22)N WRITE(IPR,5) RETURN 58 CONTINUE C HOLD=Y(1) DO60I=2,N IF(Y(I).NE.HOLD)GOTO62 60 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 62 CONTINUE HOLD=X(1) DO64I=2,N IF(X(I).NE.HOLD)GOTO66 64 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 66 CONTINUE HOLD=CHAR(1) DO68I=2,N IF(CHAR(I).NE.HOLD)GOTO70 68 CONTINUE WRITE(IPR,5) WRITE(IPR,11) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) 70 CONTINUE C DO76I=1,N IF(Y(I).LT.CUTOFF)GOTO78 76 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 78 CONTINUE DO80I=1,N IF(X(I).LT.CUTOFF)GOTO82 80 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 82 CONTINUE DO84I=1,N IF(CHAR(I).LT.CUTOFF)GOTO86 84 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 86 CONTINUE C N2=0 DO96I=1,N IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF.AND.CHAR(I).LT.CUTOFF)GOTO98 GOTO96 98 N2=N2+1 IF(N2.GE.2)GOTO99 96 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 WRITE(IPR,19)SBNAM1,SBNAM2 WRITE(IPR,40) WRITE(IPR,41)N2 WRITE(IPR,5) RETURN 99 CONTINUE C 5 FORMAT(1H ,'**************************************************', 1'********************') 10 FORMAT(1H ,' FATAL ERROR ') 11 FORMAT(1H ,' NON-FATAL DIAGNOSTIC ') 15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4, 1' SUBROUTINE') 18 FORMAT(1H ,'THE ',A4,A4,2H, ,A4,A4,', AND ',A4,A4) 19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE') 20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,1H)) 22 FORMAT(1H ,'HAS THE VALUE 1') 30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8) 32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF') 33 FORMAT(1H ,'VALUE OF ',E15.8) 40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 1' EXCLUDED FROM THE PLOT.') 41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.') C C-----START POINT----------------------------------------------------- C C DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS C DO200I=1,N IF(Y(I).GE.CUTOFF)GOTO200 IF(X(I).GE.CUTOFF)GOTO200 IF(CHAR(I).GE.CUTOFF)GOTO200 YMIN=Y(I) YMAX=Y(I) GOTO250 200 CONTINUE 250 DO300I=1,N IF(Y(I).GE.CUTOFF)GOTO300 IF(X(I).GE.CUTOFF)GOTO300 IF(CHAR(I).GE.CUTOFF)GOTO300 IF(Y(I).LT.YMIN)YMIN=Y(I) IF(Y(I).GT.YMAX)YMAX=Y(I) 300 CONTINUE DO400I=1,9 AIM1=I-1 YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN) 400 CONTINUE C C DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS C DETERMINE XMIN, XMAX, XMID, X25 (=THE 25% POINT), AND C X75 (=THE 75% POINT) C DO600I=1,N IF(Y(I).GE.CUTOFF)GOTO600 IF(X(I).GE.CUTOFF)GOTO600 IF(CHAR(I).GE.CUTOFF)GOTO600 XMIN=X(I) XMAX=X(I) GOTO650 600 CONTINUE 650 DO700I=1,N IF(Y(I).GE.CUTOFF)GOTO700 IF(X(I).GE.CUTOFF)GOTO700 IF(CHAR(I).GE.CUTOFF)GOTO700 IF(X(I).LT.XMIN)XMIN=X(I) IF(X(I).GT.XMAX)XMAX=X(I) 700 CONTINUE XMID=(XMIN+XMAX)/2.0 X25=0.75*XMIN+0.25*XMAX X75=0.25*XMIN+0.75*XMAX C C BLANK OUT THE GRAPH C DO1100I=1,45 DO1200J=1,109 IGRAPH(I,J)=BLANK 1200 CONTINUE 1100 CONTINUE C C PRODUCE THE VERTICAL AXES C DO1300I=3,43 IGRAPH(I,5)=ALPHAI IGRAPH(I,109)=ALPHAI 1300 CONTINUE DO1400I=3,43,5 IGRAPH(I,5)=HYPHEN IGRAPH(I,109)=HYPHEN 1400 CONTINUE IGRAPH(3,1)=EQUAL IGRAPH(3,2)=ALPHAM IGRAPH(3,3)=ALPHAA IGRAPH(3,4)=ALPHAX IGRAPH(23,1)=EQUAL IGRAPH(23,2)=ALPHAM IGRAPH(23,3)=ALPHAI IGRAPH(23,4)=ALPHAD IGRAPH(43,1)=EQUAL IGRAPH(43,2)=ALPHAM IGRAPH(43,3)=ALPHAI IGRAPH(43,4)=ALPHAN C C PRODUCE THE HORIZONTAL AXES C DO1500J=7,107 IGRAPH(1,J)=HYPHEN IGRAPH(45,J)=HYPHEN 1500 CONTINUE DO1600J=7,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1600 CONTINUE DO1700J=20,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1700 CONTINUE C C DETERMINE THE (X,Y) PLOT POSITIONS C RATIOY=40.0/(YMAX-YMIN) RATIOX=100.0/(XMAX-XMIN) DO1800I=1,N IF(Y(I).GE.CUTOFF)GOTO1800 IF(X(I).GE.CUTOFF)GOTO1800 IF(CHAR(I).GE.CUTOFF)GOTO1800 MX=RATIOX*(X(I)-XMIN)+0.5 MX=MX+7 MY=RATIOY*(Y(I)-YMIN)+0.5 MY=43-MY IARG=37 IF(0.5.LT.CHAR(I).AND.CHAR(I).LT.36.5)IARG=CHAR(I)+0.5 IGRAPH(MY,MX)=IPLOTC(IARG) 1800 CONTINUE C C WRITE OUT THE GRAPH C DO2100I=1,45 IP2=I+2 IFLAG=IP2-(IP2/5)*5 K=IP2/5 IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109) IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109) 2100 CONTINUE WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX C 2105 FORMAT(1H ,20X,109A1) 2106 FORMAT(1H ,F20.7,109A1) 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7) 998 FORMAT(1H1) C RETURN END SUBROUTINE PLOTCO(Y,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PLOTCO C C THIS ROUTINE YIELDS A MULTI-PAGE (IF NECESSARY) PLOT OF THE AUTOCORRELATIO C COEFFICIENT R(K) VERSUS THE LAG K C THERE IS NO RESTRICTION ON THE MAXIMUM VALUE OF N FOR THIS ROUTINE. C PRINTING--YES C SUBROUTINES NEEDED--NONE C WRITTEN BY JAMES J. FILLIBEN, STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS, WASHINGTON, D.C. 20234 JUN 1972 C UPDATED FEB 1975 C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C CHARACTER*4 IGRAPH CHARACTER*4 BLANK,STAR,HYPHEN,ALPHAI DIMENSION Y(1) COMMON /BLOCK1/ IGRAPH(55,130) DIMENSION YLABLE(11) DIMENSION IX(25) C DATA BLANK,STAR,HYPHEN,ALPHAI/' ','*','-','I'/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=Y(1) DO60I=2,N IF(Y(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 90 CONTINUE 9 FORMAT(1H , '***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE PLOTCO SUBROUTINE HAS ALL ELEMENTS = ' , 1E15.8,' *****') 15 FORMAT(1H , '***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 PLOTCO SUBROUTINE IS NON-POSITIVE *****') 18 FORMAT(1H , '***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE PLOTCO SUBROUTINE HAS THE VALUE 1 *****') 47 FORMAT(1H , '***** THE VALUE OF THE ARGUMENT IS ',I8 ,' *****') C C-----START POINT----------------------------------------------------- C C DETERMINE THE Y VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS C YMIN=-1.0 YMAX=1.0 DO110I=1,11 YLABLE(I)=FLOAT(6-I)/5.0 110 CONTINUE C C DETERMINE DISTANCES BETWEEN HORIZONTAL PLOT POINTS AND DISTANCES BETWEEN C HASH MARKS ON THE X AXIS C IF(N.LE.24)IDEL=5 IF(25.LE.N.AND.N.LE.40)IDEL=3 IF(41.LE.N.AND.N.LE.60)IDEL=2 IF(61.LE.N)IDEL=1 IAXDEL=10 IF(N.LE.24)IAXDEL=5 IF(25.LE.N.AND.N.LE.40)IAXDEL=15 C C DETERMINE THE NUMBER OF PAGES THE PLOT WILL TAKE UP C NUMPAG=((N-1)/120)+1 C C OPERATE ON EACH PAGE C DO120IZ=1,NUMPAG C C DETERMINE THE X-AXIS VALUES C IXMIN=0 IXMAX=N IF(N.LE.24)GOTO130 IF(25.LE.N.AND.N.LE.40)GOTO135 IF(41.LE.N.AND.N.LE.60)GOTO140 IXMAX=120*IZ IXMIN=IXMAX-120 I=0 150 I=I+1 IX(I)=IXMIN+10*(I-1) IF(I.LT.13)GOTO150 GOTO145 130 DO131I=1,25 IX(I)=I-1 131 CONTINUE GOTO145 135 DO136I=1,9 IX(I)=5*(I-1) 136 CONTINUE GOTO145 140 DO141I=1,13 IX(I)=5*(I-1) 141 CONTINUE C C BLANK OUT THE GRAPH C 145 DO100I=1,55 DO200J=1,130 IGRAPH(I,J)=BLANK 200 CONTINUE 100 CONTINUE C C PRODUCE THE Y AXIS C DO300I=5,55 IGRAPH(I,10)=ALPHAI IGRAPH(I,130)=ALPHAI 300 CONTINUE DO350I=5,55,5 IGRAPH(I,10)=HYPHEN IGRAPH(I,130)=HYPHEN 350 CONTINUE C C PRODUCE THE X AXIS C DO400J=10,130 IGRAPH(55,J)=HYPHEN IGRAPH(30,J)=HYPHEN IGRAPH(5,J)=HYPHEN 400 CONTINUE DO450J=10,130,IAXDEL IGRAPH(55,J)=ALPHAI IGRAPH(5,J)=ALPHAI 450 CONTINUE C C DETERMINE THE (X,Y) PLOT POSITIONS C IMIN=IXMIN+1 IMAX=IXMAX IF(IMAX.GT.N)IMAX=N RATIOY=50.0/(YMAX-YMIN) DO600I=IMIN,IMAX MX=MOD(I,120) MX=MX*IDEL IF(MX.EQ.0)MX=120 MX=MX+10 MY=RATIOY*(Y(I)-YMIN)+0.5 MY=55-MY IGRAPH(MY,MX)=STAR JMAX=MAX0(MY,30) JMIN=MIN0(MY,30) DO650J=JMIN,JMAX IGRAPH(J,MX)=STAR 650 CONTINUE 600 CONTINUE C C WRITE OUT THE GRAPH C WRITE(IPR,998) IF(IZ.EQ.1)WRITE(IPR,702)N IF(IZ.GE.2)WRITE(IPR,704) WRITE(IPR,999) IF(N.LE.24)WRITE(IPR,707)(IX(I),I=1,25) IF(25.LE.N.AND.N.LE.40)WRITE(IPR,708)(IX(I),I=1,9) IF(41.LE.N)WRITE(IPR,709)(IX(I),I=1,13) DO700I=5,55 IFLAG=I-(I/5)*5 K=I/5 IF(IFLAG.NE.0)WRITE(IPR,705)(IGRAPH(I,J),J=1,130) IF(IFLAG.EQ.0)WRITE(IPR,706)YLABLE(K),(IGRAPH(I,J),J=10,130) 700 CONTINUE IF(N.LE.24)WRITE(IPR,707)(IX(I),I=1,25) IF(25.LE.N.AND.N.LE.40)WRITE(IPR,708)(IX(I),I=1,9) IF(41.LE.N)WRITE(IPR,709)(IX(I),I=1,13) 120 CONTINUE 702 FORMAT(' THE TOTAL NUMBER OF POINTS PLOTTED (ON ALL PAGES) IS ', 1I5) 704 FORMAT(1H , 'THE PLOT ON THIS PAGE IS A CONTINUATION OF THE PLOT 1ON THE PREVIOUS PAGE') 705 FORMAT(1H ,130A1) 706 FORMAT(1H ,F9.2,130A1) 707 FORMAT(1H ,6X,24(I4,1X),I4) 708 FORMAT(1H ,6X,8(I4,11X),I4) 709 FORMAT(1H ,6X,12(I4,6X),I4) 998 FORMAT(1H1) 999 FORMAT(1H ) RETURN END SUBROUTINE PLOTCT(Y,X,CHAR,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PLOTCT C C PURPOSE--THIS SUBROUTINE YIELDS A NARROW-WIDTH (71-CHARACTER) C PLOT OF Y(I) VERSUS X(I) WITH SPECIAL PLOTTING C CHARACTERS. C ITS NARROW WIDTH MAKES IT APPROPRIATE FOR USE ON A C TERMINAL. C THIS 'SPECIAL PLOTTING CHARACTER' CAPABILITY C ALLOWS THE DATA ANALYST TO INCORPORATE INFORMATION C FROM A THIRD VARIABLE (ASIDE FROM Y AND X) INTO C THE PLOT. C THE PLOT CHARACTER USED AT THE I-TH PLOTTING C POSITION (THAT IS, AT THE COORDINATE (X(I),Y(I))) C WILL BE C 1 IF CHAR(I) IS BETWEEN 0.5 AND 1.5 C 2 IF CHAR(I) IS BETWEEN 1.5 AND 2.5 C . C . C . C 9 IF CHAR(I) IS BETWEEN 8.5 AND 9.5 C 0 IF CHAR(I) IS BETWEEN 9.5 AND 10.5 C A IF CHAR(I) IS BETWEEN 10.5 AND 11.5 C B IF CHAR(I) IS BETWEEN 11.5 AND 12.5 C C IF CHAR(I) IS BETWEEN 12.5 AND 13.5 C . C . C . C W IF CHAR(I) IS BETWEEN 32.5 AND 33.5 C X IF CHAR(I) IS BETWEEN 33.5 AND 34.5 C Y IF CHAR(I) IS BETWEEN 34.5 AND 35.5 C Z IF CHAR(I) IS BETWEEN 35.5 AND 36.5 C X IF CHAR(I) IS ANY VALUE OUTSIDE THE RANGE C 0.5 TO 36.5. C INPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED VERTICALLY. C --X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED HORIZONTALLY. C --CHAR = THE SINGLE PRECISION VECTOR OF C OBSERVATIONS WHICH CONTROL THE C VALUE OF EACH INDIVIDUAL PLOT C CHARACTER. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR Y. C OUTPUT--A NARROW-WIDTH (71-CHARACTER) TERMINAL PLOT C OF Y(I) VERSUS X(I) WITH SPECIAL PLOT CHARACTERS. C THE BODY OF THE PLOT (NOT COUNTING AXIS VALUES C AND MARGINS) IS 25 ROWS (LINES) AND 49 COLUMNS. C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (Y), C THE HORIZONTAL AXIS VECTOR (X), C OR THE PLOT CHARACTER VECTOR (CHAR) WHICH ARE C EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE C PLOTTED. C THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM C OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y C (OR X, OR CHAR) ARE 'MISSING DATA', OR WHEN WE PURPOSELY C WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y C (OR X, OR CHAR) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT C WANT CERTAIN ELEMENTS IN Y (OR X, OR CHAR) TO BE C PLOTTED). C TO CAUSE SPECIFIC ELEMENTS IN Y (OR X, OR CHAR) TO BE C IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND C (BY, FOR EXAMPLE, USE OF THE REPLAC SUBROUTINE) C BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND C THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTC C SUBROUTINE. C --NOTE THAT THE STORAGE REQUIREMENTS FOR THIS C (AND THE OTHER) TERMINAL PLOT SUBROUTINESS ARE . C VERY SMALL. C THIS IS DUE TO THE 'ONE LINE AT A TIME' ALGORITHM C EMPLOYED FOR THE PLOT. C REFERENCES--FILLIBEN, 'STATISTICAL ANALYSIS OF INTERLAB C FATIGUE TIME DATA', UNPUBLISHED MANUSCRIPT C (AVAILABLE FROM AUTHOR) C PRESENTED AT THE 'COMPUTER-ASSISTED DATA C ANALYSIS' SESSION AT THE NATIONAL MEETING C OF THE AMERICAN STATISTICAL ASSOCIATION, C NEW YORK CITY, DECEMBER 27-30, 1973. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--FEBRUARY 1974. C UPDATED --APRIL 1974. C UPDATED --OCTOBER 1974. C UPDATED --OCTOBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1977. C C--------------------------------------------------------------------- C CHARACTER*4 ILINE CHARACTER*4 IPLOTC CHARACTER*4 JPLOTC CHARACTER*4 IAXISC CHARACTER*4 SBNAM1,SBNAM2 CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 CHARACTER*4 ALPH41,ALPH42 CHARACTER*4 BLANK,HYPHEN,ALPHAI C DIMENSION Y(1) DIMENSION X(1) DIMENSION CHAR(1) DIMENSION ILINE(72),XLABLE(10) DIMENSION IPLOTC(37) C DATA SBNAM1,SBNAM2/'PLOT','CT '/ DATA ALPH11,ALPH12/'FIRS','T '/ DATA ALPH21,ALPH22/'SECO','ND '/ DATA ALPH31,ALPH32/'THIR','D '/ DATA ALPH41,ALPH42/'FOUR','TH '/ DATA BLANK,HYPHEN,ALPHAI/' ','-','I'/ DATA IPLOTC(1),IPLOTC(2),IPLOTC(3),IPLOTC(4),IPLOTC(5), 1IPLOTC(6),IPLOTC(7),IPLOTC(8),IPLOTC(9),IPLOTC(10), 1IPLOTC(11),IPLOTC(12),IPLOTC(13),IPLOTC(14),IPLOTC(15), 1IPLOTC(16),IPLOTC(17),IPLOTC(18),IPLOTC(19),IPLOTC(20), 1IPLOTC(21),IPLOTC(22),IPLOTC(23),IPLOTC(24),IPLOTC(25), 1IPLOTC(26),IPLOTC(27),IPLOTC(28),IPLOTC(29),IPLOTC(30), 1IPLOTC(31),IPLOTC(32),IPLOTC(33),IPLOTC(34),IPLOTC(35), 1IPLOTC(36),IPLOTC(37) 1/'1','2','3','4','5','6','7','8','9','0','A','B','C','D','E','F', 1'G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V', 1'W','X','Y','Z','X'/ C IPR=6 CUTOFF=(10.0**10)-1000.0 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO52 GOTO54 52 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,20)N WRITE(IPR,5) RETURN 54 CONTINUE IF(N.EQ.1)GOTO56 GOTO58 56 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,22)N WRITE(IPR,5) RETURN 58 CONTINUE C HOLD=Y(1) DO60I=2,N IF(Y(I).NE.HOLD)GOTO62 60 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 62 CONTINUE HOLD=X(1) DO64I=2,N IF(X(I).NE.HOLD)GOTO66 64 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 66 CONTINUE HOLD=CHAR(1) DO68I=2,N IF(CHAR(I).NE.HOLD)GOTO70 68 CONTINUE WRITE(IPR,5) WRITE(IPR,11) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) 70 CONTINUE C DO76I=1,N IF(Y(I).LT.CUTOFF)GOTO78 76 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 78 CONTINUE DO80I=1,N IF(X(I).LT.CUTOFF)GOTO82 80 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 82 CONTINUE DO84I=1,N IF(CHAR(I).LT.CUTOFF)GOTO86 84 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 86 CONTINUE C N2=0 DO96I=1,N IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF.AND.CHAR(I).LT.CUTOFF)GOTO98 GOTO96 98 N2=N2+1 IF(N2.GE.2)GOTO99 96 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 WRITE(IPR,19)SBNAM1,SBNAM2 WRITE(IPR,40) WRITE(IPR,41)N2 WRITE(IPR,5) RETURN 99 CONTINUE C 5 FORMAT(1H ,'**************************************************', 1'********************') 10 FORMAT(1H ,' FATAL ERROR ') 11 FORMAT(1H ,' NON-FATAL DIAGNOSTIC ') 15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4, 1' SUBROUTINE') 18 FORMAT(1H ,'THE ',A4,A4,2H, ,A4,A4,', AND ',A4,A4) 19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE') 20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,')') 22 FORMAT(1H ,'HAS THE VALUE 1') 30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8) 32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF') 33 FORMAT(1H ,'VALUE OF ',E15.8) 40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 1' EXCLUDED FROM THE PLOT.') 41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.') C C-----START POINT----------------------------------------------------- C C DEFINE THE NUMBER OF ROWS AND COLUMNS WITHIN THE PLOT--THIS HAS C BEEN SET TO 25 ROWS AND 49 COLUMNS. C NUMROW=25 NUMCOL=49 ANUMR=NUMROW ANUMRM=NUMROW-1 ANUMCM=NUMCOL-1 NUMR25=(NUMROW/4)+1 NUMR50=(NUMROW/2)+1 NUMR75=3*(NUMROW/4)+1 IXDEL=(NUMCOL-1)/4 NUMLAB=5 ANUMLM=NUMLAB-1 C C SKIP A LINE, WRITE OUT AN IDENTIFYING LINE FOR THE TYPE OF PLOT, C WRITE OUT THE TOP HORIZONTAL AXIS OF THE PLOT, AND SKIP 1 LINE C FOR A MARGIN WITHIN THE PLOT. C WRITE(IPR,999) WRITE(IPR,205) DO100ICOL=1,NUMCOL ILINE(ICOL)=HYPHEN 100 CONTINUE DO200ICOL=1,NUMCOL,IXDEL ILINE(ICOL)=ALPHAI 200 CONTINUE WRITE(IPR,305)(ILINE(I),I=1,NUMCOL) WRITE(IPR,310)BLANK C C DETERMINE THE MIN AND MAX VALUES OF Y, AND OF X. C DO250I=1,N IF(Y(I).GE.CUTOFF)GOTO250 IF(X(I).GE.CUTOFF)GOTO250 IF(CHAR(I).GE.CUTOFF)GOTO250 YMIN=Y(I) YMAX=Y(I) XMIN=X(I) XMAX=X(I) GOTO270 250 CONTINUE 270 DO300I=1,N IF(Y(I).GE.CUTOFF)GOTO300 IF(X(I).GE.CUTOFF)GOTO300 IF(CHAR(I).GE.CUTOFF)GOTO300 IF(Y(I).LT.YMIN)YMIN=Y(I) IF(Y(I).GT.YMAX)YMAX=Y(I) IF(X(I).LT.XMIN)XMIN=X(I) IF(X(I).GT.XMAX)XMAX=X(I) 300 CONTINUE DELY=YMAX-YMIN DELX=XMAX-XMIN YWIDTH=DELY/ANUMRM XWIDTH=DELX/ANUMCM C C DETERMINE AND WRITE OUT THE PLOT POSITIONS ONE LINE AT A TIME. C ALSO DETERMINE THE APPROPRIATE PLOT CHARACTERS. C DO400IROW=1,NUMROW DO500ICOL=1,NUMCOL ILINE(ICOL)=BLANK 500 CONTINUE AIROW=IROW YUPPER=YMAX+(1.5-AIROW)*YWIDTH YLABLE=YMAX+(1.0-AIROW)*YWIDTH YLOWER=YMAX+(0.5-AIROW)*YWIDTH IF(IROW.EQ.NUMROW)YLABLE=YMIN DO600I=1,N IF(Y(I).GE.CUTOFF)GOTO600 IF(X(I).GE.CUTOFF)GOTO600 IF(CHAR(I).GE.CUTOFF)GOTO600 IF(YLOWER.LE.Y(I).AND.Y(I).LT.YUPPER)GOTO650 GOTO600 650 ICOL=((X(I)-XMIN)/XWIDTH)+1.5 IA=CHAR(I)+0.5 IF(1.LE.IA.AND.IA.LE.36)GOTO630 620 JPLOTC=IPLOTC(37) GOTO640 630 JPLOTC=IPLOTC(IA) 640 ILINE(ICOL)=JPLOTC 600 CONTINUE ICOLMX=1 DO700ICOL=1,NUMCOL IF(ILINE(ICOL).NE.BLANK)ICOLMX=ICOL 700 CONTINUE IAXISC=ALPHAI IF(IROW.EQ.1.OR.IROW.EQ.NUMROW)IAXISC=HYPHEN IF(IROW.EQ.NUMR25.OR.IROW.EQ.NUMR50.OR.IROW.EQ.NUMR75) 1IAXISC=HYPHEN WRITE(IPR,710)YLABLE,IAXISC,(ILINE(ICOL),ICOL=1,ICOLMX) 400 CONTINUE C C SKIP 1 LINE FOR A BOTTOM MARGIN WITHIN THE PLOT, WRITE OUT THE C BOTTOM HORIZONTAL AXIS, AND WRITE OUT THE X AXIS LABLES. C WRITE(IPR,310)BLANK DO800ICOL=1,NUMCOL ILINE(ICOL)=HYPHEN 800 CONTINUE DO900ICOL=1,NUMCOL,IXDEL ILINE(ICOL)=ALPHAI 900 CONTINUE WRITE(IPR,305)(ILINE(ICOL),ICOL=1,NUMCOL) DO1000I=1,NUMLAB AIM1=I-1 XLABLE(I)=XMIN+(AIM1/ANUMLM)*DELX 1000 CONTINUE WRITE(IPR,910)(XLABLE(I),I=1,NUMLAB) C 205 FORMAT(1H ,'THE FOLLOWING IS A PLOT OF Y(I) VERSUS X(I)') 305 FORMAT(1H ,18X,54A1) 310 FORMAT(1H ,15X,A1) 710 FORMAT(1H ,E14.7,1X,A1,2X,50A1) 910 FORMAT(1H ,9X,5E12.4) 999 FORMAT(1H ) C RETURN END SUBROUTINE PLOTS(Y,X,N,D,DMIN,DMAX) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PLOTS C C PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT C OF Y(I) VERSUS X(I): C 1) WITH ONLY THOSE POINTS (X(I),Y(I)) PLOTTED C FOR WHICH THE CORRESPONDING VALUE OF D(I) C IS BETWEEN THE SPECIFIED VALUES OF DMIN AND DMAX. C C THE USE OF THE SUBSET DEFINITION VECTOR D C GIVES THE DATA ANALYST THE CAPABILITY OF C PLOTTING SUBSETS OF THE DATA, C WHERE THE SUBSET IS DEFINED C BY VALUES IN THE VECTOR D. C C INPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED VERTICALLY. C --X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED HORIZONTALLY. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR Y. C --D = THE SINGLE PRECISION VECTOR C WHICH 'DEFINES' THE VARIOUS C POSSIBLE SUBSETS. C --DMIN = THE SINGLE PRECISION VALUE C WHICH DEFINES THE LOWER BOUND C (INCLUSIVELY) OF THE PARTICULAR C SUBSET OF INTEREST TO BE PLOTTED. C --DMAX = THE SINGLE PRECISION VALUE C WHICH DEFINES THE UPPER BOUND C (INCLUSIVELY) OF THE PARTICULAR C SUBSET OF INTEREST TO BE PLOTTED. C OUTPUT--A ONE-PAGE PRINTER PLOT OF Y(I) VERSUS X(I), C FOR ONLY OF A SPECIFIED SUBSET OF THE DATA. C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--FOR A GIVEN DUMMY INDEX I, C IF D(I) IS SMALLER THAN DMIN OR LARGER THAN DMAX, C THEN THE CORRESPONDING POINT (X(I),Y(I)) C WILL NOT BE PLOTTED. C --VALUES IN THE VERTICAL AXIS VECTOR (Y) C OR THE HORIZONTAL AXIS VECTOR (X) WHICH ARE C EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE C PLOTTED. C THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM C OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y C (OR X) ARE 'MISSING DATA', OR WHEN WE PURPOSELY C WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y C (OR X) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT C WANT CERTAIN ELEMENTS IN Y (OR X) TO BE PLOTTED). C TO CAUSE SPECIFIC ELEMENTS IN Y (OR X) TO BE C IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND C (BY, FOR EXAMPLE, USE OF THE REPLAC SUBROUTINE) C BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND C THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOT C SUBROUTINE. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--OCTOBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1977. C C--------------------------------------------------------------------- C CHARACTER*4 IGRAPH CHARACTER*4 SBNAM1,SBNAM2 CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 CHARACTER*4 ALPH41,ALPH42 CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL C DIMENSION Y(1) DIMENSION X(1) DIMENSION D(1) DIMENSION YLABLE(11) COMMON /BLOCK1/ IGRAPH(55,130) C DATA SBNAM1,SBNAM2/'PLOT','S '/ DATA ALPH11,ALPH12/'FIRS','T '/ DATA ALPH21,ALPH22/'SECO','ND '/ DATA ALPH31,ALPH32/'THIR','D '/ DATA ALPH41,ALPH42/'FOUR','TH '/ DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/ DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/ C IPR=6 CUTOFF=(10.0**10)-1000.0 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C WRITE(IPR,998) IF(N.LT.1)GOTO52 GOTO54 52 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,20)N WRITE(IPR,5) RETURN 54 CONTINUE IF(N.EQ.1)GOTO56 GOTO58 56 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,22)N WRITE(IPR,5) RETURN 58 CONTINUE C HOLD=Y(1) DO60I=2,N IF(Y(I).NE.HOLD)GOTO62 60 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 62 CONTINUE HOLD=X(1) DO64I=2,N IF(X(I).NE.HOLD)GOTO66 64 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 66 CONTINUE HOLD=D(1) DO72I=2,N IF(D(I).NE.HOLD)GOTO74 72 CONTINUE WRITE(IPR,5) WRITE(IPR,11) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) 74 CONTINUE C DO76I=1,N IF(Y(I).LT.CUTOFF)GOTO78 76 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 78 CONTINUE DO80I=1,N IF(X(I).LT.CUTOFF)GOTO82 80 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 82 CONTINUE DO88I=1,N IF(D(I).LT.CUTOFF)GOTO90 88 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 90 CONTINUE C DO92I=1,N IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)GOTO94 92 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,34) WRITE(IPR,35)DMIN,DMAX WRITE(IPR,36) WRITE(IPR,5) RETURN 94 CONTINUE C N2=0 DO96I=1,N IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF.AND.D(I).LT.CUTOFF)GOTO98 GOTO96 98 IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)N2=N2+1 IF(N2.GE.2)GOTO99 96 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22,ALPH41,ALPH42 WRITE(IPR,19)SBNAM1,SBNAM2 WRITE(IPR,40) WRITE(IPR,41)N2 WRITE(IPR,5) RETURN 99 CONTINUE C 5 FORMAT(1H ,'**************************************************', 1'********************') 10 FORMAT(1H ,' FATAL ERROR ') 11 FORMAT(1H ,' NON-FATAL DIAGNOSTIC ') 15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4, 1' SUBROUTINE') 18 FORMAT(1H ,'THE ',A4,A4,2H, ,A4,A4,', AND ',A4,A4) 19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE') 20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,')') 22 FORMAT(1H ,'HAS THE VALUE 1') 30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8) 32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF') 33 FORMAT(1H ,'VALUE OF ',E15.8) 34 FORMAT(1H ,'HAS ALL ELEMENTS OUTSIDE THE INTERVAL') 35 FORMAT(1H ,'(',E15.8,',',E15.8,')',' AS DEFINED BY') 36 FORMAT(1H ,'THE FIFTH AND SIXTH INPUT ARGUMENTS.') 40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 1' EXCLUDED FROM THE PLOT.') 41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.') C C-----START POINT----------------------------------------------------- C C DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS C DO200I=1,N IF(Y(I).GE.CUTOFF)GOTO200 IF(X(I).GE.CUTOFF)GOTO200 IF(D(I).LT.DMIN)GOTO200 IF(D(I).GT.DMAX)GOTO200 YMIN=Y(I) YMAX=Y(I) GOTO250 200 CONTINUE 250 DO300I=1,N IF(Y(I).GE.CUTOFF)GOTO300 IF(X(I).GE.CUTOFF)GOTO300 IF(D(I).LT.DMIN)GOTO300 IF(D(I).GT.DMAX)GOTO300 IF(Y(I).LT.YMIN)YMIN=Y(I) IF(Y(I).GT.YMAX)YMAX=Y(I) 300 CONTINUE DO400I=1,9 AIM1=I-1 YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN) 400 CONTINUE C C DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS C DETERMINE XMIN, XMAX, XMID, X25 (=THE 25% POINT), AND C X75 (=THE 75% POINT) C DO600I=1,N IF(Y(I).GE.CUTOFF)GOTO600 IF(X(I).GE.CUTOFF)GOTO600 IF(D(I).LT.DMIN)GOTO600 IF(D(I).GT.DMAX)GOTO600 XMIN=X(I) XMAX=X(I) GOTO650 600 CONTINUE 650 DO700I=1,N IF(Y(I).GE.CUTOFF)GOTO700 IF(X(I).GE.CUTOFF)GOTO700 IF(D(I).LT.DMIN)GOTO700 IF(D(I).GT.DMAX)GOTO700 IF(X(I).LT.XMIN)XMIN=X(I) IF(X(I).GT.XMAX)XMAX=X(I) 700 CONTINUE XMID=(XMIN+XMAX)/2.0 X25=0.75*XMIN+0.25*XMAX X75=0.25*XMIN+0.75*XMAX C C BLANK OUT THE GRAPH C DO1100I=1,45 DO1200J=1,109 IGRAPH(I,J)=BLANK 1200 CONTINUE 1100 CONTINUE C C PRODUCE THE VERTICAL AXES C DO1300I=3,43 IGRAPH(I,5)=ALPHAI IGRAPH(I,109)=ALPHAI 1300 CONTINUE DO1400I=3,43,5 IGRAPH(I,5)=HYPHEN IGRAPH(I,109)=HYPHEN 1400 CONTINUE IGRAPH(3,1)=EQUAL IGRAPH(3,2)=ALPHAM IGRAPH(3,3)=ALPHAA IGRAPH(3,4)=ALPHAX IGRAPH(23,1)=EQUAL IGRAPH(23,2)=ALPHAM IGRAPH(23,3)=ALPHAI IGRAPH(23,4)=ALPHAD IGRAPH(43,1)=EQUAL IGRAPH(43,2)=ALPHAM IGRAPH(43,3)=ALPHAI IGRAPH(43,4)=ALPHAN C C PRODUCE THE HORIZONTAL AXES C DO1500J=7,107 IGRAPH(1,J)=HYPHEN IGRAPH(45,J)=HYPHEN 1500 CONTINUE DO1600J=7,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1600 CONTINUE DO1700J=20,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1700 CONTINUE C C DETERMINE THE (X,Y) PLOT POSITIONS C RATIOY=40.0/(YMAX-YMIN) RATIOX=100.0/(XMAX-XMIN) DO1800I=1,N IF(Y(I).GE.CUTOFF)GOTO1800 IF(X(I).GE.CUTOFF)GOTO1800 IF(D(I).LT.DMIN)GOTO1800 IF(D(I).GT.DMAX)GOTO1800 MX=RATIOX*(X(I)-XMIN)+0.5 MX=MX+7 MY=RATIOY*(Y(I)-YMIN)+0.5 MY=43-MY IGRAPH(MY,MX)=ALPHAX 1800 CONTINUE C C WRITE OUT THE GRAPH C DO2100I=1,45 IP2=I+2 IFLAG=IP2-(IP2/5)*5 K=IP2/5 IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109) IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109) 2100 CONTINUE WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX C 2105 FORMAT(1H ,20X,109A1) 2106 FORMAT(1H ,F20.7,109A1) 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7) 998 FORMAT(1H1) C RETURN END SUBROUTINE PLOTSC(Y,X,CHAR,N,D,DMIN,DMAX) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PLOTSC C C PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT C OF Y(I) VERSUS X(I): C 1) WITH SPECIAL PLOT CHARACTERS; AND C 2) WITH ONLY THOSE POINTS (X(I),Y(I)) PLOTTED C FOR WHICH THE CORRESPONDING VALUE OF D(I) C IS BETWEEN THE SPECIFIED VALUES OF DMIN AND DMAX. C C THE 'SPECIAL PLOTTING CHARACTER' CAPABILITY C ALLOWS THE DATA ANALYST TO INCORPORATE INFORMATION C FROM A THIRD VARIABLE (ASIDE FROM Y AND X) INTO C THE PLOT. C THE PLOT CHARACTER USED AT THE I-TH PLOTTING C POSITION (THAT IS, AT THE COORDINATE (X(I),Y(I))) C WILL BE C 1 IF CHAR(I) IS BETWEEN 0.5 AND 1.5 C 2 IF CHAR(I) IS BETWEEN 1.5 AND 2.5 C . C . C . C 9 IF CHAR(I) IS BETWEEN 8.5 AND 9.5 C 0 IF CHAR(I) IS BETWEEN 9.5 AND 10.5 C A IF CHAR(I) IS BETWEEN 10.5 AND 11.5 C B IF CHAR(I) IS BETWEEN 11.5 AND 12.5 C C IF CHAR(I) IS BETWEEN 12.5 AND 13.5 C . C . C . C W IF CHAR(I) IS BETWEEN 32.5 AND 33.5 C X IF CHAR(I) IS BETWEEN 33.5 AND 34.5 C Y IF CHAR(I) IS BETWEEN 34.5 AND 35.5 C Z IF CHAR(I) IS BETWEEN 35.5 AND 36.5 C X IF CHAR(I) IS ANY VALUE OUTSIDE THE RANGE C 0.5 TO 36.5. C THE USE OF THE SUBSET DEFINTION VECTOR D C GIVES THE DATA ANALYST THE CAPABILITY OF C PLOTTING SUBSETS OF THE DATA, C WHERE THE SUBSET IS DEFINED C BY VALUES IN THE VECTOR D. C C INPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED VERTICALLY. C --X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED HORIZONTALLY. C --CHAR = THE SINGLE PRECISION VECTOR OF C OBSERVATIONS WHICH CONTROL THE C VALUE OF EACH INDIVIDUAL PLOT C CHARACTER. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR Y. C --D = THE SINGLE PRECISION VECTOR C WHICH 'DEFINES' THE VARIOUS C POSSIBLE SUBSETS. C --DMIN = THE SINGLE PRECISION VALUE C WHICH DEFINES THE LOWER BOUND C (INCLUSIVELY) OF THE PARTICULAR C SUBSET OF INTEREST TO BE PLOTTED. C --DMAX = THE SINGLE PRECISION VALUE C WHICH DEFINES THE UPPER BOUND C (INCLUSIVELY) OF THE PARTICULAR C SUBSET OF INTEREST TO BE PLOTTED. C OUTPUT--A ONE-PAGE PRINTER PLOT OF Y(I) VERSUS X(I), C WITH SPECIAL PLOT CHARACTERS, C AND FOR ONLY OF A SPECIFIED SUBSET OF THE DATA. C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--FOR A GIVEN DUMMY INDEX I, C IF D(I) IS SMALLER THAN DMIN OR LARGER THAN DMAX, C THEN THE CORRESPONDING POINT (X(I),Y(I)) C WILL NOT BE PLOTTED. C --VALUES IN THE VERTICAL AXIS VECTOR (Y), C THE HORIZONTAL AXIS VECTOR (X), C OR THE PLOT CHARACTER VECTOR (CHAR) WHICH ARE C EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE C PLOTTED. C THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM C OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y C (OR X, OR CHAR) ARE 'MISSING DATA', OR WHEN WE PURPOSELY C WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y C (OR X, OR CHAR) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT C WANT CERTAIN ELEMENTS IN Y (OR X, OR CHAR) TO BE C PLOTTED). C TO CAUSE SPECIFIC ELEMENTS IN Y (OR X, OR CHAR) TO BE C IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND C (BY, FOR EXAMPLE, USE OF THE REPLAC SUBROUTINE) C BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND C THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTC C SUBROUTINE. C REFERENCES--FILLIBEN, 'STATISTICAL ANALYSIS OF INTERLAB C FATIGUE TIME DATA', UNPUBLISHED MANUSCRIPT C (AVAILABLE FROM AUTHOR) C PRESENTED AT THE 'COMPUTER-ASSISTED DATA C ANALYSIS' SESSION AT THE NATIONAL MEETING C OF THE AMERICAN STATISTICAL ASSOCIATION, C NEW YORK CITY, DECEMBER 27-30, 1973. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--OCTOBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C UPDATED --FEBRUARY 1977. C C--------------------------------------------------------------------- C CHARACTER*4 IGRAPH CHARACTER*4 IPLOTC CHARACTER*4 SBNAM1,SBNAM2 CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 CHARACTER*4 ALPH41,ALPH42,ALPH51,ALPH52 CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL C DIMENSION Y(1) DIMENSION X(1) DIMENSION D(1) DIMENSION CHAR(1) DIMENSION YLABLE(11) DIMENSION IPLOTC(37) COMMON /BLOCK1/ IGRAPH(55,130) C DATA SBNAM1,SBNAM2/'PLOT','SC '/ DATA ALPH11,ALPH12/'FIRS','T '/ DATA ALPH21,ALPH22/'SECO','ND '/ DATA ALPH31,ALPH32/'THIR','D '/ DATA ALPH41,ALPH42/'FOUR','TH '/ DATA ALPH51,ALPH52/'FIFT','H '/ DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/ DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/ DATA IPLOTC(1),IPLOTC(2),IPLOTC(3),IPLOTC(4),IPLOTC(5), 1IPLOTC(6),IPLOTC(7),IPLOTC(8),IPLOTC(9),IPLOTC(10), 1IPLOTC(11),IPLOTC(12),IPLOTC(13),IPLOTC(14),IPLOTC(15), 1IPLOTC(16),IPLOTC(17),IPLOTC(18),IPLOTC(19),IPLOTC(20), 1IPLOTC(21),IPLOTC(22),IPLOTC(23),IPLOTC(24),IPLOTC(25), 1IPLOTC(26),IPLOTC(27),IPLOTC(28),IPLOTC(29),IPLOTC(30), 1IPLOTC(31),IPLOTC(32),IPLOTC(33),IPLOTC(34),IPLOTC(35), 1IPLOTC(36),IPLOTC(37) 1/'1','2','3','4','5','6','7','8','9','0','A','B','C','D','E','F', 1'G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V', 1'W','X','Y','Z','X'/ C IPR=6 CUTOFF=(10.0**10)-1000.0 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C WRITE(IPR,998) IF(N.LT.1)GOTO52 GOTO54 52 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,20)N WRITE(IPR,5) RETURN 54 CONTINUE IF(N.EQ.1)GOTO56 GOTO58 56 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,22)N WRITE(IPR,5) RETURN 58 CONTINUE C HOLD=Y(1) DO60I=2,N IF(Y(I).NE.HOLD)GOTO62 60 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 62 CONTINUE HOLD=X(1) DO64I=2,N IF(X(I).NE.HOLD)GOTO66 64 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 66 CONTINUE HOLD=CHAR(1) DO68I=2,N IF(CHAR(I).NE.HOLD)GOTO70 68 CONTINUE WRITE(IPR,5) WRITE(IPR,11) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) 70 CONTINUE HOLD=D(1) DO72I=2,N IF(D(I).NE.HOLD)GOTO74 72 CONTINUE WRITE(IPR,5) WRITE(IPR,11) WRITE(IPR,15)ALPH51,ALPH52,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) 74 CONTINUE C DO76I=1,N IF(Y(I).LT.CUTOFF)GOTO78 76 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 78 CONTINUE DO80I=1,N IF(X(I).LT.CUTOFF)GOTO82 80 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 82 CONTINUE DO84I=1,N IF(CHAR(I).LT.CUTOFF)GOTO86 84 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 86 CONTINUE DO88I=1,N IF(D(I).LT.CUTOFF)GOTO90 88 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH51,ALPH52,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 90 CONTINUE C DO92I=1,N IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)GOTO94 92 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH51,ALPH52,SBNAM1,SBNAM2 WRITE(IPR,34) WRITE(IPR,35)DMIN,DMAX WRITE(IPR,36) WRITE(IPR,5) RETURN 94 CONTINUE C N2=0 DO96I=1,N IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF.AND.CHAR(I).LT.CUTOFF.AND. 1D(I).LT.CUTOFF)GOTO98 GOTO96 98 IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)N2=N2+1 IF(N2.GE.2)GOTO99 96 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32, 1ALPH51,ALPH52 WRITE(IPR,19)SBNAM1,SBNAM2 WRITE(IPR,40) WRITE(IPR,41)N2 WRITE(IPR,5) RETURN 99 CONTINUE C 5 FORMAT(1H ,'**************************************************', 1'********************') 10 FORMAT(1H ,' FATAL ERROR ') 11 FORMAT(1H ,' NON-FATAL DIAGNOSTIC ') 15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4, 1' SUBROUTINE') 18 FORMAT(1H ,'THE ',A4,A4,', ',A4,A4,', ',A4,A4,', AND ',A4,A4) 19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE') 20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,')') 22 FORMAT(1H ,'HAS THE VALUE 1') 30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8) 32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF') 33 FORMAT(1H ,'VALUE OF ',E15.8) 34 FORMAT(1H ,'HAS ALL ELEMENTS OUTSIDE THE INTERVAL') 35 FORMAT(1H ,'(',E15.8,',',E15.8,')',' AS DEFINED BY') 36 FORMAT(1H ,'THE SIXTH AND SEVENTH INPUT ARGUMENTS.') 40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 1' EXCLUDED FROM THE PLOT.') 41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.') C C-----START POINT----------------------------------------------------- C C DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS C DO200I=1,N IF(Y(I).GE.CUTOFF)GOTO200 IF(X(I).GE.CUTOFF)GOTO200 IF(CHAR(I).GE.CUTOFF)GOTO200 IF(D(I).LT.DMIN)GOTO200 IF(D(I).GT.DMAX)GOTO200 YMIN=Y(I) YMAX=Y(I) GOTO250 200 CONTINUE 250 DO300I=1,N IF(Y(I).GE.CUTOFF)GOTO300 IF(X(I).GE.CUTOFF)GOTO300 IF(CHAR(I).GE.CUTOFF)GOTO300 IF(D(I).LT.DMIN)GOTO300 IF(D(I).GT.DMAX)GOTO300 IF(Y(I).LT.YMIN)YMIN=Y(I) IF(Y(I).GT.YMAX)YMAX=Y(I) 300 CONTINUE DO400I=1,9 AIM1=I-1 YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN) 400 CONTINUE C C DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS C DETERMINE XMIN, XMAX, XMID, X25 (=THE 25% POINT), AND C X75 (=THE 75% POINT) C DO600I=1,N IF(Y(I).GE.CUTOFF)GOTO600 IF(X(I).GE.CUTOFF)GOTO600 IF(CHAR(I).GE.CUTOFF)GOTO600 IF(D(I).LT.DMIN)GOTO600 IF(D(I).GT.DMAX)GOTO600 XMIN=X(I) XMAX=X(I) GOTO650 600 CONTINUE 650 DO700I=1,N IF(Y(I).GE.CUTOFF)GOTO700 IF(X(I).GE.CUTOFF)GOTO700 IF(CHAR(I).GE.CUTOFF)GOTO700 IF(D(I).LT.DMIN)GOTO700 IF(D(I).GT.DMAX)GOTO700 IF(X(I).LT.XMIN)XMIN=X(I) IF(X(I).GT.XMAX)XMAX=X(I) 700 CONTINUE XMID=(XMIN+XMAX)/2.0 X25=0.75*XMIN+0.25*XMAX X75=0.25*XMIN+0.75*XMAX C C BLANK OUT THE GRAPH C DO1100I=1,45 DO1200J=1,109 IGRAPH(I,J)=BLANK 1200 CONTINUE 1100 CONTINUE C C PRODUCE THE VERTICAL AXES C DO1300I=3,43 IGRAPH(I,5)=ALPHAI IGRAPH(I,109)=ALPHAI 1300 CONTINUE DO1400I=3,43,5 IGRAPH(I,5)=HYPHEN IGRAPH(I,109)=HYPHEN 1400 CONTINUE IGRAPH(3,1)=EQUAL IGRAPH(3,2)=ALPHAM IGRAPH(3,3)=ALPHAA IGRAPH(3,4)=ALPHAX IGRAPH(23,1)=EQUAL IGRAPH(23,2)=ALPHAM IGRAPH(23,3)=ALPHAI IGRAPH(23,4)=ALPHAD IGRAPH(43,1)=EQUAL IGRAPH(43,2)=ALPHAM IGRAPH(43,3)=ALPHAI IGRAPH(43,4)=ALPHAN C C PRODUCE THE HORIZONTAL AXES C DO1500J=7,107 IGRAPH(1,J)=HYPHEN IGRAPH(45,J)=HYPHEN 1500 CONTINUE DO1600J=7,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1600 CONTINUE DO1700J=20,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1700 CONTINUE C C DETERMINE THE (X,Y) PLOT POSITIONS C RATIOY=40.0/(YMAX-YMIN) RATIOX=100.0/(XMAX-XMIN) DO1800I=1,N IF(Y(I).GE.CUTOFF)GOTO1800 IF(X(I).GE.CUTOFF)GOTO1800 IF(CHAR(I).GE.CUTOFF)GOTO1800 IF(D(I).LT.DMIN)GOTO1800 IF(D(I).GT.DMAX)GOTO1800 MX=RATIOX*(X(I)-XMIN)+0.5 MX=MX+7 MY=RATIOY*(Y(I)-YMIN)+0.5 MY=43-MY IARG=37 IF(0.5.LT.CHAR(I).AND.CHAR(I).LT.36.5)IARG=CHAR(I)+0.5 IGRAPH(MY,MX)=IPLOTC(IARG) 1800 CONTINUE C C WRITE OUT THE GRAPH C DO2100I=1,45 IP2=I+2 IFLAG=IP2-(IP2/5)*5 K=IP2/5 IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109) IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109) 2100 CONTINUE WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX C 2105 FORMAT(1H ,20X,109A1) 2106 FORMAT(1H ,F20.7,109A1) 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7) 998 FORMAT(1H1) C RETURN END SUBROUTINE PLOTSP(Y,N,IDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PLOTSP C C THIS ROUTINE YIELDS A ONE-PAGE PLOT OF THE SPECTRUM, ALONG WITH UPPER C AND LOWER LIMITS OF THE SPECTRUM. C THE CONVENTION HAS BEEN FOLLOWED THAT IF THE INTEGER INPUT PARAMETER IDF C HAS THE VALUE 0, THEN NO CONFIDENCE LIMITS WILL BE COMPUTED AND ONLY THE C SPECTRUM ITSELF WILL BE PLOTTED OUT. C MULTIPLE PLOT POINTS ARE NOT INDICATED. C THE FIRST POINT WILL BE PLOTTED ON THE LEFT VERTICAL AXIS C THE LAST POINT WILL BE PLOTTED ON THE RIGHT VERTICAL AXIS C THERE IS NO RESTRICTION ON THE MAXIMUM VALUE OF N FOR THIS ROUTINE. C PRINTING--YES C SUBROUTINES NEEDED--CHSPPF. C WRITTEN BY JAMES J. FILLIBEN, STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS, WASHINGTON, D.C. 20234 JUN 1972 C UPDATED FEB 1975 C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C CHARACTER*4 IGRAPH CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX,DOT C DIMENSION Y(1) DIMENSION YLABLE(11) COMMON /BLOCK1/ IGRAPH(55,130) C DATA BLANK,HYPHEN,ALPHAI/' ','-','I'/ DATA ALPHAX/'X'/ DATA DOT/'.'/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=Y(1) DO60I=2,N IF(Y(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 90 CONTINUE 9 FORMAT(1H , '***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE PLOTSP SUBROUTINE HAS ALL ELEMENTS = ', 1E15.8,' *****') 15 FORMAT(1H , '***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 PLOTSP SUBROUTINE IS NON-POSITIVE *****') 18 FORMAT(1H , '***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE PLOTSP SUBROUTINE HAS THE VALUE 1 *****') 47 FORMAT(1H , '***** THE VALUE OF THE ARGUMENT IS ',I8 ,' *****') C C-----START POINT----------------------------------------------------- C AN=N C C DETERMINE THE MINIMUM AND MAXIMUM OF THE SPECTRUM C SPMIN=Y(1) SPMAX=Y(1) DO100I=2,N IF(Y(I).LT.SPMIN)SPMIN=Y(I) IF(Y(I).GT.SPMAX)SPMAX=Y(I) 100 CONTINUE C C COMPUTE THE MAXIMUM VALUE OF THE UPPER CONFIDENCE LIMIT C AND THE MINIMUM VALUE OF THE LOWER CONFIDENCE LIMIT--THESE TWO VALUES C WILL DEFINE THE RANGE OF VALUES TO BE LISTED ON THE VERTICAL AXIS C IF(IDF.EQ.0)GOTO150 DF=IDF CALL CHSPPF(.975,IDF,PP975) CALL CHSPPF(.025,IDF,PP025) YMAX=DF*SPMAX/PP025 YMIN=DF*SPMIN/PP975 GOTO160 150 YMIN=SPMIN YMAX=SPMAX C C DETERMINE THE 11 VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS C 160 DO200I=1,11 YLABLE(I)=YMAX-((FLOAT(I-1))/10.0)*(YMAX-YMIN) 200 CONTINUE C C BLANK OUT THE GRAPH DO250I=1,55 DO260J=1,130 IGRAPH(I,J)=BLANK 260 CONTINUE 250 CONTINUE C C PRODUCE THE Y AXIS DO300I=5,55 IGRAPH(I,10)=ALPHAI IGRAPH(I,130)=ALPHAI 300 CONTINUE DO350I=5,55,5 IGRAPH(I,10)=HYPHEN IGRAPH(I,130)=HYPHEN 350 CONTINUE C C PRODUCE THE X AXIS DO400J=10,130 IGRAPH(55,J)=HYPHEN IGRAPH(5,J)=HYPHEN 400 CONTINUE DO450J=10,130,10 IGRAPH(55,J)=ALPHAI IGRAPH(5,J)=ALPHAI 450 CONTINUE C C DETERMINE THE (X,Y) PLOT POSITIONS RATIOY=50.0/(YMAX-YMIN) RATIOX=240.0 DO600I=1,N AI=I XI =(AI-1.0)/(2.0*(AN-1.0)) MX=RATIOX*XI+0.5 MX=MX+10 IF(IDF.EQ.0)GOTO650 SUPPER=DF*Y(I)/PP025 SLOWER=DF*Y(I)/PP975 MY=RATIOY*(SUPPER-YMIN)+0.5 MY=55-MY IGRAPH(MY,MX)=DOT MY=RATIOY*(SLOWER-YMIN)+0.5 MY=55-MY IGRAPH(MY,MX)=DOT 650 MY=RATIOY*(Y(I)-YMIN)+0.5 MY=55-MY IGRAPH(MY,MX)=ALPHAX 600 CONTINUE C C WRITE OUT THE GRAPH WRITE(IPR,998) DO700I=5,55 IFLAG=I-(I/5)*5 K=I/5 IF(IFLAG.NE.0)WRITE(IPR,705)(IGRAPH(I,J),J=1,130) IF(IFLAG.EQ.0)WRITE(IPR,706)YLABLE(K),(IGRAPH(I,J),J=10,130) 700 CONTINUE WRITE(IPR,740) WRITE(IPR,745) 705 FORMAT(1H ,130A1) 706 FORMAT(1H ,F9.2,130A1) 740 FORMAT(1H , 'FREQ .000 .042 .083 .125 .16 17 .208 .250 .292 .333 .375 .417 1 .458 .500') 745 FORMAT(1H , 'PERIOD INF 24.0 12.0 8.00 6.0 10 4.80 4.00 3.43 3.00 2.67 2.40 1 2.18 2.00') 998 FORMAT(1H1) RETURN END SUBROUTINE PLOTST(Y,X,N,D,DMIN,DMAX) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PLOTST C C PURPOSE--THIS SUBROUTINE YIELDS A NARROW-WIDTH (71-CHARACTER) C OF Y(I) VERSUS X(I): C 1) WITH ONLY THOSE POINTS (X(I),Y(I)) PLOTTED C FOR WHICH THE CORRESPONDING VALUE OF D(I) C IS BETWEEN THE SPECIFIED VALUES OF DMIN AND DMAX. C C ITS NARROW WIDTH MAKES IT C APPROPRIATE FOR USE ON A TERMINAL. C C THE USE OF THE SUBSET DEFINTION VECTOR D C GIVES THE DATA ANALYST THE CAPABILITY OF C PLOTTING SUBSETS OF THE DATA, C WHERE THE SUBSET IS DEFINED C BY VALUES IN THE VECTOR D. C C INPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED VERTICALLY. C --X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED HORIZONTALLY. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR Y. C --D = THE SINGLE PRECISION VECTOR C WHICH 'DEFINES' THE VARIOUS C POSSIBLE SUBSETS. C --DMIN = THE SINGLE PRECISION VALUE C WHICH DEFINES THE LOWER BOUND C (INCLUSIVELY) OF THE PARTICULAR C SUBSET OF INTEREST TO BE PLOTTED. C --DMAX = THE SINGLE PRECISION VALUE C WHICH DEFINES THE UPPER BOUND C (INCLUSIVELY) OF THE PARTICULAR C SUBSET OF INTEREST TO BE PLOTTED. C OUTPUT--A NARROW-WIDTH (71-CHARACTER) TERMINAL PLOT C OF Y(I) VERSUS X(I), C FOR ONLY OF A SPECIFIED SUBSET OF THE DATA. C THE BODY OF THE PLOT (NOT COUNTING AXIS VALUES C AND MARGINS) IS 25 ROWS (LINES) AND 49 COLUMNS. C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--FOR A GIVEN DUMMY INDEX I, C IF D(I) IS SMALLER THAN DMIN OR LARGER THAN DMAX, C THEN THE CORRESPONDING POINT (X(I),Y(I)) C WILL NOT BE PLOTTED. C --VALUES IN THE VERTICAL AXIS VECTOR (Y) C OR THE HORIZONTAL AXIS VECTOR (X) WHICH ARE C EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE C PLOTTED. C THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM C OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y C (OR X) ARE 'MISSING DATA', OR WHEN WE PURPOSELY C WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y C (OR X) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT C WANT CERTAIN ELEMENTS IN Y (OR X) TO BE PLOTTED). C TO CAUSE SPECIFIC ELEMENTS IN Y (OR X) TO BE C IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND C (BY, FOR EXAMPLE, USE OF THE REPLAC SUBROUTINE) C BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND C THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOT C SUBROUTINE. C --NOTE THAT THE STORAGE REQUIREMENTS FOR THIS C (AND THE OTHER) TERMINAL PLOT SUBROUTINESS ARE . C VERY SMALL. C THIS IS DUE TO THE 'ONE LINE AT A TIME' ALGORITHM C EMPLOYED FOR THE PLOT. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--OCTOBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1977. C C--------------------------------------------------------------------- C CHARACTER*4 ILINE CHARACTER*4 IAXISC CHARACTER*4 SBNAM1,SBNAM2 CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 CHARACTER*4 ALPH41,ALPH42 CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX C DIMENSION Y(1) DIMENSION X(1) DIMENSION D(1) DIMENSION ILINE(72),XLABLE(10) C DATA SBNAM1,SBNAM2/'PLOT','ST '/ DATA ALPH11,ALPH12/'FIRS','T '/ DATA ALPH21,ALPH22/'SECO','ND '/ DATA ALPH31,ALPH32/'THIR','D '/ DATA ALPH41,ALPH42/'FOUR','TH '/ DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/ C IPR=6 CUTOFF=(10.0**10)-1000.0 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO52 GOTO54 52 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,20)N WRITE(IPR,5) RETURN 54 CONTINUE IF(N.EQ.1)GOTO56 GOTO58 56 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,22)N WRITE(IPR,5) RETURN 58 CONTINUE C HOLD=Y(1) DO60I=2,N IF(Y(I).NE.HOLD)GOTO62 60 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 62 CONTINUE HOLD=X(1) DO64I=2,N IF(X(I).NE.HOLD)GOTO66 64 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 66 CONTINUE HOLD=D(1) DO72I=2,N IF(D(I).NE.HOLD)GOTO74 72 CONTINUE WRITE(IPR,5) WRITE(IPR,11) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) 74 CONTINUE C DO76I=1,N IF(Y(I).LT.CUTOFF)GOTO78 76 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 78 CONTINUE DO80I=1,N IF(X(I).LT.CUTOFF)GOTO82 80 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 82 CONTINUE DO88I=1,N IF(D(I).LT.CUTOFF)GOTO90 88 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 90 CONTINUE C DO92I=1,N IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)GOTO94 92 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,34) WRITE(IPR,35)DMIN,DMAX WRITE(IPR,36) WRITE(IPR,5) RETURN 94 CONTINUE C N2=0 DO96I=1,N IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF.AND.D(I).LT.CUTOFF)GOTO98 GOTO96 98 IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)N2=N2+1 IF(N2.GE.2)GOTO99 96 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22,ALPH41,ALPH42 WRITE(IPR,19)SBNAM1,SBNAM2 WRITE(IPR,40) WRITE(IPR,41)N2 WRITE(IPR,5) RETURN 99 CONTINUE C 5 FORMAT(1H ,'**************************************************', 1'********************') 10 FORMAT(1H ,' FATAL ERROR ') 11 FORMAT(1H ,' NON-FATAL DIAGNOSTIC ') 15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4, 1' SUBROUTINE') 18 FORMAT(1H ,'THE ',A4,A4,', ',A4,A4,', AND ',A4,A4) 19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE') 20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,')') 22 FORMAT(1H ,'HAS THE VALUE 1') 30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8) 32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF') 33 FORMAT(1H ,'VALUE OF ',E15.8) 34 FORMAT(1H ,'HAS ALL ELEMENTS OUTSIDE THE INTERVAL') 35 FORMAT(1H ,'(',E15.8,',',E15.8,')',' AS DEFINED BY') 36 FORMAT(1H ,'THE FIFTH AND SIXTH INPUT ARGUMENTS.') 40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 1' EXCLUDED FROM THE PLOT.') 41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.') C C-----START POINT----------------------------------------------------- C C DEFINE THE NUMBER OF ROWS AND COLUMNS WITHIN THE PLOT-- C THIS HAS BEEN SET TO 25 ROWS AND 49 COLUMNS. C NUMROW=25 NUMCOL=49 ANUMR=NUMROW ANUMRM=NUMROW-1 ANUMCM=NUMCOL-1 NUMR25=(NUMROW/4)+1 NUMR50=(NUMROW/2)+1 NUMR75=3*(NUMROW/4)+1 IXDEL=(NUMCOL-1)/4 NUMLAB=5 ANUMLM=NUMLAB-1 C C SKIP A LINE, WRITE OUT AN IDENTIFYING LINE FOR THE TYPE OF PLOT, C WRITE OUT THE TOP HORIZONTAL AXIS OF THE PLOT, AND SKIP 1 LINE C FOR A MARGIN WITHIN THE PLOT. C WRITE(IPR,999) WRITE(IPR,205) DO100ICOL=1,NUMCOL ILINE(ICOL)=HYPHEN 100 CONTINUE DO200ICOL=1,NUMCOL,IXDEL ILINE(ICOL)=ALPHAI 200 CONTINUE WRITE(IPR,305)(ILINE(I),I=1,NUMCOL) WRITE(IPR,310)BLANK C C DETERMINE THE MIN AND MAX VALUES OF Y, AND OF X. C DO250I=1,N IF(Y(I).GE.CUTOFF)GOTO250 IF(X(I).GE.CUTOFF)GOTO250 IF(D(I).LT.DMIN)GOTO250 IF(D(I).GT.DMAX)GOTO250 YMIN=Y(I) YMAX=Y(I) XMIN=X(I) XMAX=X(I) GOTO270 250 CONTINUE 270 DO300I=1,N IF(Y(I).GE.CUTOFF)GOTO300 IF(X(I).GE.CUTOFF)GOTO300 IF(D(I).LT.DMIN)GOTO300 IF(D(I).GT.DMAX)GOTO300 IF(Y(I).LT.YMIN)YMIN=Y(I) IF(Y(I).GT.YMAX)YMAX=Y(I) IF(X(I).LT.XMIN)XMIN=X(I) IF(X(I).GT.XMAX)XMAX=X(I) 300 CONTINUE DELY=YMAX-YMIN DELX=XMAX-XMIN YWIDTH=DELY/ANUMRM XWIDTH=DELX/ANUMCM C C DETERMINE AND WRITE OUT THE PLOT POSITIONS ONE LINE AT A TIME. C DO400IROW=1,NUMROW DO500ICOL=1,NUMCOL ILINE(ICOL)=BLANK 500 CONTINUE AIROW=IROW YUPPER=YMAX+(1.5-AIROW)*YWIDTH YLABLE=YMAX+(1.0-AIROW)*YWIDTH YLOWER=YMAX+(0.5-AIROW)*YWIDTH IF(IROW.EQ.NUMROW)YLABLE=YMIN DO600I=1,N IF(Y(I).GE.CUTOFF)GOTO600 IF(X(I).GE.CUTOFF)GOTO600 IF(D(I).LT.DMIN)GOTO600 IF(D(I).GT.DMAX)GOTO600 IF(YLOWER.LE.Y(I).AND.Y(I).LT.YUPPER)GOTO650 GOTO600 650 ICOL=((X(I)-XMIN)/XWIDTH)+1.5 ILINE(ICOL)=ALPHAX 600 CONTINUE ICOLMX=1 DO700ICOL=1,NUMCOL IF(ILINE(ICOL).EQ.ALPHAX)ICOLMX=ICOL 700 CONTINUE IAXISC=ALPHAI IF(IROW.EQ.1.OR.IROW.EQ.NUMROW)IAXISC=HYPHEN IF(IROW.EQ.NUMR25.OR.IROW.EQ.NUMR50.OR.IROW.EQ.NUMR75) 1IAXISC=HYPHEN WRITE(IPR,710)YLABLE,IAXISC,(ILINE(ICOL),ICOL=1,ICOLMX) 400 CONTINUE C C SKIP 1 LINE FOR A BOTTOM MARGIN WITHIN THE PLOT, WRITE OUT THE C BOTTOM HORIZONTAL AXIS, AND WRITE OUT THE X AXIS LABLES. C WRITE(IPR,310)BLANK DO800ICOL=1,NUMCOL ILINE(ICOL)=HYPHEN 800 CONTINUE DO900ICOL=1,NUMCOL,IXDEL ILINE(ICOL)=ALPHAI 900 CONTINUE WRITE(IPR,305)(ILINE(ICOL),ICOL=1,NUMCOL) DO1000I=1,NUMLAB AIM1=I-1 XLABLE(I)=XMIN+(AIM1/ANUMLM)*DELX 1000 CONTINUE WRITE(IPR,910)(XLABLE(I),I=1,NUMLAB) C 205 FORMAT(1H , 'THE FOLLOWING IS A PLOT OF Y(I) (VERTICALLY) VERSUS 1 X(I) (HORIZONTALLY)') 305 FORMAT(1H ,18X,54A1) 310 FORMAT(1H ,15X,A1) 710 FORMAT(1H ,E14.7,1X,A1,2X,50A1) 910 FORMAT(1H ,9X,5E12.4) 999 FORMAT(1H ) C RETURN END SUBROUTINE PLOTT(Y,X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PLOTT C C PURPOSE--THIS SUBROUTINE YIELDS A NARROW-WIDTH (71-CHARACTER) C PLOT OF Y(I) VERSUS X(I). ITS NARROW WIDTH MAKES IT C APPROPRIATE FOR USE ON A TERMINAL. C INPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED VERTICALLY. C --X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED HORIZONTALLY. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR Y. C OUTPUT--A NARROW-WIDTH (71-CHARACTER) TERMINAL PLOT C OF Y(I) VERSUS X(I). C THE BODY OF THE PLOT (NOT COUNTING AXIS VALUES C AND MARGINS) IS 25 ROWS (LINES) AND 49 COLUMNS. C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (Y) C OR THE HORIZONTAL AXIS VECTOR (X) WHICH ARE C EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE C PLOTTED. C THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM C OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y C (OR X) ARE 'MISSING DATA', OR WHEN WE PURPOSELY C WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y C (OR X) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT C WANT CERTAIN ELEMENTS IN Y (OR X) TO BE PLOTTED). C TO CAUSE SPECIFIC ELEMENTS IN Y (OR X) TO BE C IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND C (BY, FOR EXAMPLE, USE OF THE REPLAC SUBROUTINE) C BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND C THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOT C SUBROUTINE. C --NOTE THAT THE STORAGE REQUIREMENTS FOR THIS C (AND THE OTHER) TERMINAL PLOT SUBROUTINESS ARE . C VERY SMALL. C THIS IS DUE TO THE 'ONE LINE AT A TIME' ALGORITHM C EMPLOYED FOR THE PLOT. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--FEBRUARY 1974. C UPDATED --APRIL 1974. C UPDATED --OCTOBER 1974. C UPDATED --OCTOBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1977. C C--------------------------------------------------------------------- C CHARACTER*4 ILINE CHARACTER*4 IAXISC CHARACTER*4 SBNAM1,SBNAM2 CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX C DIMENSION Y(1) DIMENSION X(1) DIMENSION ILINE(72),XLABLE(10) C DATA SBNAM1,SBNAM2/'PLOT','T '/ DATA ALPH11,ALPH12/'FIRS','T '/ DATA ALPH21,ALPH22/'SECO','ND '/ DATA ALPH31,ALPH32/'THIR','D '/ DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/ C IPR=6 CUTOFF=(10.0**10)-1000.0 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO52 GOTO54 52 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,20)N WRITE(IPR,5) RETURN 54 CONTINUE IF(N.EQ.1)GOTO56 GOTO58 56 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,22)N WRITE(IPR,5) RETURN 58 CONTINUE C HOLD=Y(1) DO60I=2,N IF(Y(I).NE.HOLD)GOTO62 60 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 62 CONTINUE HOLD=X(1) DO64I=2,N IF(X(I).NE.HOLD)GOTO66 64 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 66 CONTINUE C DO76I=1,N IF(Y(I).LT.CUTOFF)GOTO78 76 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 78 CONTINUE DO80I=1,N IF(X(I).LT.CUTOFF)GOTO82 80 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 82 CONTINUE C N2=0 DO96I=1,N IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF)GOTO98 GOTO96 98 N2=N2+1 IF(N2.GE.2)GOTO99 96 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22 WRITE(IPR,19)SBNAM1,SBNAM2 WRITE(IPR,40) WRITE(IPR,41)N2 WRITE(IPR,5) RETURN 99 CONTINUE C 5 FORMAT(1H ,'**************************************************', 1'********************') 10 FORMAT(1H ,' FATAL ERROR ') 15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4, 1' SUBROUTINE') 18 FORMAT(1H ,'THE ',A4,A4,', AND ',A4,A4) 19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE') 20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,1H)) 22 FORMAT(1H ,'HAS THE VALUE 1') 30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8) 32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF') 33 FORMAT(1H ,'VALUE OF ',E15.8) 40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 1' EXCLUDED FROM THE PLOT.') 41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.') C C-----START POINT----------------------------------------------------- C C DEFINE THE NUMBER OF ROWS AND COLUMNS WITHIN THE PLOT-- C THIS HAS BEEN SET TO 25 ROWS AND 49 COLUMNS. C NUMROW=25 NUMCOL=49 ANUMR=NUMROW ANUMRM=NUMROW-1 ANUMCM=NUMCOL-1 NUMR25=(NUMROW/4)+1 NUMR50=(NUMROW/2)+1 NUMR75=3*(NUMROW/4)+1 IXDEL=(NUMCOL-1)/4 NUMLAB=5 ANUMLM=NUMLAB-1 C C SKIP A LINE, WRITE OUT AN IDENTIFYING LINE FOR THE TYPE OF PLOT, C WRITE OUT THE TOP HORIZONTAL AXIS OF THE PLOT, AND SKIP 1 LINE C FOR A MARGIN WITHIN THE PLOT. C WRITE(IPR,999) WRITE(IPR,205) DO100ICOL=1,NUMCOL ILINE(ICOL)=HYPHEN 100 CONTINUE DO200ICOL=1,NUMCOL,IXDEL ILINE(ICOL)=ALPHAI 200 CONTINUE WRITE(IPR,305)(ILINE(I),I=1,NUMCOL) WRITE(IPR,310)BLANK C C DETERMINE THE MIN AND MAX VALUES OF Y, AND OF X. C DO250I=1,N IF(Y(I).GE.CUTOFF)GOTO250 IF(X(I).GE.CUTOFF)GOTO250 YMIN=Y(I) YMAX=Y(I) XMIN=X(I) XMAX=X(I) GOTO270 250 CONTINUE 270 DO300I=1,N IF(Y(I).GE.CUTOFF)GOTO300 IF(X(I).GE.CUTOFF)GOTO300 IF(Y(I).LT.YMIN)YMIN=Y(I) IF(Y(I).GT.YMAX)YMAX=Y(I) IF(X(I).LT.XMIN)XMIN=X(I) IF(X(I).GT.XMAX)XMAX=X(I) 300 CONTINUE DELY=YMAX-YMIN DELX=XMAX-XMIN YWIDTH=DELY/ANUMRM XWIDTH=DELX/ANUMCM C C DETERMINE AND WRITE OUT THE PLOT POSITIONS ONE LINE AT A TIME. C DO400IROW=1,NUMROW DO500ICOL=1,NUMCOL ILINE(ICOL)=BLANK 500 CONTINUE AIROW=IROW YUPPER=YMAX+(1.5-AIROW)*YWIDTH YLABLE=YMAX+(1.0-AIROW)*YWIDTH YLOWER=YMAX+(0.5-AIROW)*YWIDTH IF(IROW.EQ.NUMROW)YLABLE=YMIN DO600I=1,N IF(Y(I).GE.CUTOFF)GOTO600 IF(X(I).GE.CUTOFF)GOTO600 IF(YLOWER.LE.Y(I).AND.Y(I).LT.YUPPER)GOTO650 GOTO600 650 ICOL=((X(I)-XMIN)/XWIDTH)+1.5 ILINE(ICOL)=ALPHAX 600 CONTINUE ICOLMX=1 DO700ICOL=1,NUMCOL IF(ILINE(ICOL).EQ.ALPHAX)ICOLMX=ICOL 700 CONTINUE IAXISC=ALPHAI IF(IROW.EQ.1.OR.IROW.EQ.NUMROW)IAXISC=HYPHEN IF(IROW.EQ.NUMR25.OR.IROW.EQ.NUMR50.OR.IROW.EQ.NUMR75) 1IAXISC=HYPHEN WRITE(IPR,710)YLABLE,IAXISC,(ILINE(ICOL),ICOL=1,ICOLMX) 400 CONTINUE C C SKIP 1 LINE FOR A BOTTOM MARGIN WITHIN THE PLOT, WRITE OUT THE C BOTTOM HORIZONTAL AXIS, AND WRITE OUT THE X AXIS LABLES. C WRITE(IPR,310)BLANK DO800ICOL=1,NUMCOL ILINE(ICOL)=HYPHEN 800 CONTINUE DO900ICOL=1,NUMCOL,IXDEL ILINE(ICOL)=ALPHAI 900 CONTINUE WRITE(IPR,305)(ILINE(ICOL),ICOL=1,NUMCOL) DO1000I=1,NUMLAB AIM1=I-1 XLABLE(I)=XMIN+(AIM1/ANUMLM)*DELX 1000 CONTINUE WRITE(IPR,910)(XLABLE(I),I=1,NUMLAB) C 205 FORMAT(1H , 71HTHE FOLLOWING IS A PLOT OF Y(I) (VERTICALLY) VERSUS 1 X(I) (HORIZONTALLY)) 305 FORMAT(1H ,18X,54A1) 310 FORMAT(1H ,15X,A1) 710 FORMAT(1H ,E14.7,1X,A1,2X,50A1) 910 FORMAT(1H ,9X,5E12.4) 999 FORMAT(1H ) C RETURN END SUBROUTINE PLOTU(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PLOTU C C PURPOSE--THIS SUBROUTINE PRODUCES THE FOLLOWING 4 PLOTS-- C ALL ON THE SAME PRINTER PAGE-- C 1) DATA PLOT--X(I) VERSUS I C 2) AUTOREGRESSION PLOT--X(I) VERSUS X(I-1) C 3) HISTOGRAM C 4) NORMAL PROBABILITY PLOT C IN ADDITION, LOCATION, SCALE, AND AUTOCORRELATION C SUMMARY STATISTICS ARE PRINTED OUT AUTOMATICALLY C ON THE SAME PAGE. C THESE PLOTS GIVE THE DATA ANALYST A QUICK C FIRST-PASS CHECK AT SOME OF C THE UNDERLYING ASSUMPTIONS TYPICALLY MADE-- C CONSTANT LOCATION, CONSTANT SCALE, NO OUTLIERS, C UNAUTOCORRELATED DATA, SYMMETRY, NORMALITY. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED) OBSERVATIONS. C N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--4 PLOTS (ALL ON THE SAME PRINTER PAGE)-- C 1) DATA PLOT--X(I) VERSUS I C 2) AUTOREGRESSION PLOT--X(I) VERSUS X(I-1) C 3) HISTOGRAM C 4) NORMAL PROBABILITY PLOT C PLUS LOCATION, SCALE, AND C AUTOCORRELATION SUMMARY STATISTICS. C PRINTING--YES C RESTRICTIONS--THE MINIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 2. C --THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, NORPPF. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, 'SOME USEFUL COMPUTERIZED TECHNIQUES C FOR DATA ANALYSIS', (UNPUBLISHED MANUSCRIPT C AVAILABLE FROM AUTHOR), 1975. C --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING, C 1967, PAGES 260-308. C --FILLIBEN, 'THE PROBABILITY PLOT CORRELATION COEFFICIENT C TEST FOR NORMALITY', TECHNOMETRICS, 1975, PAGES 111-117. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--NOVEMBER 1974. C UPDATED --JANUARY 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C UPDATED --MAY 1976. C UPDATED --FEBRUARY 1977. C C--------------------------------------------------------------------- C CHARACTER*4 IGRAPH CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL C DIMENSION X(1) DIMENSION X2(7500),Y2(7500) DIMENSION YLABLE(45,4) DIMENSION XMIN(4),XMAX(4),XMID(4),X25(4),X75(4) DIMENSION ITAXIS(4),IBAXIS(4),ILAXIS(4),IRAXIS(4) COMMON /BLOCK1/ IGRAPH(55,130) COMMON /BLOCK2/ WS(15000) CCCCC COMMON IGRAPH(45,110) EQUIVALENCE (X2(1),WS(1)),(Y2(1),WS(7501)) C DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/ DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/ DATA ITAXIS(1),IBAXIS(1),ILAXIS(1),IRAXIS(1)/ 1,19,5,49/ DATA ITAXIS(2),IBAXIS(2),ILAXIS(2),IRAXIS(2)/ 1,19,54,98/ DATA ITAXIS(3),IBAXIS(3),ILAXIS(3),IRAXIS(3)/27,45,5,49/ DATA ITAXIS(4),IBAXIS(4),ILAXIS(4),IRAXIS(4)/ 27,45,54,98/ C IPR=6 ILOWER=2 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C WRITE(IPR,998) IF(N.LT.ILOWER.OR.N.GT.IUPPER)GOTO50 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD RETURN 50 WRITE(IPR,17)ILOWER,IUPPER WRITE(IPR,47)N RETURN 90 CONTINUE 9 FORMAT(1H , '***** FATAL ERROR--THE FIRST INPUT ARGUMENT (A VEC 1TOR) TO THE PLOTU SUBROUTINE HAS ALL ELEMENTS = ',E15.8, 1' *****') 17 FORMAT(1H , '***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 PLOTU SUBROUTINE IS OUTSIDE THE ALLOWABLE (',I1,',',I6, ') INTER 1VAL *****') 47 FORMAT(1H , '***** THE VALUE OF THE ARGUMENT IS ',I8 ,' *****') C C-----START POINT----------------------------------------------------- C C PRODUCE THE FIRST PLOT (UPPER LEFT)--X(I) VERSUS I C C DETERMINE THE VERTICAL AXIS VECTOR Y2, THE HORIZONTAL C AXIS VECTOR X2, AND THE PLOT SAMPLE SIZE N2 FOR THIS C PARTICUAR PLOT. C N2=N DO100I=1,N2 Y2(I)=X(I) X2(I)=I 100 CONTINUE C IPLOT=1 GOTO5000 C C********************************************************************* C C PRODUCE THE SECOND PLOT (UPPER RIGHT)--X(I) VERSUS X(I-1) C C DETERMINE THE VERTICAL AXIS VECTOR Y2, THE HORIZONTAL C AXIS VECTOR X2, AND THE PLOT SAMPLE SIZE N2 FOR THIS C PARTICULAR PLOT. C 2000 N2=N-1 DO1100I=1,N2 IP1=I+1 Y2(I)=X(IP1) X2(I)=X(I) 1100 CONTINUE C IPLOT=2 GOTO5000 C C********************************************************************* C C PRODUCE THE THIRD PLOT (LOWER LEFT)-A HISTOGRAM C 3000 N2=41 INC=3 C C COMPUTE THE SAMPLE MEAN AND SAMPLE STANDARD DEVIATION C AN=N SUM=0.0 DO3100I=1,N SUM=SUM+X(I) 3100 CONTINUE XMEAN=SUM/AN SUM=0.0 DO 3200I=1,N SUM=SUM+(X(I)-XMEAN)**2 3200 CONTINUE S=SQRT(SUM/(AN-1.0)) C C FORM THE FREQUENCY TABLE (Y2) WHICH CORRESPONDS TO A HISTOGRAM C WITH 41 CLASSES AND A CLASS WIDTH OF THREE TENTHS OF A SAMPLE STANDARD C DEVIATION. C DO3300I=1,41 Y2(I)=0.0 3300 CONTINUE C NUMOUT=0 DO3400I=1,N Z=(X(I)-XMEAN)/S IF(-6.0.LE.Z.AND.Z.LE.6.0)GOTO3450 NUMOUT=NUMOUT+1 GOTO3400 3450 CONTINUE MT=((Z+6.0)/0.3)+1.5 Y2(MT)=Y2(MT)+1.0 3400 CONTINUE C DO3800I=1,41 AI=I X2(I)=XMEAN+((AI-21.0)*0.3)*S 3800 CONTINUE C NUMCLA=41 CWIDSD=0.3 CWIDTH=CWIDSD*S C IPLOT=3 GOTO5000 C C********************************************************************* C C PRODUCE THE FOURTH PLOT (LOWER RIGHT)--A NORMAL PROBABILITY PLOT C C DETERMINE THE VERTICAL AXIS VECTOR Y2, THE HORIZONTAL C AXIS VECTOR X2, AND THE PLOT SAMPLE SIZE N2 FOR THIS C PARTICUAR PLOT. C 4000 N2=N CALL SORT(X,N,Y2) CALL UNIMED(N,X2) DO4100I=1,N CALL NORPPF(X2(I),X2(I)) 4100 CONTINUE C IPLOT=4 GOTO5000 C C C********************************************************************* C C OPERATE ON A PARTICULAR PLOT C 5000 ITAX=ITAXIS(IPLOT) IBAX=IBAXIS(IPLOT) ILAX=ILAXIS(IPLOT) IRAX=IRAXIS(IPLOT) C ITAXP2=ITAX+2 IBAXM2=IBAX-2 ILAXP2=ILAX+2 IRAXM2=IRAX-2 ILAXM4=ILAX-4 ILAXM3=ILAX-3 ILAXM2=ILAX-2 ILAXM1=ILAX-1 IYMID=(ITAXP2+IBAXM2)/2 IXMID=(ILAXP2+IRAXM2)/2 HEIGHT=IBAXM2-ITAXP2 WIDTH=IRAXM2-ILAXP2 C C BLANK OUT THE GRAPH C DO300I=ITAX,IBAX DO350J=ILAXM4,IRAX IGRAPH(I,J)=BLANK 350 CONTINUE 300 CONTINUE C C PRODUCE THE Y AXIS C DO400I=ITAXP2,IBAXM2 IGRAPH(I,ILAX)=ALPHAI IGRAPH(I,IRAX)=ALPHAI 400 CONTINUE IYDEL=(IBAXM2-ITAXP2)/2 DO450I=ITAXP2,IBAXM2,IYDEL IGRAPH(I,ILAX)=HYPHEN IGRAPH(I,IRAX)=HYPHEN 450 CONTINUE IGRAPH(ITAXP2,ILAXM4)=EQUAL IGRAPH(ITAXP2,ILAXM3)=ALPHAM IGRAPH(ITAXP2,ILAXM2)=ALPHAA IGRAPH(ITAXP2,ILAXM1)=ALPHAX IGRAPH(IYMID,ILAXM4)=EQUAL IGRAPH(IYMID,ILAXM3)=ALPHAM IGRAPH(IYMID,ILAXM2)=ALPHAI IGRAPH(IYMID,ILAXM1)=ALPHAD IGRAPH(IBAXM2,ILAXM4)=EQUAL IGRAPH(IBAXM2,ILAXM3)=ALPHAM IGRAPH(IBAXM2,ILAXM2)=ALPHAI IGRAPH(IBAXM2,ILAXM1)=ALPHAN C C PRODUCE THE X AXIS C DO500J=ILAXP2,IRAXM2 IGRAPH(ITAX,J)=HYPHEN IGRAPH(IBAX,J)=HYPHEN 500 CONTINUE IXDEL=(IRAXM2-ILAXP2)/4 DO550J=ILAXP2,IRAXM2,IXDEL IGRAPH(ITAX,J)=ALPHAI IGRAPH(IBAX,J)=ALPHAI 550 CONTINUE C C DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS C YMIN=Y2(1) YMAX=Y2(1) DO600I=1,N2 IF(Y2(I).LT.YMIN)YMIN=Y2(I) IF(Y2(I).GT.YMAX)YMAX=Y2(I) 600 CONTINUE IF(IPLOT.EQ.3)YMIN=1.0 DO650I=ITAXP2,IBAXM2 ANUM=I-ITAXP2 YLABLE(I,IPLOT)=YMAX-(ANUM/HEIGHT)*(YMAX-YMIN) 650 CONTINUE C C DETERMINE XMIN, XMAX, XMID, X25 (=THE 25% POINT), AND C X75 (=THE 75% POINT) C XMIN2=X2(1) XMAX2=X2(1) DO700I=1,N2 IF(X2(I).LT.XMIN2)XMIN2=X2(I) IF(X2(I).GT.XMAX2)XMAX2=X2(I) 700 CONTINUE XMIN(IPLOT)=XMIN2 XMAX(IPLOT)=XMAX2 XMID(IPLOT)=(XMIN2+XMAX2)/2.0 X25(IPLOT)=0.75*XMIN2+0.25*XMAX2 X75(IPLOT)=0.25*XMIN2+0.75*XMAX2 C C DETERMINE THE (X,Y) PLOT POSITIONS C RATIOY=0.0 RATIOX=0.0 IF(YMAX.GT.YMIN)RATIOY=HEIGHT/(YMAX-YMIN) IF(XMAX(IPLOT).GT.XMIN(IPLOT))RATIOX= 1WIDTH/(XMAX(IPLOT)-XMIN(IPLOT)) IF(IPLOT.EQ.3)GOTO750 DO800I=1,N2 MX=RATIOX*(X2(I)-XMIN(IPLOT))+0.5 MX=MX+ILAXP2 MY=RATIOY*(Y2(I)-YMIN)+0.5 MY=IBAXM2-MY IGRAPH(MY,MX)=ALPHAX 800 CONTINUE GOTO850 C 750 DO900I=1,N2 IF(Y2(I).LE.0.5)GOTO900 MX=RATIOX*(X2(I)-XMIN(IPLOT))+0.5 MX=MX+ILAXP2 MY=RATIOY*(Y2(I)-YMIN)+0.5 MY=IBAXM2-MY IGRAPH(MY,MX)=ALPHAX DO950IY=MY,IBAXM2 IGRAPH(IY,MX)=ALPHAX 950 CONTINUE 900 CONTINUE C 850 IF(IPLOT.EQ.1)GOTO2000 IF(IPLOT.EQ.2)GOTO3000 IF(IPLOT.EQ.3)GOTO4000 C C******************************************************************** C C COMPUTE SUMMARY STATISTICS C ZMIN=Y2(1) ZMAX=Y2(N) ZRANGE=ZMAX-ZMIN ZMEAN=XMEAN ZSD=S ZDEVB=ZMEAN-ZMIN ZRDEVB=0.0 IF(ZMEAN.NE.0.0)ZRDEVB=100.0*ZDEVB/ZMEAN IF(ZRDEVB.LT.0.0)ZRDEVB=-ZRDEVB ZDEVA=ZMAX-ZMEAN ZRDEVA=0.0 IF(ZMEAN.NE.0.0)ZRDEVA=100.0*ZDEVA/ZMEAN IF(ZRDEVA.LT.0.0)ZRDEVA=-ZRDEVA C C DETERMINE THE NUMBER OF DISTINCT POINTS C NUMDIS=1 NM1=N-1 DO7200I=1,NM1 IP1=I+1 IF(Y2(I).EQ.Y2(IP1))GOTO7200 NUMDIS=NUMDIS+1 7200 CONTINUE C C COMPUTE THE SAMPLE MEDIAN C NHALF=N/2 IEVODD=N-2*(N/2) IF(IEVODD.EQ.0)GOTO7250 ZMED=Y2(NHALF) GOTO7260 7250 NHALFP=NHALF+1 ZMED=(Y2(NHALF)+Y2(NHALFP))/2.0 7260 CONTINUE C C DETERMINE THE FREQUENCY OF THE SAMPLE MIN AND MAX C NUMMIN=1 NM1=N-1 DO7400I=1,NM1 IP1=I+1 IF(Y2(I).EQ.Y2(IP1))NUMMIN=NUMMIN+1 IF(Y2(I).EQ.Y2(IP1))GOTO7400 GOTO7450 7400 CONTINUE 7450 NUMMAX=1 DO7500I=1,NM1 IREV=N-I+1 NMI=N-I IF(Y2(IREV).EQ.Y2(NMI))NUMMAX=NUMMAX+1 IF(Y2(IREV).EQ.Y2(NMI))GOTO7500 GOTO7550 7500 CONTINUE 7550 CONTINUE PROMIN=NUMMIN PROMIN=100.0*PROMIN/AN PROMAX=NUMMAX PROMAX=100.0*PROMAX/AN C C COMPUTE THE AUTOCORRELATION C ZMEAN1=(AN*ZMEAN-X(N))/(AN-1.0) ZMEAN2=(AN*ZMEAN-X(1))/(AN-1.0) SUM1=0.0 SUM2=0.0 SUM3=0.0 NM1=N-1 DO7600I=1,NM1 IP1=I+1 SUM1=SUM1+(X(I)-ZMEAN1)*(X(IP1)-ZMEAN2) SUM2=SUM2+(X(I)-ZMEAN1)**2 SUM3=SUM3+(X(IP1)-ZMEAN2)**2 7600 CONTINUE SUM23=SUM2*SUM3 ZAUTOC=9999.99 IF(SUM23.GT.0.0)ZAUTOC=SUM1/(SQRT(SUM23)) ZAUTOC=100.0*ZAUTOC C C WRITE EVERYTHING OUT C ITAX=ITAXIS(1) IBAX=IBAXIS(1) ITAXP1=ITAX+1 ITAXP2=ITAX+2 IBAXM1=IBAX-1 IBAXM2=IBAX-2 J1=ILAXIS(1)-4 J2=IRAXIS(1) J3=ILAXIS(2)-4 J4=IRAXIS(2) WRITE(IPR,5104) WRITE(IPR,5105)(IGRAPH(ITAX,J),J=J1,J2),(IGRAPH(ITAX,J),J=J3,J4) WRITE(IPR,5105)(IGRAPH(ITAXP1,J),J=J1,J2),(IGRAPH(ITAXP1,J),J=J3,J 14) DO5100I=ITAXP2,IBAXM2 WRITE(IPR,5110)YLABLE(I,1),(IGRAPH(I,J),J=J1,J2), 1 YLABLE(I,2),(IGRAPH(I,J),J=J3,J4) 5100 CONTINUE WRITE(IPR,5105)(IGRAPH(IBAXM1,J),J=J1,J2),(IGRAPH(IBAXM1,J),J=J3,J 14) WRITE(IPR,5105)(IGRAPH(IBAX,J),J=J1,J2),(IGRAPH(IBAX,J),J=J3,J4) WRITE(IPR,5115)XMIN(1),X25(1),XMID(1),X75(1),XMAX(1), 1 XMIN(2),X25(2),XMID(2),X75(2),XMAX(2) C ISKIPM=2 DO5200I=1,ISKIPM WRITE(IPR,999) 5200 CONTINUE C ITAX=ITAXIS(3) IBAX=IBAXIS(3) ITAXP1=ITAX+1 ITAXP2=ITAX+2 IBAXM1=IBAX-1 IBAXM2=IBAX-2 J1=ILAXIS(3)-4 J2=IRAXIS(3) J3=ILAXIS(4)-4 J4=IRAXIS(4) WRITE(IPR,5304) WRITE(IPR,5105)(IGRAPH(ITAX,J),J=J1,J2),(IGRAPH(ITAX,J),J=J3,J4) WRITE(IPR,5105)(IGRAPH(ITAXP1,J),J=J1,J2),(IGRAPH(ITAXP1,J),J=J3,J 14) DO5300I=ITAXP2,IBAXM2 WRITE(IPR,5110)YLABLE(I,3),(IGRAPH(I,J),J=J1,J2), 1 YLABLE(I,4),(IGRAPH(I,J),J=J3,J4) 5300 CONTINUE WRITE(IPR,5105)(IGRAPH(IBAXM1,J),J=J1,J2),(IGRAPH(IBAXM1,J),J=J3,J 14) WRITE(IPR,5105)(IGRAPH(IBAX,J),J=J1,J2),(IGRAPH(IBAX,J),J=J3,J4) WRITE(IPR,5115)XMIN(3),X25(3),XMID(3),X75(3),XMAX(3), 1 XMIN(4),X25(4),XMID(4),X75(4),XMAX(4) WRITE(IPR,5320) WRITE(IPR,5325)NUMCLA,N,NUMDIS WRITE(IPR,5326)CWIDTH,CWIDSD,ZMIN,NUMMIN,PROMIN WRITE(IPR,5330)NUMOUT,ZMED WRITE(IPR,5331)ZMEAN WRITE(IPR,5332)ZMAX,NUMMAX,PROMAX WRITE(IPR,5334)ZSD,ZRANGE WRITE(IPR,5336)ZDEVB,ZRDEVB WRITE(IPR,5338)ZDEVA,ZRDEVA WRITE(IPR,5340)ZAUTOC C 5104 FORMAT(1H ,20X,12X,'PLOT OF X(I) VERSUS I',41X,'PLOT OF ', 1 'X(I) VERSUS X(I-1)') 5105 FORMAT(1H ,16X,4A1,45A1,16X,4A1,45A1) 5110 FORMAT(1H ,F16.7,4A1,45A1,F16.7,4A1,45A1) 5115 FORMAT(1H ,17X,5F10.4,15X,4F10.4,F9.3) 5304 FORMAT(1H ,38X,'HISTOGRAM',49X,'NORMAL PROBABILITY PLOT') 5320 FORMAT(1H ,20X,' -6 -3 0 3 6') 5325 FORMAT(1H ,20X,'NUMBER OF CLASSES = ',I3,42X, 1'SAMPLE SIZE =',I9,' DISTINCT POINTS =',I6) 5326 FORMAT(1H ,20X,'CLASS WIDTH = ',E14.7,' = ',F3.1, 1 ' STANDARD DEVIATIONS',11X, 1'MINIMUM =',F13.6,' COUNT =',I5,' (',F7.2,'%)') 5330 FORMAT(1H ,16X,I5,' OBSERVATIONS WERE IN EXCESS OF 6 STANDARD', 1 ' DEVIATIONS',11X, 1'MEDIAN =',F14.6) 5331 FORMAT(1H ,20X, 'ABOUT THE SAMPLE MEAN AND SO WERE NOT PRINTED IN 1 HISTOGRAM',7X, 1'MEAN =',F16.6) 5332 FORMAT(1H ,85X, 1'MAXIMUM =',F13.6,' COUNT =',I5,' (',F7.2,'%)') 5334 FORMAT(1H ,85X, 1'ST. DEV. =',F12.6,' RANGE =',F16.6) 5336 FORMAT(1H ,20X,65X,'MAX DEV. BELOW MEAN =',F14.6,' (',F7.2,'%)') 5338 FORMAT(1H ,85X,'MAX DEV. ABOVE MEAN =',F14.6,' (',F7.2,'%)') 5340 FORMAT(1H ,85X,'AUTOCORR. =',F10.2,'%') 998 FORMAT(1H1) 999 FORMAT(1H ) C RETURN END SUBROUTINE PLOTX(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PLOTX C C PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT C OF X(I) VERSUS I. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED VERTICALLY. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--A ONE-PAGE PRINTER PLOT OF X(I) VERSUS I. C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (X) WHICH ARE C EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE C PLOTTED. C THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM C OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR X C ARE 'MISSING DATA', OR WHEN WE PURPOSELY C WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR X C FOR PLOTTING PURPOSES (THAT IS, WE DO NOT C WANT CERTAIN ELEMENTS IN X TO BE PLOTTED). C TO CAUSE SPECIFIC ELEMENTS IN X TO BE C IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND C (BY, FOR EXAMPLE, USE OF THE REPLAC SUBROUTINE) C BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND C THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTX C SUBROUTINE. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --JANUARY 1975. C UPDATED --JULY 1975. C UPDATED --SEPTEMBER 1975. C UPDATED --OCTOBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C UPDATED --FEBRUARY 1977. C C--------------------------------------------------------------------- C CHARACTER*4 IGRAPH CHARACTER*4 SBNAM1,SBNAM2 CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22 CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL C DIMENSION X(1) DIMENSION YLABLE(11) COMMON /BLOCK1/ IGRAPH(55,130) C DATA SBNAM1,SBNAM2/'PLOT','X '/ DATA ALPH11,ALPH12/'FIRS','T '/ DATA ALPH21,ALPH22/'SECO','ND '/ DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/ DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/ C IPR=6 CUTOFF=(10.0**10)-1000.0 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C WRITE(IPR,998) IF(N.LT.1)GOTO52 GOTO54 52 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,20)N WRITE(IPR,5) RETURN 54 CONTINUE IF(N.EQ.1)GOTO56 GOTO58 56 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,22)N WRITE(IPR,5) RETURN 58 CONTINUE C HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO62 60 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 62 CONTINUE C DO76I=1,N IF(X(I).LT.CUTOFF)GOTO78 76 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 78 CONTINUE C 5 FORMAT(1H ,'**************************************************', 1'********************') 10 FORMAT(1H ,' FATAL ERROR ') 15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4, 1' SUBROUTINE') 20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,1H)) 22 FORMAT(1H ,'HAS THE VALUE 1') 30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8) 32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF') 33 FORMAT(1H ,'VALUE OF ',E15.8) C C-----START POINT----------------------------------------------------- C C DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS C DO200I=1,N IF(X(I).GE.CUTOFF)GOTO200 YMIN=X(I) YMAX=X(I) GOTO250 200 CONTINUE 250 DO300I=1,N IF(X(I).GE.CUTOFF)GOTO300 IF(X(I).LT.YMIN)YMIN=X(I) IF(X(I).GT.YMAX)YMAX=X(I) 300 CONTINUE DO400I=1,9 AIM1=I-1 YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN) 400 CONTINUE C C DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS. C DETERMINE XMIN, XMAX, XMID, X25 (=THE 25% POINT), AND C X75 (=THE 75% POINT). C XMIN=1.0 XMAX=N XMID=(XMIN+XMAX)/2.0 X25=0.75*XMIN+0.25*XMAX X75=0.25*XMIN+0.75*XMAX C C BLANK OUT THE GRAPH C DO1100I=1,45 DO1200J=1,109 IGRAPH(I,J)=BLANK 1200 CONTINUE 1100 CONTINUE C C PRODUCE THE VERTICAL AXES C DO1300I=3,43 IGRAPH(I,5)=ALPHAI IGRAPH(I,109)=ALPHAI 1300 CONTINUE DO1400I=3,43,5 IGRAPH(I,5)=HYPHEN IGRAPH(I,109)=HYPHEN 1400 CONTINUE IGRAPH(3,1)=EQUAL IGRAPH(3,2)=ALPHAM IGRAPH(3,3)=ALPHAA IGRAPH(3,4)=ALPHAX IGRAPH(23,1)=EQUAL IGRAPH(23,2)=ALPHAM IGRAPH(23,3)=ALPHAI IGRAPH(23,4)=ALPHAD IGRAPH(43,1)=EQUAL IGRAPH(43,2)=ALPHAM IGRAPH(43,3)=ALPHAI IGRAPH(43,4)=ALPHAN C C PRODUCE THE HORIZONTAL AXES C DO1500J=7,107 IGRAPH(1,J)=HYPHEN IGRAPH(45,J)=HYPHEN 1500 CONTINUE DO1600J=7,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1600 CONTINUE DO1700J=20,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1700 CONTINUE C C DETERMINE THE (X,Y) PLOT POSITIONS C RATIOY=40.0/(YMAX-YMIN) RATIOX=100.0/(XMAX-XMIN) DO1800I=1,N IF(X(I).GE.CUTOFF)GOTO1800 XI=I MX=RATIOX*(XI-XMIN)+0.5 MX=MX+7 MY=RATIOY*(X(I)-YMIN)+0.5 MY=43-MY IGRAPH(MY,MX)=ALPHAX 1800 CONTINUE C C WRITE OUT THE GRAPH C WRITE(IPR,2102) DO2100I=1,45 IP2=I+2 IFLAG=IP2-(IP2/5)*5 K=IP2/5 IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109) IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109) 2100 CONTINUE WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX C 2102 FORMAT(1H , 'THE FOLLOWING IS A PLOT OF X(I) (VERTICALLY) VERSUS 1 I (HORIZONTALLY)') 2105 FORMAT(1H ,20X,109A1) 2106 FORMAT(1H ,F20.7,109A1) 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7) 998 FORMAT(1H1) C RETURN END SUBROUTINE PLOTXT(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PLOTXT C C PURPOSE--THIS SUBROUTINE YIELDS A NARROW-WIDTH (71-CHARACTER) C PLOT OF X(I) VERSUS I. ITS NARROW WIDTH MAKES IT C APPROPRIATE FOR USE ON A TERMINAL. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED VERTICALLY. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--A NARROW-WIDTH (71-CHARACTER) TERMINAL PLOT C OF X(I) VERSUS I. C THE BODY OF THE PLOT (NOT COUNTING AXIS VALUES C AND MARGINS) IS 25 ROWS (LINES) AND 49 COLUMNS. C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (X) WHICH ARE C EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE C PLOTTED. C THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM C OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR X C ARE 'MISSING DATA', OR WHEN WE PURPOSELY C WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR X C FOR PLOTTING PURPOSES (THAT IS, WE DO NOT C WANT CERTAIN ELEMENTS IN X TO BE PLOTTED). C TO CAUSE SPECIFIC ELEMENTS IN X TO BE C IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND C (BY, FOR EXAMPLE, USE OF THE REPLAC SUBROUTINE) C BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND C THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTX C SUBROUTINE. C --NOTE THAT THE STORAGE REQUIREMENTS FOR THIS C (AND THE OTHER) TERMINAL PLOT SUBROUTINESS ARE . C VERY SMALL. C THIS IS DUE TO THE 'ONE LINE AT A TIME' ALGORITHM C EMPLOYED FOR THE PLOT. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--FEBRUARY 1974. C UPDATED --APRIL 1974. C UPDATED --OCTOBER 1974. C UPDATED --OCTOBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1977. C C--------------------------------------------------------------------- C CHARACTER*4 ILINE CHARACTER*4 IAXISC CHARACTER*4 SBNAM1,SBNAM2 CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22 CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX C DIMENSION X(1) DIMENSION ILINE(72),AILABL(10) C DATA SBNAM1,SBNAM2/'PLOT','XT '/ DATA ALPH11,ALPH12/'FIRS','T '/ DATA ALPH21,ALPH22/'SECO','ND '/ DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/ C IPR=6 CUTOFF=(10.0**10)-1000.0 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO52 GOTO54 52 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,20)N WRITE(IPR,5) RETURN 54 CONTINUE IF(N.EQ.1)GOTO56 GOTO58 56 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,22)N WRITE(IPR,5) RETURN 58 CONTINUE C HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO62 60 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 62 CONTINUE C DO76I=1,N IF(X(I).LT.CUTOFF)GOTO78 76 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 78 CONTINUE C 5 FORMAT(1H ,'**************************************************', 1'********************') 10 FORMAT(1H ,' FATAL ERROR ') 15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4, 1' SUBROUTINE') 20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,1H)) 22 FORMAT(1H ,'HAS THE VALUE 1') 30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8) 32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF') 33 FORMAT(1H ,'VALUE OF ',E15.8) C C-----START POINT----------------------------------------------------- C C DEFINE THE NUMBER OF ROWS AND COLUMNS WITHIN THE PLOT-- C THIS HAS BEEN SET TO 25 ROWS AND 49 COLUMNS. C NUMROW=25 NUMCOL=49 ANUMR=NUMROW ANUMRM=NUMROW-1 ANUMCM=NUMCOL-1 NUMR25=(NUMROW/4)+1 NUMR50=(NUMROW/2)+1 NUMR75=3*(NUMROW/4)+1 IXDEL=(NUMCOL-1)/4 NUMLAB=5 ANUMLM=NUMLAB-1 C C WRITE OUT THE TOP HORIZONTAL AXIS OF THE PLOT, AND SKIP 1 LINE C FOR A MARGIN WITHIN THE PLOT. C WRITE(IPR,999) WRITE(IPR,205) DO100ICOL=1,NUMCOL ILINE(ICOL)=HYPHEN 100 CONTINUE DO200ICOL=1,NUMCOL,IXDEL ILINE(ICOL)=ALPHAI 200 CONTINUE WRITE(IPR,305)(ILINE(I),I=1,NUMCOL) WRITE(IPR,310)BLANK C C DETERMINE THE MIN AND MAX VALUES OF X, AND OF I. C XMIN=X(1) XMAX=X(1) AIMIN=1 AIMAX=N DO300I=1,N IF(X(I).GE.CUTOFF)GOTO300 IF(X(I).LT.XMIN)XMIN=X(I) IF(X(I).GT.XMAX)XMAX=X(I) 300 CONTINUE DELX=XMAX-XMIN DELAI=AIMAX-AIMIN XWIDTH=DELX/ANUMRM AIWIDT=DELAI/ANUMCM C C DETERMINE AND WRITE OUT THE PLOT POSITIONS ONE LINE AT A TIME. C DO400IROW=1,NUMROW DO500ICOL=1,NUMCOL ILINE(ICOL)=BLANK 500 CONTINUE AIROW=IROW XUPPER=XMAX+(1.5-AIROW)*XWIDTH XLABLE=XMAX+(1.0-AIROW)*XWIDTH XLOWER=XMAX+(0.5-AIROW)*XWIDTH IF(IROW.EQ.NUMROW)XLABLE=XMIN DO600I=1,N AI=I IF(X(I).GE.CUTOFF)GOTO600 IF(XLOWER.LE.X(I).AND.X(I).LT.XUPPER)GOTO650 GOTO600 650 ICOL=((AI-AIMIN)/AIWIDT)+1.5 ILINE(ICOL)=ALPHAX 600 CONTINUE ICOLMX=1 DO700ICOL=1,NUMCOL IF(ILINE(ICOL).EQ.ALPHAX)ICOLMX=ICOL 700 CONTINUE IAXISC=ALPHAI IF(IROW.EQ.1.OR.IROW.EQ.NUMROW)IAXISC=HYPHEN IF(IROW.EQ.NUMR25.OR.IROW.EQ.NUMR50.OR.IROW.EQ.NUMR75) 1IAXISC=HYPHEN WRITE(IPR,710)XLABLE,IAXISC,(ILINE(ICOL),ICOL=1,ICOLMX) 400 CONTINUE C C SKIP 1 LINE FOR A BOTTOM MARGIN WITHIN THE PLOT, WRITE OUT THE C BOTTOM HORIZONTAL AXIS, AND WRITE OUT THE X AXIS LABLES. C WRITE(IPR,310)BLANK DO800ICOL=1,NUMCOL ILINE(ICOL)=HYPHEN 800 CONTINUE DO900ICOL=1,NUMCOL,IXDEL ILINE(ICOL)=ALPHAI 900 CONTINUE WRITE(IPR,305)(ILINE(ICOL),ICOL=1,NUMCOL) DO1000I=1,NUMLAB AIM1=I-1 AILABL(I)=AIMIN+(AIM1/ANUMLM)*DELAI 1000 CONTINUE WRITE(IPR,910)(AILABL(I),I=1,NUMLAB) C 205 FORMAT(1H , 'THE FOLLOWING IS A PLOT OF X(I) (VERTICALLY) ', 1'VERSUS I (HORIZONTALLY') 305 FORMAT(1H ,18X,54A1) 310 FORMAT(1H ,15X,A1) 710 FORMAT(1H ,E14.7,1X,A1,2X,50A1) 910 FORMAT(1H ,9X,5E12.4) 999 FORMAT(1H ) C RETURN END SUBROUTINE PLOTXX(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PLOTXX C C PURPOSE--THIS SUBROUTINE YIELDS A ONE-PAGE PRINTER PLOT C OF X(I) VERSUS X(I-1). C THIS TYPE OF PLOT (WHICH IS CALLED AN C AUTOCORRELATION PLOT OR A LAG 1 PLOT) C IS USEFUL IN EXAMINING FOR C AUTOCORRELATION IN A SEQUENCE OF OBSERVATIONS. C UNCORRELATED DATA WILL PRODUCE AN AUTOCORRELATION C PLOT WITH NO APPARENT STRUCTURE; AUTOCORRELATED C DATA WILL PRODUCE AN AUTOCORRELATION PLOT WITH C LINEAR, ELLIPTICAL, OR OTHER KINDS OF STRUCTURE. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED) OBSERVATIONS C TO BE GRAPHICALLY TESTED FOR C AUTOCORRELATION. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--A ONE-PAGE PRINTER PLOT OF X(I) VERSUS X(I-1). C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--VALUES IN THE INPUT VECTOR X WHICH ARE C EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE C PLOTTED. C THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM C OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR X C ARE 'MISSING DATA', OR WHEN WE PURPOSELY C WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR X C FOR PLOTTING PURPOSES (THAT IS, WE DO NOT C WANT CERTAIN ELEMENTS IN X TO BE PLOTTED). C TO CAUSE SPECIFIC ELEMENTS IN X TO BE C IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND C (BY, FOR EXAMPLE, USE OF THE REPLAC SUBROUTINE) C BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND C THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTXX C SUBROUTINE. C REFERENCES--FILLIBEN, 'SOME USEFUL PROCEDURES FOR THE C STATISTICAL ANALYSIS OF DATA', UNPUBLISHED C MANUSCRIPT (AVAILABLE FROM AUTHOR) C PRESENTED AT THE FALL CONFERENCE C OF THE CHEMICAL DIVISION OF THE AMERICAN C SOCIETY FOR QUALITY CONTROL, KNOXVILLE, C TENNESSEE, OCTOBER 19-20, 1972. C --FILLIBEN, 'DATA EXPLORATION USING STAND-ALONE C SUBROUTINES', UNPUBLISHED MANUSCRIPT C (AVAILABLE FROM AUTHOR) C PRESENTED AT THE 'STRATEGY FOR DATA ANALYSIS C BY COMPUTERS' SESSION AT THE NATIONAL C MEETING OF THE AMERICAN STATISTICAL ASSOCIATION, C ST. LOUIS, MISSOURI, AUGUST 26-29, 1974. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --OCTOBER 1974. C UPDATED --NOVEMBER 1974. C UPDATED --JANUARY 1975. C UPDATED --JULY 1975. C UPDATED --SEPTEMBER 1975. C UPDATED --OCTOBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C UPDATED --FEBRUARY 1977. C C--------------------------------------------------------------------- C CHARACTER*4 IGRAPH CHARACTER*4 SBNAM1,SBNAM2 CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22 CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX CHARACTER*4 ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL C DIMENSION X(1) DIMENSION YLABLE(11) COMMON /BLOCK1/ IGRAPH(55,130) C DATA SBNAM1,SBNAM2/'PLOT','XX '/ DATA ALPH11,ALPH12/'FIRS','T '/ DATA ALPH21,ALPH22/'SECO','ND '/ DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/ DATA ALPHAM,ALPHAA,ALPHAD,ALPHAN,EQUAL/'M','A','D','N','='/ C IPR=6 CUTOFF=(10.0**10)-1000.0 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C WRITE(IPR,998) IF(N.LT.1)GOTO52 GOTO54 52 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,20)N WRITE(IPR,5) RETURN 54 CONTINUE IF(N.EQ.1)GOTO56 GOTO58 56 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,22)N WRITE(IPR,5) RETURN 58 CONTINUE C HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO62 60 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 62 CONTINUE C DO76I=1,N IF(X(I).LT.CUTOFF)GOTO78 76 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 78 CONTINUE C 5 FORMAT(1H ,'**************************************************', 1'********************') 10 FORMAT(1H ,' FATAL ERROR ') 15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4, 1' SUBROUTINE') 20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,1H)) 22 FORMAT(1H ,'HAS THE VALUE 1') 30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8) 32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF') 33 FORMAT(1H ,'VALUE OF ',E15.8) C C-----START POINT----------------------------------------------------- C C DETERMINE THE VALUES TO BE LISTED ON THE LEFT VERTICAL AXIS C DO200I=1,N IF(X(I).GE.CUTOFF)GOTO200 YMIN=X(I) YMAX=X(I) GOTO250 200 CONTINUE 250 DO300I=1,N IF(X(I).GE.CUTOFF)GOTO300 IF(X(I).LT.YMIN)YMIN=X(I) IF(X(I).GT.YMAX)YMAX=X(I) 300 CONTINUE DO400I=1,9 AIM1=I-1 YLABLE(I)=YMAX-(AIM1/8.0)*(YMAX-YMIN) 400 CONTINUE C C DETERMINE THE VALUES TO BE LISTED ON THE BOTTOM HORIZONTAL AXIS. C DETERMINE XMIN, XMAX, XMID, X25 (=THE 25% POINT), AND C X75 (=THE 75% POINT). C XMIN=YMIN XMAX=YMAX XMID=(XMIN+XMAX)/2.0 X25=0.75*XMIN+0.25*XMAX X75=0.25*XMIN+0.75*XMAX C C BLANK OUT THE GRAPH C DO1100I=1,45 DO1200J=1,109 IGRAPH(I,J)=BLANK 1200 CONTINUE 1100 CONTINUE C C PRODUCE THE VERTICAL AXES C DO1300I=3,43 IGRAPH(I,5)=ALPHAI IGRAPH(I,109)=ALPHAI 1300 CONTINUE DO1400I=3,43,5 IGRAPH(I,5)=HYPHEN IGRAPH(I,109)=HYPHEN 1400 CONTINUE IGRAPH(3,1)=EQUAL IGRAPH(3,2)=ALPHAM IGRAPH(3,3)=ALPHAA IGRAPH(3,4)=ALPHAX IGRAPH(23,1)=EQUAL IGRAPH(23,2)=ALPHAM IGRAPH(23,3)=ALPHAI IGRAPH(23,4)=ALPHAD IGRAPH(43,1)=EQUAL IGRAPH(43,2)=ALPHAM IGRAPH(43,3)=ALPHAI IGRAPH(43,4)=ALPHAN C C PRODUCE THE HORIZONTAL AXES C DO1500J=7,107 IGRAPH(1,J)=HYPHEN IGRAPH(45,J)=HYPHEN 1500 CONTINUE DO1600J=7,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1600 CONTINUE DO1700J=20,107,25 IGRAPH(1,J)=ALPHAI IGRAPH(45,J)=ALPHAI 1700 CONTINUE C C DETERMINE THE (X,Y) PLOT POSITIONS C RATIOY=40.0/(YMAX-YMIN) RATIOX=100.0/(XMAX-XMIN) DO1800I=2,N IM1=I-1 IF(X(I).GE.CUTOFF)GOTO1800 IF(X(IM1).GE.CUTOFF)GOTO1800 MX=RATIOX*(X(IM1)-XMIN)+0.5 MX=MX+7 MY=RATIOY*(X(I)-YMIN)+0.5 MY=43-MY IGRAPH(MY,MX)=ALPHAX 1800 CONTINUE C C WRITE OUT THE GRAPH C WRITE(IPR,2102) DO2100I=1,45 IP2=I+2 IFLAG=IP2-(IP2/5)*5 K=IP2/5 IF(IFLAG.NE.0)WRITE(IPR,2105)(IGRAPH(I,J),J=1,109) IF(IFLAG.EQ.0)WRITE(IPR,2106)YLABLE(K),(IGRAPH(I,J),J=1,109) 2100 CONTINUE WRITE(IPR,2107)XMIN,X25,XMID,X75,XMAX C 2102 FORMAT(1H , 'THE FOLLOWING IS A PLOT OF X(I) (VERTICALLY) VERSUS 1 X(I-1) (HORIZONTALLY)') 2105 FORMAT(1H ,20X,109A1) 2106 FORMAT(1H ,F20.7,109A1) 2107 FORMAT(1H ,14X,F20.7,5X,F20.7,5X,F20.7,5X,F20.7,1X,F20.7) 998 FORMAT(1H1) C RETURN END SUBROUTINE PLTSCT(Y,X,CHAR,N,D,DMIN,DMAX) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PLTSCT C C PURPOSE--THIS SUBROUTINE YIELDS A NARROW-WIDTH (71-CHARACTER) C PLOT OF Y(I) VERSUS X(I): C 1) WITH SPECIAL PLOT CHARACTERS; AND C 2) WITH ONLY THOSE POINTS (X(I),Y(I)) PLOTTED C FOR WHICH THE CORRESPONDING VALUE OF D(I) C IS BETWEEN THE SPECIFIED VALUES OF DMIN AND DMAX. C C ITS NARROW WIDTH MAKES IT APPROPRIATE FOR USE ON A C TERMINAL. C THE 'SPECIAL PLOTTING CHARACTER' CAPABILITY C ALLOWS THE DATA ANALYST TO INCORPORATE INFORMATION C FROM A THIRD VARIABLE (ASIDE FROM Y AND X) INTO C THE PLOT. C THE PLOT CHARACTER USED AT THE I-TH PLOTTING C POSITION (THAT IS, AT THE COORDINATE (X(I),Y(I))) C WILL BE C 1 IF CHAR(I) IS BETWEEN 0.5 AND 1.5 C 2 IF CHAR(I) IS BETWEEN 1.5 AND 2.5 C . C . C . C 9 IF CHAR(I) IS BETWEEN 8.5 AND 9.5 C 0 IF CHAR(I) IS BETWEEN 9.5 AND 10.5 C A IF CHAR(I) IS BETWEEN 10.5 AND 11.5 C B IF CHAR(I) IS BETWEEN 11.5 AND 12.5 C C IF CHAR(I) IS BETWEEN 12.5 AND 13.5 C . C . C . C W IF CHAR(I) IS BETWEEN 32.5 AND 33.5 C X IF CHAR(I) IS BETWEEN 33.5 AND 34.5 C Y IF CHAR(I) IS BETWEEN 34.5 AND 35.5 C Z IF CHAR(I) IS BETWEEN 35.5 AND 36.5 C X IF CHAR(I) IS ANY VALUE OUTSIDE THE RANGE C 0.5 TO 36.5. C THE USE OF THE SUBSET DEFINTION VECTOR D C GIVES THE DATA ANALYST THE CAPABILITY OF C PLOTTING SUBSETS OF THE DATA, C WHERE THE SUBSET IS DEFINED C BY VALUES IN THE VECTOR D. C C INPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED VERTICALLY. C --X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C TO BE PLOTTED HORIZONTALLY. C --CHAR = THE SINGLE PRECISION VECTOR OF C OBSERVATIONS WHICH CONTROL THE C VALUE OF EACH INDIVIDUAL PLOT C CHARACTER. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR Y. C --D = THE SINGLE PRECISION VECTOR C WHICH 'DEFINES' THE VARIOUS C POSSIBLE SUBSETS. C --DMIN = THE SINGLE PRECISION VALUE C WHICH DEFINES THE LOWER BOUND C (INCLUSIVELY) OF THE PARTICULAR C SUBSET OF INTEREST TO BE PLOTTED. C --DMAX = THE SINGLE PRECISION VALUE C WHICH DEFINES THE UPPER BOUND C (INCLUSIVELY) OF THE PARTICULAR C SUBSET OF INTEREST TO BE PLOTTED. C OUTPUT--A NARROW-WIDTH (71-CHARACTER) TERMINAL PLOT C OF Y(I) VERSUS X(I) WITH SPECIAL PLOT CHARACTERS C AND FOR ONLY A SPECIFIED SUBSET OF THE DATA. C THE BODY OF THE PLOT (NOT COUNTING AXIS VALUES C AND MARGINS) IS 25 ROWS (LINES) AND 49 COLUMNS. C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--FOR A GIVEN DUMMY INDEX I, C IF D(I) IS SMALLER THAN DMIN OR LARGER THAN DMAX, C THEN THE CORRESPONDING POINT (X(I),Y(I)) C WILL NOT BE PLOTTED. C --VALUES IN THE VERTICAL AXIS VECTOR (Y), C THE HORIZONTAL AXIS VECTOR (X), C OR THE PLOT CHARACTER VECTOR (CHAR) WHICH ARE C EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE C PLOTTED. C THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM C OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR Y C (OR X, OR CHAR) ARE 'MISSING DATA', OR WHEN WE PURPOSELY C WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR Y C (OR X, OR CHAR) FOR PLOTTING PURPOSES (THAT IS, WE DO NOT C WANT CERTAIN ELEMENTS IN Y (OR X, OR CHAR) TO BE C PLOTTED). C TO CAUSE SPECIFIC ELEMENTS IN Y (OR X, OR CHAR) TO BE C IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND C (BY, FOR EXAMPLE, USE OF THE REPLAC SUBROUTINE) C BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND C THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTC C SUBROUTINE. C REFERENCES--FILLIBEN, 'STATISTICAL ANALYSIS OF INTERLAB C FATIGUE TIME DATA', UNPUBLISHED MANUSCRIPT C (AVAILABLE FROM AUTHOR) C PRESENTED AT THE 'COMPUTER-ASSISTED DATA C ANALYSIS' SESSION AT THE NATIONAL MEETING C OF THE AMERICAN STATISTICAL ASSOCIATION, C NEW YORK CITY, DECEMBER 27-30, 1973. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --FEBRUARY 1977. C C--------------------------------------------------------------------- C CHARACTER*4 ILINE CHARACTER*4 IAXISC CHARACTER*4 IPLOTC CHARACTER*4 JPLOTC CHARACTER*4 SBNAM1,SBNAM2 CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32 CHARACTER*4 ALPH41,ALPH42,ALPH51,ALPH52 CHARACTER*4 BLANK,HYPHEN,ALPHAI C DIMENSION Y(1) DIMENSION X(1) DIMENSION CHAR(1) DIMENSION D(1) DIMENSION ILINE(72),XLABLE(10) DIMENSION IPLOTC(37) C DATA SBNAM1,SBNAM2/'PLTS','CT '/ DATA ALPH11,ALPH12/'FIRS','T '/ DATA ALPH21,ALPH22/'SECO','ND '/ DATA ALPH31,ALPH32/'THIR','D '/ DATA ALPH41,ALPH42/'FOUR','TH '/ DATA ALPH51,ALPH52/'FIFT','H '/ DATA BLANK,HYPHEN,ALPHAI/' ','-','I'/ DATA IPLOTC(1),IPLOTC(2),IPLOTC(3),IPLOTC(4),IPLOTC(5), 1IPLOTC(6),IPLOTC(7),IPLOTC(8),IPLOTC(9),IPLOTC(10), 1IPLOTC(11),IPLOTC(12),IPLOTC(13),IPLOTC(14),IPLOTC(15), 1IPLOTC(16),IPLOTC(17),IPLOTC(18),IPLOTC(19),IPLOTC(20), 1IPLOTC(21),IPLOTC(22),IPLOTC(23),IPLOTC(24),IPLOTC(25), 1IPLOTC(26),IPLOTC(27),IPLOTC(28),IPLOTC(29),IPLOTC(30), 1IPLOTC(31),IPLOTC(32),IPLOTC(33),IPLOTC(34),IPLOTC(35), 1IPLOTC(36),IPLOTC(37) 1/'1','2','3','4','5','6','7','8','9','0','A','B','C','D','E','F', 1'G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V', 1'W','X','Y','Z','X'/ C IPR=6 CUTOFF=(10.0**10)-1000.0 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO52 GOTO54 52 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,20)N WRITE(IPR,5) RETURN 54 CONTINUE IF(N.EQ.1)GOTO56 GOTO58 56 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH41,ALPH42,SBNAM1,SBNAM2 WRITE(IPR,22)N WRITE(IPR,5) RETURN 58 CONTINUE C HOLD=Y(1) DO60I=2,N IF(Y(I).NE.HOLD)GOTO62 60 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 62 CONTINUE HOLD=X(1) DO64I=2,N IF(X(I).NE.HOLD)GOTO66 64 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 66 CONTINUE HOLD=CHAR(1) DO68I=2,N IF(CHAR(I).NE.HOLD)GOTO70 68 CONTINUE WRITE(IPR,5) WRITE(IPR,11) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) 70 CONTINUE HOLD=D(1) DO72I=2,N IF(D(I).NE.HOLD)GOTO74 72 CONTINUE WRITE(IPR,5) WRITE(IPR,11) WRITE(IPR,15)ALPH51,ALPH52,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) 74 CONTINUE C DO76I=1,N IF(Y(I).LT.CUTOFF)GOTO78 76 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 78 CONTINUE DO80I=1,N IF(X(I).LT.CUTOFF)GOTO82 80 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 82 CONTINUE DO84I=1,N IF(CHAR(I).LT.CUTOFF)GOTO86 84 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH31,ALPH32,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 86 CONTINUE DO88I=1,N IF(D(I).LT.CUTOFF)GOTO90 88 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH51,ALPH52,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 90 CONTINUE C DO92I=1,N IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)GOTO94 92 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH51,ALPH52,SBNAM1,SBNAM2 WRITE(IPR,34) WRITE(IPR,35)DMIN,DMAX WRITE(IPR,36) WRITE(IPR,5) RETURN 94 CONTINUE C N2=0 DO96I=1,N IF(Y(I).LT.CUTOFF.AND.X(I).LT.CUTOFF.AND.CHAR(I).LT.CUTOFF.AND. 1D(I).LT.CUTOFF)GOTO98 GOTO96 98 IF(DMIN.LT.D(I).AND.D(I).LT.DMAX)N2=N2+1 IF(N2.GE.2)GOTO99 96 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,18)ALPH11,ALPH12,ALPH21,ALPH22,ALPH31,ALPH32, 1ALPH51,ALPH52 WRITE(IPR,19)SBNAM1,SBNAM2 WRITE(IPR,40) WRITE(IPR,41)N2 WRITE(IPR,5) RETURN 99 CONTINUE C 5 FORMAT(1H ,'**************************************************', 1'********************') 10 FORMAT(1H ,' FATAL ERROR ') 11 FORMAT(1H ,' NON-FATAL DIAGNOSTIC ') 15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4, 1' SUBROUTINE') 18 FORMAT(1H ,'THE ',A4,A4,', ',A4,A4,', ',A4,A4,', AND ',A4,A4) 19 FORMAT(1H ,'INPUT ARGUMENTS TO THE ',A4,A4,' SUBROUTINE') 20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,')') 22 FORMAT(1H ,'HAS THE VALUE 1') 30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8) 32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF') 33 FORMAT(1H ,'VALUE OF ',E15.8) 34 FORMAT(1H ,'HAS ALL ELEMENTS OUTSIDE THE INTERVAL') 35 FORMAT(1H ,'(',E15.8,',',E15.8,')',' AS DEFINED BY') 36 FORMAT(1H ,'THE SIXTH AND SEVENTH INPUT ARGUMENTS.') 40 FORMAT(1H ,'ARE SUCH THAT TOO MANY POINTS HAVE BEEN', 1' EXCLUDED FROM THE PLOT.') 41 FORMAT(1H ,'ONLY ',I3,' POINTS ARE LEFT TO BE PLOTTED.') C C-----START POINT----------------------------------------------------- C C DEFINE THE NUMBER OF ROWS AND COLUMNS WITHIN THE PLOT--THIS HAS C BEEN SET TO 25 ROWS AND 49 COLUMNS. C NUMROW=25 NUMCOL=49 ANUMR=NUMROW ANUMRM=NUMROW-1 ANUMCM=NUMCOL-1 NUMR25=(NUMROW/4)+1 NUMR50=(NUMROW/2)+1 NUMR75=3*(NUMROW/4)+1 IXDEL=(NUMCOL-1)/4 NUMLAB=5 ANUMLM=NUMLAB-1 C C SKIP A LINE, WRITE OUT AN IDENTIFYING LINE FOR THE TYPE OF PLOT, C WRITE OUT THE TOP HORIZONTAL AXIS OF THE PLOT, AND SKIP 1 LINE C FOR A MARGIN WITHIN THE PLOT. C WRITE(IPR,999) WRITE(IPR,205) DO100ICOL=1,NUMCOL ILINE(ICOL)=HYPHEN 100 CONTINUE DO200ICOL=1,NUMCOL,IXDEL ILINE(ICOL)=ALPHAI 200 CONTINUE WRITE(IPR,305)(ILINE(I),I=1,NUMCOL) WRITE(IPR,310)BLANK C C DETERMINE THE MIN AND MAX VALUES OF Y, AND OF X. C DO250I=1,N IF(Y(I).GE.CUTOFF)GOTO250 IF(X(I).GE.CUTOFF)GOTO250 IF(CHAR(I).GE.CUTOFF)GOTO250 IF(D(I).LT.DMIN)GOTO250 IF(D(I).GT.DMAX)GOTO250 YMIN=Y(I) YMAX=Y(I) XMIN=X(I) XMAX=X(I) GOTO270 250 CONTINUE 270 DO300I=1,N IF(Y(I).GE.CUTOFF)GOTO300 IF(X(I).GE.CUTOFF)GOTO300 IF(CHAR(I).GE.CUTOFF)GOTO300 IF(D(I).LT.DMIN)GOTO300 IF(D(I).GT.DMAX)GOTO300 IF(Y(I).LT.YMIN)YMIN=Y(I) IF(Y(I).GT.YMAX)YMAX=Y(I) IF(X(I).LT.XMIN)XMIN=X(I) IF(X(I).GT.XMAX)XMAX=X(I) 300 CONTINUE DELY=YMAX-YMIN DELX=XMAX-XMIN YWIDTH=DELY/ANUMRM XWIDTH=DELX/ANUMCM C C DETERMINE AND WRITE OUT THE PLOT POSITIONS ONE LINE AT A TIME. C ALSO DETERMINE THE APPROPRIATE PLOT CHARACTERS. C DO400IROW=1,NUMROW DO500ICOL=1,NUMCOL ILINE(ICOL)=BLANK 500 CONTINUE AIROW=IROW YUPPER=YMAX+(1.5-AIROW)*YWIDTH YLABLE=YMAX+(1.0-AIROW)*YWIDTH YLOWER=YMAX+(0.5-AIROW)*YWIDTH IF(IROW.EQ.NUMROW)YLABLE=YMIN DO600I=1,N IF(Y(I).GE.CUTOFF)GOTO600 IF(X(I).GE.CUTOFF)GOTO600 IF(CHAR(I).GE.CUTOFF)GOTO600 IF(D(I).LT.DMIN)GOTO600 IF(D(I).GT.DMAX)GOTO600 IF(YLOWER.LE.Y(I).AND.Y(I).LT.YUPPER)GOTO650 GOTO600 650 ICOL=((X(I)-XMIN)/XWIDTH)+1.5 IA=CHAR(I)+0.5 IF(1.LE.IA.AND.IA.LE.36)GOTO630 620 JPLOTC=IPLOTC(37) GOTO640 630 JPLOTC=IPLOTC(IA) 640 ILINE(ICOL)=JPLOTC 600 CONTINUE ICOLMX=1 DO700ICOL=1,NUMCOL IF(ILINE(ICOL).NE.BLANK)ICOLMX=ICOL 700 CONTINUE IAXISC=ALPHAI IF(IROW.EQ.1.OR.IROW.EQ.NUMROW)IAXISC=HYPHEN IF(IROW.EQ.NUMR25.OR.IROW.EQ.NUMR50.OR.IROW.EQ.NUMR75) 1IAXISC=HYPHEN WRITE(IPR,710)YLABLE,IAXISC,(ILINE(ICOL),ICOL=1,ICOLMX) 400 CONTINUE C C SKIP 1 LINE FOR A BOTTOM MARGIN WITHIN THE PLOT, WRITE OUT THE C BOTTOM HORIZONTAL AXIS, AND WRITE OUT THE X AXIS LABLES. C WRITE(IPR,310)BLANK DO800ICOL=1,NUMCOL ILINE(ICOL)=HYPHEN 800 CONTINUE DO900ICOL=1,NUMCOL,IXDEL ILINE(ICOL)=ALPHAI 900 CONTINUE WRITE(IPR,305)(ILINE(ICOL),ICOL=1,NUMCOL) DO1000I=1,NUMLAB AIM1=I-1 XLABLE(I)=XMIN+(AIM1/ANUMLM)*DELX 1000 CONTINUE WRITE(IPR,910)(XLABLE(I),I=1,NUMLAB) C 205 FORMAT(1H , 'THE FOLLOWING IS A PLOT OF Y(I) VERSUS X(I)') 305 FORMAT(1H ,18X,54A1) 310 FORMAT(1H ,15X,A1) 710 FORMAT(1H ,E14.7,1X,A1,2X,50A1) 910 FORMAT(1H ,9X,5E12.4) 999 FORMAT(1H ) C RETURN END SUBROUTINE PLTXXT(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PLTXXT C C PURPOSE--THIS SUBROUTINE YIELDS A NARROW-WIDTH (71-CHARACTER) C PLOT OF X(I) VERSUS X(I-1). ITS NARROW WIDTH MAKES IT C APPROPRIATE FOR USE ON A TERMINAL. C THIS TYPE OF PLOT (WHICH IS CALLED AN C AUTOCORRELATION PLOT OR A LAG 1 PLOT) C IS USEFUL IN EXAMINING FOR C AUTOCORRELATION IN A SEQUENCE OF OBSERVATIONS. C UNCORRELATED DATA WILL PRODUCE AN AUTOCORRELATION C PLOT WITH NO APPARENT STRUCTURE; AUTOCORRELATED C DATA WILL PRODUCE AN AUTOCORRELATION PLOT WITH C LINEAR, ELLIPTICAL, OR OTHER KINDS OF STRUCTURE. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED) OBSERVATIONS C TO BE GRAPHICALLY TESTED FOR C AUTOCORRELATION. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--A NARROW-WIDTH (71-CHARACTER) TERMINAL PLOT C OF X(I) VERSUS X(I-1). C THE BODY OF THE PLOT (NOT COUNTING AXIS VALUES C AND MARGINS) IS 25 ROWS (LINES) AND 49 COLUMNS. C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--VALUES IN THE VERTICAL AXIS VECTOR (X) WHICH ARE C EQUAL TO OR IN EXCESS OF 10.0**10 WILL NOT BE C PLOTTED. C THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM C OF PLOTTING WHEN SOME ELEMENTS IN THE VECTOR X C ARE 'MISSING DATA', OR WHEN WE PURPOSELY C WANT TO IGNORE CERTAIN ELEMENTS IN THE VECTOR X C FOR PLOTTING PURPOSES (THAT IS, WE DO NOT C WANT CERTAIN ELEMENTS IN X TO BE PLOTTED). C TO CAUSE SPECIFIC ELEMENTS IN X TO BE C IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND C (BY, FOR EXAMPLE, USE OF THE REPLAC SUBROUTINE) C BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND C THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLTXXT C SUBROUTINE. C --NOTE THAT THE STORAGE REQUIREMENTS FOR THIS C (AND THE OTHER) TERMINAL PLOT SUBROUTINESS ARE . C VERY SMALL. C THIS IS DUE TO THE 'ONE LINE AT A TIME' ALGORITHM C EMPLOYED FOR THE PLOT. C REFERENCES--FILLIBEN, 'SOME USEFUL PROCEDURES FOR THE C STATISTICAL ANALYSIS OF DATA', UNPUBLISHED C MANUSCRIPT (AVAILABLE FROM AUTHOR) C PRESENTED AT THE FALL CONFERENCE C OF THE CHEMICAL DIVISION OF THE AMERICAN C SOCIETY FOR QUALITY CONTROL, KNOXVILLE, C TENNESSEE, OCTOBER 19-20, 1972. C --FILLIBEN, 'DATA EXPLORATION USING STAND-ALONE C SUBROUTINES', UNPUBLISHED MANUSCRIPT C (AVAILABLE FROM AUTHOR) C PRESENTED AT THE 'STRATEGY FOR DATA ANALYSIS C BY COMPUTERS' SESSION AT THE NATIONAL C MEETING OF THE AMERICAN STATISTICAL ASSOCIATION, C ST. LOUIS, MISSOURI, AUGUST 26-29, 1974. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--FEBRUARY 1974. C UPDATED --APRIL 1974. C UPDATED --OCTOBER 1974. C UPDATED --OCTOBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1977. C C--------------------------------------------------------------------- C CHARACTER*4 ILINE CHARACTER*4 IAXISC CHARACTER*4 SBNAM1,SBNAM2 CHARACTER*4 ALPH11,ALPH12,ALPH21,ALPH22 CHARACTER*4 BLANK,HYPHEN,ALPHAI,ALPHAX C DIMENSION X(1) DIMENSION ILINE(72),X2LABL(10) C DATA SBNAM1,SBNAM2/'PLTX','XT '/ DATA ALPH11,ALPH12/'FIRS','T '/ DATA ALPH21,ALPH22/'SECO','ND '/ DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/ C IPR=6 CUTOFF=(10.0**10)-1000.0 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO52 GOTO54 52 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,20)N WRITE(IPR,5) RETURN 54 CONTINUE IF(N.EQ.1)GOTO56 GOTO58 56 WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH21,ALPH22,SBNAM1,SBNAM2 WRITE(IPR,22)N WRITE(IPR,5) RETURN 58 CONTINUE C HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO62 60 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,30)HOLD WRITE(IPR,5) RETURN 62 CONTINUE C DO76I=1,N IF(X(I).LT.CUTOFF)GOTO78 76 CONTINUE WRITE(IPR,5) WRITE(IPR,10) WRITE(IPR,15)ALPH11,ALPH12,SBNAM1,SBNAM2 WRITE(IPR,32) WRITE(IPR,33)CUTOFF WRITE(IPR,5) RETURN 78 CONTINUE C 5 FORMAT(1H ,'**************************************************', 1'********************') 10 FORMAT(1H ,' FATAL ERROR ') 15 FORMAT(1H ,'THE ',A4,A4,' INPUT ARGUMENT TO THE ',A4,A4, 1' SUBROUTINE') 20 FORMAT(1H ,'IS NON-NEGATIVE (WITH VALUE = ',I8,1H)) 22 FORMAT(1H ,'HAS THE VALUE 1') 30 FORMAT(1H ,'HAS ALL ELEMENTS = ',E15.8) 32 FORMAT(1H ,'HAS ALL ELEMENTS IN EXCESS OF THE CUTOFF') 33 FORMAT(1H ,'VALUE OF ',E15.8) C C-----START POINT----------------------------------------------------- C C DEFINE THE NUMBER OF ROWS AND COLUMNS WITHIN THE PLOT-- C THIS HAS BEEN SET TO 25 ROWS AND 49 COLUMNS. C NUMROW=25 NUMCOL=49 ANUMR=NUMROW ANUMRM=NUMROW-1 ANUMCM=NUMCOL-1 NUMR25=(NUMROW/4)+1 NUMR50=(NUMROW/2)+1 NUMR75=3*(NUMROW/4)+1 IXDEL=(NUMCOL-1)/4 NUMLAB=5 ANUMLM=NUMLAB-1 C C WRITE OUT THE TOP HORIZONTAL AXIS OF THE PLOT, AND SKIP 1 LINE C FOR A MARGIN WITHIN THE PLOT. C WRITE(IPR,999) WRITE(IPR,205) DO100ICOL=1,NUMCOL ILINE(ICOL)=HYPHEN 100 CONTINUE DO200ICOL=1,NUMCOL,IXDEL ILINE(ICOL)=ALPHAI 200 CONTINUE WRITE(IPR,305)(ILINE(I),I=1,NUMCOL) WRITE(IPR,310)BLANK C C DETERMINE THE MIN AND MAX VALUES OF X. C XMIN=X(1) XMAX=X(1) DO300I=1,N IF(X(I).GE.CUTOFF)GOTO300 IF(X(I).LT.XMIN)XMIN=X(I) IF(X(I).GT.XMAX)XMAX=X(I) 300 CONTINUE DELX=XMAX-XMIN XRWIDT=DELX/ANUMRM XCWIDT=DELX/ANUMCM C C DETERMINE AND WRITE OUT THE PLOT POSITIONS ONE LINE AT A TIME. C DO400IROW=1,NUMROW DO500ICOL=1,NUMCOL ILINE(ICOL)=BLANK 500 CONTINUE AIROW=IROW XUPPER=XMAX+(1.5-AIROW)*XRWIDT XLABLE=XMAX+(1.0-AIROW)*XRWIDT XLOWER=XMAX+(0.5-AIROW)*XRWIDT IF(IROW.EQ.NUMROW)XLABLE=XMIN DO600I=2,N IM1=I-1 IF(X(IM1).GE.CUTOFF)GOTO600 IF(X(I).GE.CUTOFF)GOTO600 IF(XLOWER.LE.X(I).AND.X(I).LT.XUPPER)GOTO650 GOTO600 650 ICOL=((X(IM1)-XMIN)/XCWIDT)+1.5 ILINE(ICOL)=ALPHAX 600 CONTINUE ICOLMX=1 DO700ICOL=1,NUMCOL IF(ILINE(ICOL).EQ.ALPHAX)ICOLMX=ICOL 700 CONTINUE IAXISC=ALPHAI IF(IROW.EQ.1.OR.IROW.EQ.NUMROW)IAXISC=HYPHEN IF(IROW.EQ.NUMR25.OR.IROW.EQ.NUMR50.OR.IROW.EQ.NUMR75) 1IAXISC=HYPHEN WRITE(IPR,710)XLABLE,IAXISC,(ILINE(ICOL),ICOL=1,ICOLMX) 400 CONTINUE C C SKIP 1 LINE FOR A BOTTOM MARGIN WITHIN THE PLOT, WRITE OUT THE C BOTTOM HORIZONTAL AXIS, AND WRITE OUT THE X AXIS LABLES. C WRITE(IPR,310)BLANK DO800ICOL=1,NUMCOL ILINE(ICOL)=HYPHEN 800 CONTINUE DO900ICOL=1,NUMCOL,IXDEL ILINE(ICOL)=ALPHAI 900 CONTINUE WRITE(IPR,305)(ILINE(ICOL),ICOL=1,NUMCOL) DO1000I=1,NUMLAB AIM1=I-1 X2LABL(I)=XMIN+(AIM1/ANUMLM)*DELX 1000 CONTINUE WRITE(IPR,910)(X2LABL(I),I=1,NUMLAB) C 205 FORMAT(1H , 'THE FOLLOWING IS A PLOT OF X(I) (VERTICALLY) VS. , 1 21HX(I-1) (HORIZONTALLY)') 305 FORMAT(1H ,18X,54A1) 310 FORMAT(1H ,15X,A1) 710 FORMAT(1H ,E14.7,1X,A1,2X,50A1) 910 FORMAT(1H ,9X,5E12.4) 999 FORMAT(1H ) C RETURN END SUBROUTINE POICDF(X,ALAMBA,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT POICDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE AT THE SINGLE PRECISION VALUE X C FOR THE POISSON DISTRIBUTION C WITH SINGLE PRECISION C TAIL LENGTH PARAMETER = ALAMBA. C THE POISSON DISTRIBUTION USED C HEREIN HAS MEAN = ALAMBA C AND STANDARD DEVIATION = SQRT(ALAMBA). C THIS DISTRIBUTION IS DEFINED FOR C ALL DISCRETE NON-NEGATIVE INTEGER X--X = 0, 1, 2, ... . C THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION C F(X) = EXP(-ALAMBA) * ALAMBA**X / X!. C THE POISSON DISTRIBUTION IS THE C DISTRIBUTION OF THE NUMBER OF EVENTS C IN THE INTERVAL (0,ALAMBA) WHEN C THE WAITING TIME BETWEEN EVENTS C IS EXPONENTIALLY DISTRIBUTED C WITH MEAN = 1 AND STANDARD DEVIATION = 1. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE C AT WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C X SHOULD BE NON-NEGATIVE AND C INTEGRAL-VALUED. C --ALAMBA = THE SINGLE PRECISION VALUE C OF THE TAIL LENGTH PARAMETER. C ALAMBA SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF C FOR THE POISSON DISTRIBUTION C WITH TAIL LENGTH PARAMETER = ALAMBA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--X SHOULD BE NON-NEGATIVE AND INTEGRAL-VALUED. C --ALAMBA SHOULD BE POSITIVE. C OTHER DATAPAC SUBROUTINES NEEDED--NORCDF. C FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DATAN. C MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--THE SINGLE PRECISION TAIL LENGTH C PARAMETER ALAMBA IS NOT RESTRICTED C TO ONLY INTEGER VALUES. C ALAMBA CAN BE SET TO ANY POSITIVE REAL C VALUE--INTEGER OR NON-INTEGER. C --NOTE THAT EVEN THOUGH THE INPUT C TO THIS CUMULATIVE C DISTRIBUTION FUNCTION SUBROUTINE C FOR THIS DISCRETE DISTRIBUTION C SHOULD (UNDER NORMAL CIRCUMSTANCES) BE A C DISCRETE INTEGER VALUE, C THE INPUT VARIABLE X IS SINGLE C PRECISION IN MODE. C X HAS BEEN SPECIFIED AS SINGLE C PRECISION SO AS TO CONFORM WITH THE DATAPAC C CONVENTION THAT ALL INPUT ****DATA**** C (AS OPPOSED TO SAMPLE SIZE, FOR EXAMPLE) C VARIABLES TO ALL C DATAPAC SUBROUTINES ARE SINGLE PRECISION. C THIS CONVENTION IS BASED ON THE BELIEF THAT C 1) A MIXTURE OF MODES (FLOATING POINT C VERSUS INTEGER) IS INCONSISTENT AND C AN UNNECESSARY COMPLICATION C IN A DATA ANALYSIS; AND C 2) FLOATING POINT MACHINE ARITHMETIC C (AS OPPOSED TO INTEGER ARITHMETIC) C IS THE MORE NATURAL MODE FOR DOING C DATA ANALYSIS. C REFERENCES--JOHNSON AND KOTZ, DISCRETE C DISTRIBUTIONS, 1969, PAGES 87-121, C ESPECIALLY PAGE 114, FORMULA 93. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGE 112. C --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 941, FORMULAE 26.4.4 AND 26.4.5, C AND PAGE 929. C --FELLER, AN INTRODUCTION TO PROBABILITY C THEORY AND ITS APPLICATIONS, VOLUME 1, C EDITION 2, 1957, PAGES 146-154. C --COX AND MILLER, THE THEORY OF STOCHASTIC C PROCESSES, 1965, PAGE 7. C --GENERAL ELECTRIC COMPANY, TABLES OF THE C INDIVIDUAL AND CUMULATIVE TERMS OF POISSON C DISTRIBUTION, 1962. C --OWEN, HANDBOOK OF STATISTICAL C TABLES, 1962, PAGES 259-261. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C C--------------------------------------------------------------------- C DOUBLE PRECISION DX,PI,CHI,SUM,TERM,AI,DGCDF DOUBLE PRECISION DSQRT,DEXP DATA PI/3.14159265358979D0/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(ALAMBA.LE.0.0)GOTO50 IF(X.LT.0.0)GOTO55 INTX=X+0.0001 FINTX=INTX DEL=X-FINTX IF(DEL.LT.0.0)DEL=-DEL IF(DEL.GT.0.001)GOTO60 GOTO90 50 WRITE(IPR,15) WRITE(IPR,46)ALAMBA CDF=0.0 RETURN 55 WRITE(IPR,4) WRITE(IPR,46)X CDF=0.0 RETURN 60 WRITE(IPR,5) WRITE(IPR,46)X 90 CONTINUE 4 FORMAT(1H , 96H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE POICDF SUBROUTINE IS NEGATIVE *****) 5 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE POICDF SUBROUTINE IS NON-INTEGRAL *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 POICDF SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C C EXPRESS THE POISSON CUMULATIVE DISTRIBUTION C FUNCTION IN TERMS OF THE EQUIVALENT CHI-SQUARED C CUMULATIVE DISTRIBUTION FUNCTION, C AND THEN EVALUATE THE LATTER. C DX=ALAMBA DX=2.0D0*DX NU=X+0.0001 NU=2*(1+NU) C 110 CHI=DSQRT(DX) IEVODD=NU-2*(NU/2) IF(IEVODD.EQ.0)GOTO120 C SUM=0.0D0 TERM=1.0/CHI IMIN=1 IMAX=NU-1 GOTO130 C 120 SUM=1.0D0 TERM=1.0D0 IMIN=2 IMAX=NU-2 C 130 IF(IMIN.GT.IMAX)GOTO160 DO100I=IMIN,IMAX,2 AI=I TERM=TERM*(DX/AI) SUM=SUM+TERM 100 CONTINUE C 160 SUM=SUM*DEXP(-DX/2.0D0) IF(IEVODD.EQ.0)GOTO170 SUM=(DSQRT(2.0D0/PI))*SUM SPCHI=CHI CALL NORCDF(SPCHI,GCDF) DGCDF=GCDF SUM=SUM+2.0D0*(1.0D0-DGCDF) 170 CDF=SUM C RETURN END SUBROUTINE POIPLT(X,N,ALAMBA) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT POIPLT C C PURPOSE--THIS SUBROUTINE GENERATES A POISSON C PROBABILITY PLOT C (WITH SINGLE PRECISION C TAIL LENGTH PARAMETER = ALAMBA). C THE PROTOTYPE POISSON DISTRIBUTION USED C HEREIN HAS MEAN = ALAMBA C AND STANDARD DEVIATION = SQRT(ALAMBA). C THIS DISTRIBUTION IS DEFINED FOR C ALL DISCRETE NON-NEGATIVE INTEGER X--X = 0, 1, 2, ... . C THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION C F(X) = EXP(-ALAMBA) * ALAMBA**X / X!. C THE POISSON DISTRIBUTION IS THE C DISTRIBUTION OF THE NUMBER OF EVENTS C IN THE INTERVAL (0,ALAMBA) WHEN C THE WAITING TIME BETWEEN EVENTS C IS EXPONENTIALLY DISTRIBUTED C WITH MEAN = 1 AND STANDARD DEVIATION = 1. C THE PROTOTYPE DISTRIBUTION RESTRICTIONS OF C DISCRETENESS AND NON-NEGATIVENESS C MENTIONED ABOVE DO NOT CARRY OVER TO THE C INPUT VECTOR X OF OBSERVATIONS TO BE ANALYZED. C THE INPUT OBSERVATIONS IN X MAY BE DISCRETE, CONTINUOUS, C NON-NEGATIVE, OR NEGATIVE. C AS USED HEREIN, A PROBABILITY PLOT FOR A DISTRIBUTION C IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS C THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION. C THE POISSON PROBABILITY PLOT IS USEFUL IN C GRAPHICALLY TESTING THE COMPOSITE (THAT IS, C LOCATION AND SCALE PARAMETERS NEED NOT BE SPECIFIED) C HYPOTHESIS THAT THE UNDERLYING DISTRIBUTION C FROM WHICH THE DATA HAVE BEEN RANDOMLY DRAWN C IS THE POISSON DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = ALAMBA. C IF THE HYPOTHESIS IS TRUE, THE PROBABILITY PLOT C SHOULD BE NEAR-LINEAR. C A MEASURE OF SUCH LINEARITY IS GIVEN BY THE C CALCULATED PROBABILITY PLOT CORRELATION COEFFICIENT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --ALAMBA = THE SINGLE PRECISION VALUE OF THE C TAIL LENGTH PARAMETER. C ALAMBA SHOULD BE POSITIVE. C OUTPUT--A ONE-PAGE POISSON PROBABILITY PLOT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 5000. C --ALAMBA SHOULD BE POSITIVE. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, PLOT, C CHSCDF, NORPPF. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--FOR LARGE VALUES OF ALAMBA (IN EXCESS OF 500.) C THIS SUBROUTINE USES THE NORMAL APPROXIMATION TO C THE POISSON. THIS IS DONE TO SAVE EXECUTION TIME C WHICH INCREASES AS A FUNCTION OF ALAMBA AND WOULD C BE EXCESSIVE FOR LARGE VALUES OF ALAMBA. C REFERENCES--FILLIBEN, 'TECHNIQUES FOR TAIL LENGTH ANALYSIS', C PROCEEDINGS OF THE EIGHTEENTH CONFERENCE C ON THE DESIGN OF EXPERIMENTS IN ARMY RESEARCH C DEVELOPMENT AND TESTING (ABERDEEN, MARYLAND, C OCTOBER, 1972), PAGES 425-450. C --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING, C 1967, PAGES 260-308. C --JOHNSON AND KOTZ, DISCRETE C DISTRIBUTIONS, 1969, PAGES 87-121. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1974. C UPDATED --AUGUST 1975. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(5000),W(5000) DIMENSION Z(5000) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(W(1),WS(5001)) EQUIVALENCE (Z(1),WS(10001)) C IPR=6 IUPPER=5000 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 IF(ALAMBA.LE.0.0)GOTO60 HOLD=X(1) DO65I=2,N IF(X(I).NE.HOLD)GOTO90 65 CONTINUE WRITE(IPR, 9)HOLD RETURN 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 60 WRITE(IPR,25) WRITE(IPR,46)ALAMBA RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE POIPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 POIPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE POIPLT SUBROUTINE HAS THE VALUE 1 *****) 25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 POIPLT SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N CUTOFF=500.0 C C SORT THE DATA C CALL SORT(X,N,Y) C C GENERATE UNIFORM ORDER STATISTIC MEDIANS C CALL UNIMED(N,W) C C COMPUTE POISSON ORDER STATISTIC MEDIANS. C IF THE INPUT ALAMBA VALUE IS LARGE (IN EXCESS OF C CUTOFF VALUE OF 500.0), THEN USE THE NORMAL APPROXIMATION C TO THE POISSON. C IF(ALAMBA.LE.CUTOFF)GOTO150 SQALAM=SQRT(ALAMBA) DO170I=1,N CALL NORPPF(W(I),W(I)) W(I)=ALAMBA+W(I)*SQALAM 170 CONTINUE GOTO1550 150 CONTINUE C C DETERMINE WHICH UNIFORM ORDER STATISTIC MEDIAN IS ASSOCIATED WITH C THE CLOSEST INTEGER TO ALAMBA. C DO100I=1,N Z(I)=-1.0 100 CONTINUE C ILAMBA=ALAMBA+0.5 ARG1=2.0*ALAMBA IARG2=2*(ILAMBA+1) CALL CHSCDF(ARG1,IARG2,CDF) CDF=1.0-CDF DO200J=1,N IF(W(J).GT.CDF)GOTO250 200 CONTINUE 250 JM1=J-1 Z(JM1)=ILAMBA C C FILL IN THE POISSON ORDER STATISTIC MEDIANS BELOW ALAMBA C IMAX=6.0*SQRT(ALAMBA) DO500I=1,IMAX K=ILAMBA-I IF(K.LT.0)GOTO750 IARG2=2*(K+1) CALL CHSCDF(ARG1,IARG2,CDF) CDF=1.0-CDF DO600J=1,N IF(W(J).GT.CDF)GOTO650 600 CONTINUE 650 JM1=J-1 IF(JM1.LE.0)GOTO750 IF(Z(JM1).LT.-0.5)Z(JM1)=K 500 CONTINUE C C FILL IN THE POISSON ORDER STATISTIC MEDIANS ABOVE ALAMBA C 750 DO800I=1,IMAX K=ILAMBA+I IARG2=2*(K+1) CALL CHSCDF(ARG1,IARG2,CDF) CDF=1.0-CDF DO900J=1,N IF(W(J).GT.CDF)GOTO950 900 CONTINUE Z(N)=K GOTO1050 950 JM1=J-1 IF(Z(JM1).LT.-0.5)Z(JM1)=K 800 CONTINUE C C FILL IN THE EMPTY HOLES IN THE POISSON ORDER STATISTIC MEDIAN C Z MATRIX WITH THE PROPER VALUES. C THEN FOR SAKE OF CONSISTENCY WITH OTHER DATAPAC C PROBABILITY PLOT SUBROUTINES, COPY THE Z VECTOR C INTO THE W VECTOR. C 1050 HOLD=Z(N) DO1200IREV=1,N I=N-IREV+1 IF(Z(I).GE.-0.5)HOLD=Z(I) IF(Z(I).LT.-0.5)Z(I)=HOLD 1200 CONTINUE DO1300I=1,N W(I)=Z(I) 1300 CONTINUE C C PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS. C WRITE OUT THE SAMPLE SIZE. C 1550 CALL PLOT(Y,W,N) WRITE(IPR,2105)ALAMBA,N C C COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. C COMPUTE LOCATION AND SCALE ESTIMATES C FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. C THEN WRITE THEM OUT. C SUM1=0.0 SUM2=0.0 DO2200I=1,N SUM1=SUM1+Y(I) SUM2=SUM2+W(I) 2200 CONTINUE YBAR=SUM1/AN WBAR=SUM2/AN SUM1=0.0 SUM2=0.0 SUM3=0.0 DO2300I=1,N SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 2300 CONTINUE CC=SUM2/SQRT(SUM3*SUM1) YSLOPE=SUM2/SUM3 YINT=YBAR-YSLOPE*WBAR WRITE(IPR,2305)CC,YINT,YSLOPE C 2105 FORMAT(1H ,42HPOISSON PROBABILITY PLOT WITH PARAMETER = ,9X, 1E17.10,1X,8X,11X,20HTHE SAMPLE SIZE N = ,I7) 2305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X, 122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) C RETURN END SUBROUTINE POIPPF(P,ALAMBA,PPF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT POIPPF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE AT THE SINGLE PRECISION VALUE P C FOR THE POISSON DISTRIBUTION C WITH SINGLE PRECISION C TAIL LENGTH PARAMETER = ALAMBA. C THE POISSON DISTRIBUTION USED C HEREIN HAS MEAN = ALAMBA C AND STANDARD DEVIATION = SQRT(ALAMBA). C THIS DISTRIBUTION IS DEFINED FOR C ALL DISCRETE NON-NEGATIVE INTEGER X--X = 0, 1, 2, ... . C THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION C F(X) = EXP(-ALAMBA) * ALAMBA**X / X!. C THE POISSON DISTRIBUTION IS THE C DISTRIBUTION OF THE NUMBER OF EVENTS C IN THE INTERVAL (0,ALAMBA) WHEN C THE WAITING TIME BETWEEN EVENTS C IS EXPONENTIALLY DISTRIBUTED C WITH MEAN = 1 AND STANDARD DEVIATION = 1. C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 (INCLUSIVELY) C AND 1.0 (EXCLUSIVELY)) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C --ALAMBA = THE SINGLE PRECISION VALUE C OF THE TAIL LENGTH PARAMETER. C ALAMBA SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT . C FUNCTION VALUE PPF C FOR THE POISSON DISTRIBUTION C WITH TAIL LENGTH PARAMETER = ALAMBA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--ALAMBA SHOULD BE POSITIVE. C --P SHOULD BE BETWEEN 0.0 (INCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C OTHER DATAPAC SUBROUTINES NEEDED--NORPPF, POICDF. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, DEXP. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION AND DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--THE SINGLE PRECISION TAIL LENGTH C PARAMETER ALAMBA IS NOT RESTRICTED C TO ONLY INTEGER VALUES. C ALAMBA CAN BE SET TO ANY POSITIVE REAL C VALUE--INTEGER OR NON-INTEGER. C --NOTE THAT EVEN THOUGH THE OUTPUT C FROM THIS DISCRETE DISTRIBUTION C PERCENT POINT FUNCTION C SUBROUTINE MUST NECESSARILY BE A C DISCRETE INTEGER VALUE, C THE OUTPUT VARIABLE PPF IS SINGLE C PRECISION IN MODE. C PPF HAS BEEN SPECIFIED AS SINGLE C PRECISION SO AS TO CONFORM WITH THE DATAPAC C CONVENTION THAT ALL OUTPUT VARIABLES FROM ALL C DATAPAC SUBROUTINES ARE SINGLE PRECISION. C THIS CONVENTION IS BASED ON THE BELIEF THAT C 1) A MIXTURE OF MODES (FLOATING POINT C VERSUS INTEGER) IS INCONSISTENT AND C AN UNNECESSARY COMPLICATION C IN A DATA ANALYSIS; AND C 2) FLOATING POINT MACHINE ARITHMETIC C (AS OPPOSED TO INTEGER ARITHMETIC) C IS THE MORE NATURAL MODE FOR DOING C DATA ANALYSIS. C REFERENCES--JOHNSON AND KOTZ, DISCRETE C DISTRIBUTIONS, 1969, PAGES 87-121, C ESPECIALLY PAGE 102, FORMULA 36.1. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGES 108-113. C --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 929. C --FELLER, AN INTRODUCTION TO PROBABILITY C THEORY AND ITS APPLICATIONS, VOLUME 1, C EDITION 2, 1957, PAGES 146-154. C --COX AND MILLER, THE THEORY OF STOCHASTIC C PROCESSES, 1965, PAGE 7. C --GENERAL ELECTRIC COMPANY, TABLES OF THE C INDIVIDUAL AND CUMULATIVE TERMS OF POISSON C DISTRIBUTION, 1962. C --OWEN, HANDBOOK OF STATISTICAL C TABLES, 1962, PAGES 259-261. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C C--------------------------------------------------------------------- C DOUBLE PRECISION DLAMBA C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LT.0.0.OR.P.GE.1.0)GOTO50 IF(ALAMBA.LE.0.0)GOTO55 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P PPF=0.0 RETURN 55 WRITE(IPR,15) WRITE(IPR,46)ALAMBA PPF=0.0 RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 POIPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 POIPPF SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C DLAMBA=ALAMBA PPF=0.0 IX0=0 IX1=0 IX2=0 P0=0.0 P1=0.0 P2=0.0 C C TREAT CERTAIN SPECIAL CASES IMMEDIATELY-- C 1) P = 0.0 C 2) PPF = 0 C IF(P.EQ.0.0)GOTO110 PF0=DEXP(-DLAMBA) IF(P.LE.PF0)GOTO110 GOTO190 110 PPF=0.0 RETURN 190 CONTINUE C C DETERMINE AN INITIAL APPROXIMATION TO THE POISSON C PERCENT POINT BY USE OF THE NORMAL APPROXIMATION C TO THE POISSON. C (SEE JOHNSON AND KOTZ, DISCRETE DISTRIBUTIONS, C PAGE 102, FORMULA 36.1). C AMEAN=ALAMBA SD=SQRT(ALAMBA) CALL NORPPF(P,ZPPF) X2=AMEAN-1.0+ZPPF*SD IX2=X2 C C CHECK AND MODIFY (IF NECESSARY) THIS INITIAL C ESTIMATE OF THE PERCENT POINT C TO ASSURE THAT IT BE NON-NEGATIVE. C IF(IX2.LT.0)IX2=0 C C DETERMINE UPPER AND LOWER BOUNDS ON THE DESIRED C PERCENT POINT BY ITERATING OUT (BOTH BELOW AND ABOVE) C FROM THE ORIGINAL APPROXIMATION AT STEPS C OF 1 STANDARD DEVIATION. C THE RESULTING BOUNDS WILL BE AT MOST C 1 STANDARD DEVIATION APART. C IX0=0 IX1=10**10 ISD=SD+1.0 X2=IX2 CALL POICDF(X2,ALAMBA,P2) C IF(P2.LT.P)GOTO210 GOTO250 C 210 IX0=IX2 DO220I=1,100000 IX2=IX0+ISD IF(IX2.GE.IX1)GOTO275 X2=IX2 CALL POICDF(X2,ALAMBA,P2) IF(P2.GE.P)GOTO230 IX0=IX2 220 CONTINUE WRITE(IPR,249) WRITE(IPR,222) GOTO950 230 IX1=IX2 GOTO275 C 250 IX1=IX2 DO260I=1,100000 IX2=IX1-ISD IF(IX2.LE.IX0)GOTO275 X2=IX2 CALL POICDF(X2,ALAMBA,P2) IF(P2.LT.P)GOTO270 IX1=IX2 260 CONTINUE WRITE(IPR,249) WRITE(IPR,262) GOTO950 270 IX0=IX2 C 275 IF(IX0.EQ.IX1)GOTO280 GOTO295 280 IF(IX0.EQ.0)GOTO285 CCCCC IF(IX0.EQ.N)GOTO290 WRITE(IPR,249) WRITE(IPR,282) GOTO950 285 IX1=IX1+1 GOTO295 290 IX0=IX0-1 295 CONTINUE C C COMPUTE POISSON PROBABILITIES FOR THE C DERIVED LOWER AND UPPER BOUNDS. C X0=IX0 X1=IX1 CALL POICDF(X0,ALAMBA,P0) CALL POICDF(X1,ALAMBA,P1) C C CHECK THE PROBABILITIES FOR PROPER ORDERING C IF(P0.LT.P.AND.P.LE.P1)GOTO490 IF(P0.EQ.P)GOTO410 IF(P1.EQ.P)GOTO420 IF(P0.GT.P1)GOTO430 IF(P0.GT.P)GOTO440 IF(P1.LT.P)GOTO450 WRITE(IPR,249) WRITE(IPR,401) GOTO950 410 PPF=IX0 RETURN 420 PPF=IX1 RETURN 430 WRITE(IPR,249) WRITE(IPR,431) GOTO950 440 WRITE(IPR,249) WRITE(IPR,441) GOTO950 450 WRITE(IPR,249) WRITE(IPR,451) GOTO950 490 CONTINUE C C THE STOPPING CRITERION IS THAT THE LOWER BOUND C AND UPPER BOUND ARE EXACTLY 1 UNIT APART. C CHECK TO SEE IF IX1 = IX0 + 1; C IF SO, THE ITERATIONS ARE COMPLETE; C IF NOT, THEN BISECT, COMPUTE PROBABILIIES, C CHECK PROBABILITIES, AND CONTINUE ITERATING C UNTIL IX1 = IX0 + 1. C 300 IX0P1=IX0+1 IF(IX1.EQ.IX0P1)GOTO690 IX2=(IX0+IX1)/2 IF(IX2.EQ.IX0)GOTO610 IF(IX2.EQ.IX1)GOTO620 X2=IX2 CALL POICDF(X2,ALAMBA,P2) IF(P0.LT.P2.AND.P2.LT.P1)GOTO630 IF(P2.LE.P0)GOTO640 IF(P2.GE.P1)GOTO650 610 WRITE(IPR,249) WRITE(IPR,611) GOTO950 620 WRITE(IPR,249) WRITE(IPR,611) GOTO950 630 IF(P2.LE.P)GOTO635 IX1=IX2 P1=P2 GOTO300 635 IX0=IX2 P0=P2 GOTO300 640 WRITE(IPR,249) WRITE(IPR,641) GOTO950 650 WRITE(IPR,249) WRITE(IPR,651) GOTO950 690 PPF=IX1 IF(P0.EQ.P)PPF=IX0 RETURN C 950 WRITE(IPR,240)IX0,P0 WRITE(IPR,241)IX1,P1 WRITE(IPR,242)IX2,P2 WRITE(IPR,244)P WRITE(IPR,245)ALAMBA RETURN C 222 FORMAT(1H ,43HNO UPPER BOUND FOUND AFTER 10**7 ITERATIONS) 240 FORMAT(1H ,9HIX0 = ,I8,10X,5HP0 = ,F14.7) 241 FORMAT(1H ,9HIX1 = ,I8,10X,5HP1 = ,F14.7) 242 FORMAT(1H ,9HIX2 = ,I8,10X,5HP2 = ,F14.7) 244 FORMAT(1H ,9HP = ,F14.7) 245 FORMAT(1H ,9HALAMBA = ,F14.7) 249 FORMAT(1H ,47H***** INTERNAL ERROR IN POIPPF SUBROUTINE *****) 262 FORMAT(1H ,43HNO LOWER BOUND FOUND AFTER 10**7 ITERATIONS) 282 FORMAT(1H ,31HLOWER AND UPPER BOUND IDENTICAL) 401 FORMAT(1H ,39HIMPOSSIBLE BRANCH CONDITION ENCOUNTERED) 431 FORMAT(1H ,42HLOWER BOUND PROBABILITY (P0) GREATER THAN , 1 28HUPPER BOUND PROBABILITY (P1)) 441 FORMAT(1H ,42HLOWER BOUND PROBABILITY (P0) GREATER THAN , 1 21HINPUT PROBABILITY (P)) 451 FORMAT(1H ,42HUPPER BOUND PROBABILITY (P1) LESS THAN , 1 21HINPUT PROBABILITY (P)) 611 FORMAT(1H ,39HBISECTION VALUE (X2) = LOWER BOUND (X0)) 621 FORMAT(1H ,39HBISECTION VALUE (X2) = UPPER BOUND (X1)) 641 FORMAT(1H ,33HBISECTION VALUE PROBABILITY (P2) , 1 38HLESS THAN LOWER BOUND PROBABILITY (P0)) 651 FORMAT(1H ,33HBISECTION VALUE PROBABILITY (P2) , 1 41HGREATER THAN UPPER BOUND PROBABILITY (P1)) C END SUBROUTINE POIRAN(N,ALAMBA,ISEED,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT POIRAN C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE POISSON DISTRIBUTION C WITH SINGLE PRECISION C TAIL LENGTH PARAMETER = ALAMBA. C THE POISSON DISTRIBUTION USED C HEREIN HAS MEAN = ALAMBA C AND STANDARD DEVIATION = SQRT(ALAMBA). C THIS DISTRIBUTION IS DEFINED FOR C ALL DISCRETE NON-NEGATIVE INTEGER X--X = 0, 1, 2, ... . C THIS DISTRIBUTION HAS THE PROBABILITY FUNCTION C F(X) = EXP(-ALAMBA) * ALAMBA**X / X!. C THE POISSON DISTRIBUTION IS THE C DISTRIBUTION OF THE NUMBER OF EVENTS C IN THE INTERVAL (0,ALAMBA) WHEN C THE WAITING TIME BETWEEN EVENTS C IS EXPONENTIALLY DISTRIBUTED C WITH MEAN = 1 AND STANDARD DEVIATION = 1. C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C --ALAMBA = THE SINGLE PRECISION VALUE C OF THE TAIL LENGTH PARAMETER. C ALAMBA SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE POISSON DISTRIBUTION C WITH TAIL LENGTH PARAMETER = ALAMBA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C --ALAMBA SHOULD BE POSITIVE. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C COMMENT--THE SINGLE PRECISION TAIL LENGTH C PARAMETER ALAMBA IS NOT RESTRICTED C TO ONLY INTEGER VALUES. C ALAMBA CAN BE SET TO ANY POSITIVE REAL C VALUE--INTEGER OR NON-INTEGER. C COMMENT--NOTE THAT EVEN THOUGH THE OUTPUT C FROM THIS DISCRETE RANDOM NUMBER C GENERATOR MUST NECESSARILY BE A C SEQUENCE OF ***INTEGER*** VALUES, C THE OUTPUT VECTOR X IS SINGLE C PRECISION IN MODE. C X HAS BEEN SPECIFIED AS SINGLE C PRECISION SO AS TO CONFORM WITH THE DATAPAC C CONVENTION THAT ALL OUTPUT VECTORS FROM ALL C DATAPAC SUBROUTINES ARE SINGLE PRECISION. C THIS CONVENTION IS BASED ON THE BELIEF THAT C 1) A MIXTURE OF MODES (FLOATING POINT C VERSUS INTEGER) IS INCONSISTENT AND C AN UNNECESSARY COMPLICATION C IN A DATA ANALYSIS; AND C 2) FLOATING POINT MACHINE ARITHMETIC C (AS OPPOSED TO INTEGER ARITHMETIC) C IS THE MORE NATURAL MODE FOR DOING C DATA ANALYSIS. C REFERENCES--COX AND MILLER, THE THEORY OF STOCHASTIC C PROCESSES, 1965, PAGE 7. C --TOCHER, THE ART OF SIMULATION, C 1963, PAGES 36-37. C --JOHNSON AND KOTZ, DISCRETE C DISTRIBUTIONS, 1969, PAGES 87-121. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGES 108-113. C --FELLER, AN INTRODUCTION TO PROBABILITY C THEORY AND ITS APPLICATIONS, VOLUME 1, C EDITION 2, 1957, PAGES 146-154. C --NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS C SERIES 55, 1964, PAGE 929. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82.6 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) C C--------------------------------------------------------------------- C CCCCC CHARACTER*4 IFEEDB CCCCC CHARACTER*4 IPRINT C CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW CCCCC COMMON /PRINT/IFEEDB,IPRINT C IPR=6 C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(ALAMBA.LE.0.0)GOTO55 GOTO90 50 WRITE(IPR, 5) WRITE(IPR,47)N RETURN 55 WRITE(IPR,15) WRITE(IPR,46)ALAMBA RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 POIRAN SUBROUTINE IS NON-POSITIVE *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 POIRAN SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C GENERATE N POISSON RANDOM NUMBERS C USING THE FACT THAT THE DISTRIBUTION C OF EXPONENTIAL WAITING TIMES IS POISSON. C DO100I=1,N SUM=0.0 J=1 150 CALL UNIRAN(1,ISEED,U) E=-ALOG(1.0-U) SUM=SUM+E IF(SUM.GT.ALAMBA)GOTO250 J=J+1 GOTO150 250 X(I)=J-1 100 CONTINUE C RETURN END SUBROUTINE POLY(Y,X,W,N,IDEG,IWRITE,B,SDB,S,DF,PRED,RES) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT POLY EXTERNAL DOT C C PURPOSE--THIS SUBROUTINE COMPUTES A LEAST SQUARES C POLYNOMIAL FIT (OF DEGREE = IDEG) OF THE C RESPONSE VARIABLE DATA IN THE SINGLE PRECISION C VECTOR Y AS A FUNCTION OF THE INDEPENDENT C VARIABLE DATA IN THE SINGLE PRECISION C VECTOR X. C INPUT ARGUMENTS--Y = SINGLE PRECISION VECTOR OF C RESPONSE DATA (THAT IS, THE C DEPENDENT VARIABLE). C --X = SINGLE PRECISION VECTOR OF C THE INDEPENDENT VARIABLE. C --W = THE SINGLE PRECISION VECTOR C OF WEIGHTS FOR THE RESPONSE C VARIABLE. C --N = THE INTEGER VALUE OF THE SAMPLE SIZE. C --IDEG = THE INTEGER VALUE OF THE DESIRED C DEGREE OF THE POLYNOMIAL C TO BE FIT. C --IWRITE = THE INTEGER VALUE WHICH IF ZERO WILL C RESULT IN NO PRINTED OUTPUT, AND IF C NON-ZERO (E.G., 1) WILL RESULT IN C SOME LIMITED PRINTED OUTPUT C (COEFFICIENTS, STANDARD DEVIATIONS OF C COEFFICIENTS, RESIDUAL STANDARD DEVIATION). C OUTPUT ARGUMENTS--B = THE SINGLE PRECISION VECTOR OF C ESTIMATED REGRESSION COEFFICIENTS. C --SDB = THE SINGLE PRECISION VECTOR OF C ESTIMATED STANDARD DEVIATIONS OF THE C ESTIMATED REGRESSION COEFFICIENTS. C --S = THE ESTIMATED RESIDUAL STANDARD C DEVIATION. C --DF = THE DEGREES OF FREEDOM C ASSOCIATED WITH THE RESIDUAL C STANDARD DEVIATION = C NUMBER OF OBSERVATIONS MINUS C NUMBER OF PARAMETERS = C N - (IDEG + 1). C --PRED = THE SINGLE PRECISION VECTOR OF C PREDICTED VALUES FROM THE C LEAST SQUARES FIT. C --RES = THE SINGLE PRECISION VECTOR OF C RESIDUALS FROM THE LEAST SQUARES FIT. C SUBROUTINES NEEDED--DECOMP, INVXWX, DOT, FCDF. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--MARCH 1974 C UPDATED--OCTOBER 1974 C UPDATED--MARCH 1975 C UPDATED--MAY 1975 C UPDATED--JULY 1975 C UPDATED--SEPTEMBER 1975 C UPDATED--NOVEMBER 1975. C UPDATED--FEBRUARY 1976. C UPDATED--JUNE 1976. C UPDATED--OCTOBER 1976. C UPDATED--MAY 1977. C UPDATED--JUNE 1977. C C--------------------------------------------------------------------- C DIMENSION Y(1),X(1),W(1),B(1),SDB(1),PRED(1),RES(1) DIMENSION B2(50) DIMENSION F(3000),WRES(3000),G(50),H(50) DIMENSION Q(10000),R(2500),D(50),IPIVOT(50) COMMON /BLOCK2/ WS(15000) COMMON /BLOCK3/ DUM1(3000),DUM2(3000) EQUIVALENCE (Q(1),WS(1)) EQUIVALENCE (R(1),WS(10001)) EQUIVALENCE (D(1),WS(12501)) EQUIVALENCE (IPIVOT(1),WS(12551)) C IPR=6 AN=N K=IDEG+1 AK=K NK=N*K KK=K*K NMAX=3000 KMAX=50 NKMAX=10000 C C-----START POINT----------------------------------------------------- C C WRITE OUT THE TITLE C IF(IWRITE.EQ.0)GOTO150 WRITE(IPR,999) WRITE(IPR,999) WRITE(IPR,101) WRITE(IPR,102)N WRITE(IPR,103)IDEG C C PRE-SET THE OUTPUT VARIABLES AND VECTORS C TO A LARGE VALUE C IN CASE A PREMATURE EXIT OCCURS DUE TO NUMERICAL INSTABILITY. C 150 VALUE=(10.0**10)+1000.0 S=VALUE IF(K.LE.0)GOTO155 DO160I=1,K B(I)=VALUE SDB(I)=VALUE 160 CONTINUE 155 IF(N.LE.0)GOTO175 DO170I=1,N RES(I)=VALUE 170 CONTINUE C C CHECK THE INPUT ARGUMENTS N AND K C 175 IF(N.LE.0.OR.N.GT.NMAX)WRITE(IPR,105)N,NMAX IF(N.LE.0.OR.N.GT.NMAX)RETURN IF(K.LE.0.OR.K.GT.KMAX)WRITE(IPR,110)K,KMAX IF(K.LE.0.OR.K.GT.KMAX)RETURN IF(K.GT.N)WRITE(IPR,115)K,N IF(K.GT.N)RETURN C C INSPECT THE WEIGHT VECTOR W--IF ALL ELEMENTS ARE IDENTICAL, C THEN RESET ALL ELEMENTS TO 1.0. THIS AVOIDS THE C PROBLEM OF AN UNDEFINED EMPTY WEIGHT VECTOR W WHEN C IN FACT AN EQUAL WEIGHTING SCHEME IS DESIRED. C IWFLAG=0 WHOLD=W(1) DO600I=1,N IF(W(I).EQ.WHOLD)GOTO600 GOTO850 600 CONTINUE IWFLAG=1 850 IF(IWFLAG.EQ.0.AND.IWRITE.NE.0)WRITE(IPR,851) IF(IWFLAG.EQ.1.AND.IWRITE.NE.0)WRITE(IPR,852) C C COMPUTE THE ORIGINAL FORM FOR THE Q MATRIX C WHICH WILL BE IDENTICAL TO THE DATA MATRIX X C OF INDEPENDENT VARIABLES IF THE WEIGHTS C SPECIFIED ARE ALL EQUAL. NOTE THAT THE C DATA MATRIX X IS NEVER COMPUTED AS SUCH. C NOTE THAT THE DATA MATRIX X IS NOT TO BE C CONFUSED WITH THE SINGLE INDEPENDENT C VARIABLE VECTOR X. C THE Q MATRIX WILL BE CHANGED IN THE DECOMP SUBROUTINE. C DO100J=1,K IF(J.EQ.1)GOTO250 IF(J.EQ.2)GOTO350 JM1=J-1 DO200I=1,N IQARG1=(I-1)*K+J IQARG2=(I-1)*K+JM1 Q(IQARG1)=Q(IQARG2)*X(I) 200 CONTINUE GOTO100 250 DO300I=1,N IQARG=(I-1)*K+1 Q(IQARG)=1.0 300 CONTINUE GOTO100 350 DO400I=1,N IQARG=(I-1)*K+2 Q(IQARG)=X(I) 400 CONTINUE 100 CONTINUE IF(IWFLAG.EQ.1)GOTO1440 DO1300I=1,N DO1400J=1,K IQARG=(I-1)*K+J Q(IQARG)=Q(IQARG)*SQRT(W(I)) 1400 CONTINUE 1300 CONTINUE C C COMPUTE ETA AND TOL (FOR THE UNIVAC 1108, ETA = 2**-27) C WHICH WILL BE USED IN THE DECOMP SUBROUTINE C 1440 ETA=1.0 1450 ETA=0.5*ETA ETAP1=ETA+1.0 IF(ETAP1.GT.1.0)GOTO1450 TOL=ETA*AK NM5=N-5 NKM5=NK-5 CCCCC WRITE(IPR,1505)(Y(I),I=1,6) CCCCC WRITE(IPR,1505)(Y(I),I=NM5,N) CCCCC WRITE(IPR,1505)(X(I),I=1,6) CCCCC WRITE(IPR,1505)(X(I),I=NM5,N) CCCCC WRITE(IPR,1505)(W(I),I=1,6) CCCCC WRITE(IPR,1505)(W(I),I=NM5,N) CCCCC WRITE(IPR,1505)(Q(IQARG),IQARG=1,6) CCCCC WRITE(IPR,1505)(Q(IQARG),IQARG=NKM5,NK) CCCCC WRITE(IPR,1505)(Q(IQARG),IQARG=1,NK) C CALL DECOMP(N,K,ETA,TOL,IRANK,INSING) C CCCCC WRITE(IPR,1505)(Q(IQARG),IQARG=1,NK) CCCCC WRITE(IPR,1505)(R(IRARG),IRARG=1,KK) CCCCC WRITE(IPR,1505)(D(J),J=1,K) IF(INSING.EQ.1)GOTO1550 WRITE(IPR,1510)IRANK,K RETURN 1550 KP1=K+1 C C *************************************************************** C C THE PURPOSE OF THIS NEXT SEGMENT (BETWEEN THE STARRED LINES) C IS TO SOLVE FOR THE DESIRED REGRESSION COEFFICIENTS. C ITERATIVE REFINEMENT IS USED. C A SECOND OUTPUT FROM THIS SEGMENT IS THE RESIDUALS FROM THE C FINAL FIT. C A THIRD OUTPUT FROM THIS SEGMENT IS AN INDICATION (IN THE C VARIABLE ICONV) AS TO WHETHER THE ITERATIVE REFINEMENT C CONVERGED OR NOT. C X--USED IN THIS SEGMENT C Q--USED IN THIS SEGMENT C R--USED IN THIS SEGMENT C D--USED IN THIS SEGMENT C IPIVOT--USED IN THIS SEGMENT C C ETA2=ETA*ETA B2(KP1)=-1.0 DO 50010 I=1,N F(I)=Y(I) WRES(I)=0.0 RES(I)=0.0 50010 CONTINUE DO 50020 J=1,K B2(J)=0.0 G(J)=0.0 H(J)=0.0 50020 CONTINUE M=0 AMDB2=0.0 AMDR2=0.0 C C BEGIN THE M-TH ITERATION STEP IN THE ITERATIVE REFINEMENT C 50030 IF (M.LT.2) GO TO 50040 IF (((64.*AMDB2.LT.AMDB1).AND.(AMDB2.GT.ETA2*AMB)).OR.((64.*AMDR2. 1LT.AMDR1).AND.(AMDR2.GT.ETA2*AMR))) GO TO 50040 GO TO 50250 50040 AMDB1=AMDB2 AMDR1=AMDR2 AMDB2=0.0 AMDR2=0.0 IF (M.EQ.0) GO TO 50100 C C BEGIN FORMING NEW RESIDUALS C IF(IWFLAG.EQ.0)GOTO50044 DO50045I=1,N WRES(I)=WRES(I)+F(I) RES(I)=RES(I)+F(I) 50045 CONTINUE GOTO50055 50044 DO 50050 I=1,N WRES(I)=WRES(I)+F(I)*SQRT(W(I)) RES(I)=RES(I)+F(I)/SQRT(W(I)) 50050 CONTINUE 50055 DO 50070 IS=1,IRANK J=IPIVOT(IS) B2(J)=B2(J)+G(IS) DO 50060 L=1,N IF(J.GE.2)GOTO50065 DUM1(L)=1.0 GOTO50060 50065 DUM1(L)=X(L)**(J-1) 50060 CONTINUE C CALL DOT(DUM1,WRES,1,N,0.0,G(IS)) 50070 G(IS)=-G(IS) C DO 50090 I=1,N E=RES(I) DO 50080 L=1,K IF(L.GE.2)GOTO50085 DUM1(L)=1.0 GOTO50080 50085 DUM1(L)=X(I)**(L-1) 50080 CONTINUE DUM1(KP1)=Y(I) C CALL DOT(DUM1,B2,1,KP1,E,F(I)) IF(IWFLAG.EQ.0)F(I)=-F(I)*SQRT(W(I)) IF(IWFLAG.EQ.1)F(I)=-F(I) 50090 CONTINUE C C END FORMING NEW RESIDUALS C 50100 DO 50150 IS=1,IRANK J=IPIVOT(IS) IF (IS.NE.1) GO TO 50110 50110 ISM1=IS-1 DO 50120 L=1,ISM1 IRARG=(L-1)*K+IS 50120 DUM1(L)=R(IRARG) ANEGGI=-G(IS) C CALL DOT(DUM1,H,1,ISM1,ANEGGI,H(IS)) H(IS)=-H(IS) C E=-H(IS) DO 50130 L=1,N IQARG=(L-1)*K+J 50130 DUM1(L)=Q(IQARG) C CALL DOT(DUM1,F,1,N,E,E) E=E/D(IS) C G(IS)=E DO 50140 I=1,N IQARG=(I-1)*K+J 50140 F(I)=F(I)-E*Q(IQARG) 50150 CONTINUE C DO 50210 IS=1,IRANK JS=IRANK+1-IS JSP1=JS+1 DO 50200 L=JSP1,IRANK IRARG=(JS-1)*K+L 50200 DUM1(L)=R(IRARG) ANEGGJ=-G(JS) C CALL DOT(DUM1,G,JSP1,IRANK,ANEGGJ,G(JS)) 50210 G(JS)=-G(JS) C DO 50220 IS=1,IRANK 50220 AMDB2=AMDB2+G(IS)*G(IS) DO 50230 I=1,N 50230 AMDR2=AMDR2+F(I)*F(I) IF (M.NE.0) GO TO 50240 AMB=AMDB2 AMR=AMDR2 50240 CONTINUE CCCCC WRITE(IPR,50505)M CCCCC WRITE(IPR,50506)(B2(I),I=1,K) CCCCC DO5555I=1,N CCCCC WRITE(IPR,50506)Y(I),X(I),RES(I),WRES(I),F(I),G(I),H(I) C5555 CONTINUE 50505 FORMAT(I8) 50506 FORMAT(1H ,8F10.5) C C END THE M-TH ITERATION STEP IN THE ITERATIVE REFINEMENT C M=M+1 GO TO 50030 50250 IF ((AMDR2.GT.4.*ETA2*AMR).AND.(AMDB2.GT.4.*ETA2*AMB)) GO TO 50260 ICONV=1 GO TO 1700 50260 ICONV=0 C C *************************************************************** C 1700 IF(ICONV.EQ.1)GOTO1750 WRITE(IPR,1520) RETURN C C ADJUST THE R MATRIX C WHICH WILL BE USED IN THE INVERT (INVRR) SUBROUTINE. C 1750 DO1800J=1,K IRARG=(J-1)*K+J R(IRARG)=SQRT(D(J)) IF(J.EQ.K)GOTO1800 JP1=J+1 DO1900L=JP1,K IRARG1=(J-1)*K+L IRARG2=(J-1)*K+J R(IRARG1)=R(IRARG1)*R(IRARG2) 1900 CONTINUE 1800 CONTINUE CCCCC WRITE(IPR,1505)(R(IRARG),IRARG=1,KK) C CALL INVXWX(N,K) C CCCCC WRITE(IPR,1505)(R(IRARG),IRARG=1,KK) C C COMPUTE STATISTICAL CALCULATIONS AND THEN WRITE OUT COEFFICIENTS C AND STANDARD DEVIATIONS OF COEFFICIENTS ALONG WITH THE C RESIDUAL STANDARD DEVIATION. C DO3040I=1,K B(I)=B2(I) 3040 CONTINUE DO3070I=1,N IF(RES(I).EQ.0.0)GOTO3070 GOTO3050 3070 CONTINUE WRITE(IPR,3080) 3080 FORMAT(' ',10X,'NOTE THAT AN EXACT FIT HAS BEEN OBTAINED') 3050 SUM=0.0 IF(IWFLAG.EQ.0)GOTO3060 DO3055I=1,N SUM=SUM+RES(I)*RES(I) 3055 CONTINUE RESSS=SUM GOTO3105 3060 DO3100I=1,N SUM=SUM+RES(I)*RES(I)*W(I) 3100 CONTINUE 3105 IF(K.EQ.N.AND.IWRITE.NE.0)WRITE(IPR,3110)K IF(K.EQ.N)GOTO3250 3110 FORMAT(1H ,10X,72HNOTE THAT THE NUMBER OF COEFFICIENTS K 1 = THE SAMPLE SIZE N = ,I8) RESDF=AN-AK DF=RESDF IRESDF=AN-AK+0.5 RESMS=RESSS/RESDF S=SQRT(RESMS) 3250 CONTINUE CCCCC WRITE(IPR,3205) DO3300I=1,N PRED(I)=Y(I)-RES(I) CCCCC WRITE(IPR,3305)Y(I),PRED(I),RES(I) 3300 CONTINUE IF(K.EQ.N)GOTO3450 GOTO3480 3450 IF(IWRITE.NE.0)WRITE(IPR,3455) 3455 FORMAT(1H ,21H J B(J)) DO3460I=1,K IF(IWRITE.NE.0)WRITE(IPR,3405)J,B(J) 3460 CONTINUE RETURN 3480 IF(IWRITE.NE.0)WRITE(IPR,3310)S IF(IWRITE.NE.0)WRITE(IPR,3311)IRESDF IF(IWRITE.NE.0)WRITE(IPR,3312) IF(IWRITE.NE.0)WRITE(IPR,3315) DO3400J=1,K IRARG=(J-1)*K+J SDB(J)=S*SQRT(R(IRARG)) T=B(J)/SDB(J) IF(IWRITE.NE.0)WRITE(IPR,3405)J,B(J),SDB(J),T 3400 CONTINUE C C COMPUTE THE COVARIANCE AND CORRELATION MATRIX OF THE COEFFICIENTS C DO3500I=1,K DO3600J=1,K IRARG=(I-1)*K+J R(IRARG)=R(IRARG)*S*S 3600 CONTINUE 3500 CONTINUE DO2200I=1,K DO2300J=1,K IF(I.EQ.J)GOTO2300 IRARG1=(I-1)*K+J IRARG2=(I-1)*K+I IRARG3=(J-1)*K+J R(IRARG1)=R(IRARG1)/SQRT(R(IRARG2)*R(IRARG3)) 2300 CONTINUE 2200 CONTINUE DO2400J=1,K IRARG=(J-1)*K+J R(IRARG)=1.0 2400 CONTINUE CCCCC WRITE(IPR,2405) DO2500I=1,K IRAMIN=(I-1)*K+1 IRAMAX=I*K CCCCC WRITE(IPR,2505)(R(IRARG),IRARG=IRAMIN,IRAMAX) 2500 CONTINUE C C CHECK FOR REPLICATION. C IF SO, COMPUTE A POOLED STANDARD DEVIATION. C THEN COMPUTE A LACK OF FIT F TEST. C C DETERMINE THE NUMBER OF DISTINCT SUBSETS C NUMSET=0 DO4200I=1,N IF(NUMSET.EQ.0)GOTO4350 DO4300J=1,NUMSET IF(X(I).EQ.DUM1(J))GOTO4200 4300 CONTINUE 4350 NUMSET=NUMSET+1 DUM1(NUMSET)=X(I) 4200 CONTINUE IF(NUMSET.EQ.0)WRITE(IPR,4205) IF(NUMSET.EQ.0)RETURN C C COPY OUT EACH SUBSET INTO THE DUM2 VECTOR C AND ANALYZE IT THEREIN C IREPDF=0 REPSS=0.0 DO4600ISET=1,NUMSET NI=0 DO4700I=1,N IF(X(I).EQ.DUM1(ISET))NI=NI+1 IF(X(I).EQ.DUM1(ISET))DUM2(NI)=Y(I) 4700 CONTINUE ANI=NI SUM=0.0 DO5100I=1,NI SUM=SUM+DUM2(I) 5100 CONTINUE YMEAN=SUM/ANI SUM=0.0 DO5200I=1,NI SUM=SUM+(DUM2(I)-YMEAN)**2 5200 CONTINUE IREPDF=IREPDF+NI-1 REPSS=REPSS+SUM 4600 CONTINUE IF(IREPDF.LE.0)RETURN REPDF=IREPDF REPV=REPSS/REPDF REPSD=SQRT(REPV) IF(IWRITE.NE.0)WRITE(IPR,999) IF(IWRITE.NE.0)WRITE(IPR,4930)REPSD IF(IWRITE.NE.0)WRITE(IPR,4935)IREPDF IF(IWRITE.NE.0)WRITE(IPR,4933)NUMSET IFITDF=IRESDF-IREPDF IF(IFITDF.GE.1)GOTO5250 IF(IWRITE.NE.0)WRITE(IPR,4936) IF(IWRITE.NE.0)WRITE(IPR,4937) IF(IWRITE.NE.0)WRITE(IPR,4938) IF(IWRITE.NE.0)WRITE(IPR,4939) RETURN 5250 FITDF=IFITDF FITSS=RESSS-REPSS FITMS=FITSS/FITDF FSTAT=FITMS/RESMS CALL FCDF(FSTAT,IFITDF,IREPDF,CDF) CDF2=100.0*CDF IF(IWRITE.NE.0)WRITE(IPR,4940)FSTAT,CDF2 IF(IWRITE.NE.0)WRITE(IPR,4945)IFITDF,IREPDF C 999 FORMAT(1H ) 1505 FORMAT(1H ,6E15.8) 1510 FORMAT(1H ,51H*****ERROR--THE MATRIX IS SINGULAR--IT HAS IRANK = , 1I8,51H WHICH IS LESS THAN THE NUMBER OF COEFFICIENTS K = ,I8,6H ** 1***) 1520 FORMAT(1H ,51H*****ERROR--THE ITERATIONS ARE NOT CONVERGING *****) 1605 FORMAT(1H ,I8,5X,E15.8) 2005 FORMAT(1H ,8E15.8) 2405 FORMAT(1H ,34HCORRELATION MATRIX OF COEFFICIENTS) 2505 FORMAT(1H ,8E15.8) 3205 FORMAT(1H ,44H OBSERVED PREDICTED RESIDUALS) 3305 FORMAT(1H ,8E15.8) 3310 FORMAT(1H ,10X,30HRESIDUAL STANDARD DEVIATION = ,E15.8) 3311 FORMAT(1H ,10X,30HRESIDUAL DEGREES OF FREEDOM = ,I8) 3312 FORMAT(1H ,10X,13HCOEFFICIENTS:) 3315 FORMAT(1H ,58H J B(J) SD(B(J)) B(J)/SD 1(B(J))) 3405 FORMAT(1H ,3X,I8,8E15.8) 101 FORMAT(1H ,28HLEAST SQUARES POLYNOMIAL FIT) 102 FORMAT(1H ,10X,16HSAMPLE SIZE N = ,I8) 103 FORMAT(1H ,10X,9HDEGREE = ,I8) 105 FORMAT(1H ,33H*****ERROR--THE SAMPLE SIZE N (= ,I8,40H) IS NON-POS 1ITIVE OR LARGER THAN NMAX = ,I8,6H *****) 110 FORMAT(1H ,52H*****ERROR--THE DESIRED NUMBER OF COEFFICIENTS K (= 1,I8,40H) IS NON-POSITIVE OR LARGER THAN KMAX = ,I8,6H *****) 115 FORMAT(1H ,52H*****ERROR--THE DESIRED NUMBER OF COEFFICIENTS K (= 1,I8,38H) IS LARGER THAN THE SAMPLE SIZE N (= ,I8,7H) *****) 851 FORMAT(1H ,10X,20HUNEQUAL WEIGHTS CASE) 852 FORMAT(1H ,10X,18HEQUAL WEIGHTS CASE) 4205 FORMAT(1H ,38HERROR IN POLY SUBROUTINE--NUMSET = 0) 4930 FORMAT(1H ,44H REPLICATION STANDARD DEVIATION = ,D15.7) 4935 FORMAT(1H ,44H REPLICATION DEGREES OF FREEDOM = ,I8) 4933 FORMAT(1H ,44H NUMBER OF DISTINCT SUBSETS = ,I8) 4936 FORMAT(1H ,51H LACK OF FIT F TEST CANNOT BE DONE BECAUSE) 4937 FORMAT(1H ,44H HAVE ONLY 0 DEGREES OF FREEDOM IN , , 121HNUMERATOR OF F RATIO.) 4938 FORMAT(1H ,49H THIS HAPPENS WHEN NUMBER OF PARAMETERS , 16HFITTED ) 4939 FORMAT(1H ,45H IS IDENTICAL TO NUMBER OF DISTINCT , 18HSUBSETS.) 4940 FORMAT(1H ,32H LACK OF FIT F RATIO = ,F10.4,7H = THE , 1F8.4,14H% POINT OF THE) 4945 FORMAT(1H ,30H F DISTRIBUTION WITH ,I6,5H AND ,I6, 119H DEGREES OF FREEDOM) C RETURN END SUBROUTINE PROPOR(X,N,XMIN,XMAX,IWRITE,XPROP) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT PROPOR C C PURPOSE--THIS SUBROUTINE COMPUTES THE C THE SAMPLE PROPORTION WHICH IS THE C PROPORTION OF DATA BETWEEN XMIN AND XMAX (INCLUSIVELY) C IN THE INPUT VECTOR X. C THE SAMPLE PROPORTION = (THE NUMBER OF OBSERVATIONS C IN THE SAMPLE BETWEEN XMIN AND XMAX, INCLUSIVELY) / N. C THE SAMPLE PROPORTION WILL BE A SINGLE PRECISION C VALUE BETWEEN 0.0 AND 1.0 (INCLUSIVELY). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --XMIN = THE SINGLE PRECISION VALUE C WHICH DEFINES THE LOWER LIMIT C (INCLUSIVELY) OF THE REGION C OF INTEREST. C --XMAX = THE SINGLE PRECISION VALUE C WHICH DEFINES THE UPPER LIMIT C (INCLUSIVELY) OF THE REGION C OF INTEREST. C --IWRITE = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL SUPPRESS C THE PRINTING OF THE C SAMPLE PROPORTION C AS IT IS COMPUTED; C OR (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0), C LIKE, SAY, 1) WILL CAUSE C THE PRINTING OF THE C SAMPLE PROPORTION C AT THE TIME IT IS COMPUTED. C OUTPUT ARGUMENTS--XPROP = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE PROPORTION. C THIS WILL BE A VALUE BETWEEN C 0.0 AND 1.0 (INCLUSIVELY). C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SAMPLE PROPORTION. C PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO C INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR C CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--SNEDECOR AND COCHRAN, STATISTICAL METHODS, C EDITION 6, 1967, PAGES 207-213. C --DIXON AND MASSEY, INTRODUCTION TO STATISTICAL C ANALYSIS, EDITION 2, 1957, PAGES 81-82, 228-231. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1974. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 IF(XMIN.EQ.XMAX)GOTO80 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD XPROP=0.0 RETURN 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XPROP=0.0 RETURN 80 WRITE(IPR,26) WRITE(IPR,49)XMIN XPROP=0.0 RETURN 90 CONTINUE 9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE PROPOR SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 PROPOR SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE PROPOR SUBROUTINE HAS THE VALUE 1 *****) 26 FORMAT(1H ,46H***** FATAL ERROR--THE THIRD AND FOURTH INPUT , 1 48HARGUMENTS TO THE PROPOR SUBROUTINE ARE IDENTICAL) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) 49 FORMAT(1H , 37H***** THE VALUE OF THE ARGUMENTS ARE ,E15.7 ,6H * 1****) C C-----START POINT----------------------------------------------------- C AN=N XPROP=0.0 ISUM=0 DO100I=1,N IF(X(I).LT.XMIN.OR.XMAX.LT.X(I))GOTO100 ISUM=ISUM+1 100 CONTINUE SUM=ISUM XPROP=SUM/AN C 101 IF(IWRITE.EQ.0)RETURN WRITE(IPR,999) WRITE(IPR,105)N,XMIN,XMAX,XPROP 105 FORMAT(1H ,22HTHE PROPORTION OF THE ,I6,30H OBSERVATIONS IN THE IN 1TERVAL ,E15.7,4H TO ,E15.7,4H IS ,E15.7) 999 FORMAT(1H ) RETURN END SUBROUTINE RANGE(X,N,IWRITE,XRANGE) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT RANGE C C PURPOSE--THIS SUBROUTINE COMPUTES THE C SAMPLE RANGE C OF THE DATA IN THE INPUT VECTOR X. C THE SAMPLE RANGE = SAMPLE MAX - SAMPLE MIN. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --IWRITE = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL SUPPRESS C THE PRINTING OF THE C SAMPLE RANGE C AS IT IS COMPUTED; C OR (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0), C LIKE, SAY, 1) WILL CAUSE C THE PRINTING OF THE C SAMPLE RANGE C AT THE TIME IT IS COMPUTED. C OUTPUT ARGUMENTS--XRANGE = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE RANGE. C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SAMPLE RANGE. C PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO C INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR C CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 1, EDITION 2, 1963, PAGE 338. C --DAVID, ORDER STATISTICS, 1970, PAGE 10-11. C --SNEDECOR AND COCHRAN, STATISTICAL METHODS, C EDITION 6, 1967, PAGE 39. C --DIXON AND MASSEY, INTRODUCTION TO STATISTICAL C ANALYSIS, EDITION 2, 1957, PAGE 21. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --JUNE 1974. C UPDATED --APRIL 1975. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS IF(N.LT.1)GOTO50 C IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD XRANGE=0.0 GOTO101 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XRAMGE=0.0 GOTO101 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE RANGE SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 RANGE SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE RANGE SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C XMIN=X(1) XMAX=X(1) DO100I=1,N IF(X(I).LT.XMIN)XMIN=X(I) IF(X(I).GT.XMAX)XMAX=X(I) 100 CONTINUE XRANGE=XMAX-XMIN C 101 IF(IWRITE.EQ.0)RETURN WRITE(IPR,999) WRITE(IPR,105)N,XRANGE 105 FORMAT(1H ,24HTHE SAMPLE RANGE OF THE ,I6,17H OBSERVATIONS IS ,E15 1.8) 999 FORMAT(1H ) RETURN END SUBROUTINE RANK(X,N,XR) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT RANK C C PURPOSE--THIS SUBROUTINE RANKS (IN ASCENDING ORDER) C THE N ELEMENTS OF THE SINGLE PRECISION VECTOR X, C AND PUTS THE RESULTING N RANKS INTO THE C SINGLE PRECISION VECTOR XR. C THIS SUBROUTINE GIVES THE DATA ANALYST C THE ABILITY TO (FOR EXAMPLE) RANK THE DATA C PRELIMINARY TO CERTAIN DISTRIBUTION-FREE C ANALYSES. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C OBSERVATIONS TO BE RANKED. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT ARGUMENTS--XR = THE SINGLE PRECISION VECTOR C INTO WHICH THE RANKS C FROM X WILL BE PLACED. C OUTPUT--THE SINGLE PRECISION VECTOR XR C CONTAINING THE RANKS C (IN ASCENDING ORDER) C OF THE VALUES C IN THE SINGLE PRECISION VECTOR X. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C OTHER DATAPAC SUBROUTINES NEEDED--SORT. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--THE RANK OF THE FIRST ELEMENT C OF THE VECTOR X C WILL BE PLACED IN THE FIRST POSITION C OF THE VECTOR XR, C THE RANK OF THE SECOND ELEMENT C OF THE VECTOR X C WILL BE PLACED IN THE SECOND POSITION C OF THE VECTOR XR, C ETC. C COMMENT--THE SMALLEST ELEMENT IN THE VECTOR X C WILL HAVE A RANK OF 1 (UNLESS TIES EXIST). C THE LARGEST ELEMENT IN THE VECTOR X C WILL HAVE A RANK OF N (UNLESS TIES EXIST). C COMMENT--ALTHOUGH RANKS ARE USUALLY (UNLESS TIES EXIST) C INTEGRAL VALUES FROM 1 TO N, IT IS TO BE C NOTED THAT THEY ARE OUTPUTED AS SINGLE C PRECISION INTEGERS IN THE SINGLE PRECISION C VECTOR XR. C XR IS SINGLE PRECISION SO AS TO BE C CONSISTENT WITH THE FACT THAT ALL C VECTOR ARGUMENTS IN ALL OTHER C DATAPAC SUBROUTINES ARE SINGLE PRECISION; C BUT MORE IMPORTANTLY, BECAUSE TIES FREQUENTLY C DO EXIST IN DATA SETS AND SO SOME OF THE C RESULTING RANKS WILL BE NON-INTEGRAL C AND SO THE OUTPUT VECTOR OF RANKS MUST NECESSARILY C BE SINGLE PRECISION AND NOT INTEGER. C COMMENT--THE INPUT VECTOR X REMAINS UNALTERED. C COMMENT--DUE TO CONFLICTING USE OF LABELED C COMMON /BLOCK2/ BY THIS RANK C SUBROUTINE AND THE SPCORR (SPEARMAN RANK C CORRELATION COEFFICIENT) SUBROUTINE, C THE VECTOR XS OF THIS RANK C SUBROUTINE HAS BEEN PLACED IN C LABELED COMMON /BLOCK4/ C COMMENT--THE FIRST AND THIRD ARGUMENTS IN THE C CALLING SEQUENCE MAY C BE IDENTICAL; THAT IS, AN 'IN PLACE' C RANKING IS PERMITTED. C THE CALLING SEQUENCE C CALL RANK(X,N,X) IS VALID, IF DESIRED. C COMMENT--THE SORTING ALGORTHM USED HEREIN C IS THE BINARY SORT. C THIS ALGORTHIM IS EXTREMELY FAST AS THE C FOLLOWING TIME TRIALS INDICATE. C THESE TIME TRIALS WERE CARRIED OUT ON THE C UNIVAC 1108 EXEC 8 SYSTEM AT NBS C IN AUGUST OF 1974. C BY WAY OF COMPARISON, THE TIME TRIAL VALUES C FOR THE EASY-TO-PROGRAM BUT EXTREMELY C INEFFICIENT BUBBLE SORT ALGORITHM HAVE C ALSO BEEN INCLUDED-- C NUMBER OF RANDOM BINARY SORT BUBBLE SORT C NUMBERS SORTED C N = 10 .002 SEC .002 SEC C N = 100 .011 SEC .045 SEC C N = 1000 .141 SEC 4.332 SEC C N = 3000 .476 SEC 37.683 SEC C N = 10000 1.887 SEC NOT COMPUTED C REFERENCES--CACM MARCH 1969, PAGE 186 (BINARY SORT ALGORITHM C BY RICHARD C. SINGLETON). C --CACM JANUARY 1970, PAGE 54. C --CACM OCTOBER 1970, PAGE 624. C --JACM JANUARY 1961, PAGE 41. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --JANUARY 1975. C UPDATED --NOVEMBER 1975. C UPDATED --JANUARY 1977. C C--------------------------------------------------------------------- C DIMENSION X(1),XR(1) COMMON /BLOCK4/ XS(7500) C AN=N IPR=6 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD AVRANK=(AN+1.0)/2.0 DO61I=1,N XR(I)=AVRANK 61 CONTINUE RETURN 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XR(1)=1.0 RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE RANK SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 RANK SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE RANK SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C C FIRST SORT THE DATA FROM THE INPUT VECTOR X C INTO THE INTERMEDIATE STORAGE VECTOR XS. C CALL SORT(X,N,XS) C C NOW DETERMINE THE RANKS. C THE BASIC ALGORITHM IS TO TAKE A GIVEN ELEMENT C IN THE ORIGINAL INPUT VECTOR X, C AND SCAN THE SORTED VALUES IN THE XS VECTOR C UNTIL A MATCH IS FOUND; C WHEN A MATCH IS FOUND, THEN THE RANK FOR THAT C VALUE IN THE XS VECTOR IS DETERMINED. C THAT RANK IS THEN WRITTEN INTO THAT POSITION C IN THE OUTPUT Y VECTOR WHICH CORRESPONDS TO THE POSITION OF THE C GIVEN ELEMENT OF INTEREST IN THE ORIGINAL X VECTOR. C THE CODE IS LENGTHENED FROM THIS BASIC ALGORITHM C BY A SECTION WHICH CUTS DOWN THE SEARCH IN THE XS VECTOR, C AND BY A SECTION WHICH OBVIATES (UNDER CERTAIN CIRCUMSTANCES) C THE NEED FOR RECALCULATING THE RANK OF AN ELEMENT IN XS. C NM1=N-1 XPREV=X(1) DO700I=1,N JMIN=1 IF(X(I).GT.XPREV)GOTO770 IF(I.EQ.1)GOTO790 IF(X(I).EQ.XPREV)GOTO750 GOTO790 750 CONTINUE XR(I)=RPREV GOTO880 770 CONTINUE JMIN=K IF(JMIN.LT.N)GOTO790 IF(JMIN.EQ.N)GOTO820 IBRAN=1 WRITE(IPR,109)IBRAN WRITE(IPR,101)JMIN 109 FORMAT(1H ,40H*****INTERNAL ERROR IN RANK SUBROUTINE--, 146HIMPOSSIBLE BRANCH CONDITION AT BRANCH POINT = ,I8) 101 FORMAT(1H ,'JMIN = ',I8) STOP 790 CONTINUE DO800J=JMIN,NM1 IF(X(I).NE.XS(J))GOTO800 JP1=J+1 DO900K=JP1,N IF(XS(K).NE.XS(J))GOTO950 900 CONTINUE K=N+1 950 CONTINUE AVRANK=J+K-1 AVRANK=AVRANK/2.0 XR(I)=AVRANK GOTO880 800 CONTINUE 820 CONTINUE J=N K=N+1 IF(X(I).EQ.XS(J))GOTO850 IBRAN=2 WRITE(IPR,109)IBRAN WRITE(IPR,102)X(I),XS(J) 102 FORMAT(1H ,'X(I) = ',F15.7,' XS(J) = ',F15.7) STOP 850 CONTINUE XR(I)=N 880 CONTINUE XPREV=X(I) RPREV=XR(I) 700 CONTINUE C RETURN END SUBROUTINE RANPER(N,ISTART,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT RANPER C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM PERMUTATION OF SIZE N C OF THE VALUES 1.0, 2.0, 3.0, ..., N-1, N. C INPUT ARGUMENTS--N = THE DESIRED INTEGER SIZE C OF THE RANDOM 1 TO N PERMUTATION. C --ISTART = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL START THE C GENERATOR OVER AND HENCE C PRODUCE THE SAME RANDOM PERMUTATION C OVER AND OVER AGAIN C UPON SUCCESSIVE CALLS TO C THIS SUBROUTINE WITHIN A RUN; OR C (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0, C LIKE, SAY, 1) WILL ALLOW C THE GENERATOR TO CONTINUE C FROM WHERE IT STOPPED C AND HENCE PRODUCE DIFFERENT C RANDOM PERMUTATIONS UPON C SUCCESSIVE CALLS TO C THIS SUBROUTINE WITHIN A RUN. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM PERMUTATION WILL BE PLACED. C OUTPUT--A RANDOM PERMUTATION OF SIZE N C OF THE VALUES 1.0, 2.0, 3.0, ..., N-1, N. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--ALGORITHM SUGGESTED BY DAN LOZIER, C NATIONAL BUREAU OF STANDARDS (205.01). C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --MAY 1974. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION U(1) C AN=N IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 GOTO90 50 WRITE(IPR, 5) WRITE(IPR,47)N RETURN 55 WRITE(IPR, 8) X(1)=1 RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 RANPER SUBROUTINE IS NON-POSITIVE *****) 8 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE RANPER SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C CALL UNIRAN(1,ISTART,U) C DO100I=1,N X(I)=I 100 CONTINUE C DO200I=1,N CALL UNIRAN(1,1,U) ADD=AN*U(1)+1.0 IADD=ADD IF(IADD.LT.1)IADD=1 IF(IADD.GT.N)IADD=N J=I+IADD IF(J.GT.N)J=J-N HOLD=X(J) X(J)=X(I) X(I)=HOLD 200 CONTINUE RETURN END SUBROUTINE READ(ICOL1,ICOL2,X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT READ C C PURPOSE--THIS SUBROUTINE PERFORMS A FORMAT-FREE READ C OF DATA FROM PUNCHED CARDS. C ONLY THE CARD COLUMNS BETWEEN ICOL1 AND ICOL2 C (INCLUSIVELY) ARE SCANNED FOR THE READ. C THIS SUBROUTINE GIVES THE DATA ANALYST THE ABILITY C TO GET DATA INTO THE MACHINE WITHOUT HAVING C TO WORRY ABOUT AND SPECIFY FORMATS. C THE DATA CARDS MAY BE PUNCHED UP C WITHOUT REGARD TO ANY PARTICULAR FORMAT C AND MAY BE ENTERED INTO THE MACHINE C WITHOUT DEFINING ANY FORMATS. C INPUT ARGUMENTS--ICOL1 = THE INTEGER CARD COLUMN NUMBER C WHICH DEFINES THE LOWER BOUND C (INCLUSIVELY) OF THE INTERVAL C ON EACH CARD TO BE SCANNED C FOR THE READ. C --ICOL2 = THE INTEGER CARD COLUMN NUMBER C WHICH DEFINES THE UPPER BOUND C (INCLUSIVELY) OF THE INTERVAL C ON EACH CARD TO BE SCANNED C FOR THE READ. C OUTPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR C INTO WHICH THE READ DATA VALUES C WILL BE SEQUENTIALLY PLACED. C --N = THE INTEGER VALUE C WHICH WILL EQUAL THE NUMBER OF DATA C VALUES WHICH WERE READ. C OUTPUT--THE SINGLE PRECISION VECTOR X WHICH C WILL CONTAIN THE READ C DATA VALUES, AND C THE INTEGER VALUE N WHICH WILL C EQUAL THE NUMBER OF DATA VALUES C READ INTO X. C ALSO, 7 LINES OF SUMMARY INFORMATION C WILL BE GENERATED-- C REGARDING WHAT WAS IN FACT READ INTO THE MACHINE-- C 1) THE VALUES OF ICOL1 AND ICOL2; C 2) THE (ENTIRE) FIRST DATA CARD READ; C 3) THE (ENTIRE) LAST DATA CARD READ; C 4) THE TOTAL NUMBER OF DATA CARDS READ; C 5) THE TOTAL NUMBER OF DATA VALUES READ. C PRINTING--YES. C RESTRICTIONS--ICOL1 AND ICOL2 MUST BE BETWEEN 1 AND 80, C INCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--ADJACENT DATA VALUES ON THE SAME CARD C MUST BE SEPARATED BY AT LEAST 1 BLANK C OR 1 ALPHABETIC CHARACTER, OR BY ANY C COMBINATION OF BLANKS AND ALPHABETIC C CHARACTERS. IN THIS CONTEXT, AN C ALPHABETIC CHARACTER IS ANY CHARACTER C OTHER THAN 0, 1, 2, ..., 9, +, -, OR .. C IN EFFECT, THEREFORE, ALL ALPHABETIC INFORMATION C IN THE INTERVAL DEFINED BY ICOL1 AND ICOL2 C (INCLUSIVELY) IS IGNORED FOR READING PURPOSES. C ALL INFORMATION (BOTH NUMERIC AND ALPHABETIC) C OUTSIDE THE DEFINED INTERVAL IS ALSO IGNORED C FOR READING PURPOSES. C COMMENT--THE DATA VALUES ON THE CARDS ARE FREE-FORMAT. C THEY MAY BE EITHER INTEGER OR FLOATING POINT C (THAT IS, WITHOUT OR WITH THE DECIMAL POINTS). C EXPONENTIAL FLOATING POINT FORMAT (E FORMAT) C IS NOT PERMITTED. C ALL DATA, WHETHER WITHOUT OR WITH THE DECIMAL POINT C ON THE CARDS, WILL BE READ INTO THE MACHINE C INTO THE X VECTOR AND WILL RESIDE THERE AS FLOATING C POINT NUMBERS. C COMMENT--ANY PARTICULAR DATA VALUE MUST START AND END C ON THE SAME DATA CARD; DATA VALUES MAY NOT C START ON ONE CARD AND FINISH ON THE NEXT. C VARIOUS ILLEGAL COMBINATIONS (SUCH AS C MULTIPLE DECIMAL POINTS, MULTIPLE PLUSSES OR C MINUSES, INCOMPLETE VALUES CONSISTING ONLY C OF A DECIMAL POINT, OR ONLY OF A SIGN AND A DECIMAL C POINT, ETC. ARE NOT ACCEPTED AND THE C DATA ANALYST WILL BE INFORMED OF THE EXISTENCE OF C SUCH BY AN ERROR DIAGNOSTIC. C IN THE EVENT OF SUCH AN ILLEGAL COMBINATION, C THAT 'NUMBER' AND ALL REMAINING NUMBERS ON THAT CARD WILL C WILL BE IGNORED (NOT READ INTO THE MACHINE) C AND THE NEXT DATA CARD WILL THEN C BE READ. C COMMENT--THIS SUBROUTINE WILL CONTINUOUSLY AND C SEQUENTIALLY READ CARDS UNTIL A CARD WITH C THE WORD END (SOMEWHERE BETWEEN C COLUMNS ICOL1 AND ICOL2 (INCLUSIVELY) C IS ENCOUNTERED. C TO TERMINATE A DATA SET, THE ANALYST SHOULD C APPEND SUCH A CARD WHICH HAS THE WORD C END SOMEWHERE IN THE INTERVAL C DEFINED BY ICOL1 AND ICOL2. C FOR EXAMPLE, IF ICOL1 = 1 AND ICOL2 = 20, C THEN A SEPARATE CARD WITH END C IN COLUMNS 1, 2, AND 3, OR C IN COLUMNS 10, 11, AND 12, ETC. C WOULD TERMINATE THE READ. C IT IS IMPORTANT TO APPEND SUCH A CARD-- C FAILURE TO DO SO WILL RESULT IN AN INCOMPLETE C DATA SET OR (ON SOME COMPUTERS) AN C UNPREDICTABLE RUN TERMINATION. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--DECEMBER 1972. C UPDATED --AUGUST 1974. C UPDATED --NOVEMBER 1975. C UPDATED --OCTOBER 1976. C C--------------------------------------------------------------------- C CHARACTER*4 PLUS,MINUS,POINT,BLANK CHARACTER*4 ALPHAE,ALPHAN,ALPHAD CHARACTER*4 IC CHARACTER*4 IA CHARACTER*4 ICHAR CHARACTER*4 ISTOR1 CHARACTER*4 ISTOR2 C DIMENSION X(1) DIMENSION IA(80),ICHAR(41),IC(10) DIMENSION ISTOR1(80),ISTOR2(80) C DATA PLUS,MINUS,POINT,BLANK /'+','-','.',' '/ DATA ALPHAE,ALPHAN,ALPHAD /'E','N','D'/ DATA IC(1),IC(2),IC(3),IC(4),IC(5),IC(6),IC(7),IC(8),IC(9),IC(10) 1/'0','1','2','3','4','5','6','7','8','9'/ C N=0 IRD=5 IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C MINCOL=ICOL1 MAXCOL=ICOL2 IF(ICOL2.LT.ICOL1)MINCOL=ICOL2 IF(ICOL2.LT.ICOL1)MAXCOL=ICOL1 IF(MINCOL.LT.1.OR.MAXCOL.GT.80)GOTO51 GOTO90 51 WRITE(IPR,41) WRITE(IPR,42) WRITE(IPR,43)ICOL1,ICOL2 RETURN 90 CONTINUE 41 FORMAT(1H ,103H***** FATAL ERROR--THE FIRST OR SECOND (OR BOTH) IN 1PUT ARGUMENT TO THE READ SUBROUTINE IS OUTSIDE THE) 42 FORMAT(1H , 37H ALLOWABLE (1,80) INTERVAL *****) 43 FORMAT(1H , 41H***** THE VALUE OF THE FIRST ARGUMENT IS ,I7, 42H 1AND THE VALUE OF THE SECOND ARGUMENT IS ,I7,6H *****) C C-----START POINT----------------------------------------------------- C IBUG=0 C NUMCRD=0 120 CONTINUE READ(IRD,2031,END=1950)(IA(I),I=1,80) IF(IBUG.EQ.1)WRITE(6,1111)(IA(I),I=1,80) 1111 FORMAT(1H ,80A1) DO101J=1,78 JP1=J+1 JP2=J+2 IF(IA(J).EQ.ALPHAE.AND.IA(JP1).EQ.ALPHAN. 1AND.IA(JP2).EQ.ALPHAD)GOTO1950 101 CONTINUE 102 NUMCRD=NUMCRD+1 IF(NUMCRD.EQ.1)GOTO103 DO104J=1,80 ISTOR2(J)=IA(J) 104 CONTINUE GOTO105 103 DO106J=1,80 ISTOR1(J)=IA(J) ISTOR2(J)=IA(J) 106 CONTINUE 105 I=MINCOL C 150 DO100J=1,41 ICHAR(J)=BLANK 100 CONTINUE NC=0 NDP=0 160 DO200J=1,10 IF(IA(I).EQ.IC(J))GOTO250 200 CONTINUE IF(IA(I).EQ.PLUS)GOTO350 IF(IA(I).EQ.MINUS)GOTO450 IF(IA(I).EQ.POINT)GOTO550 IF(NC.EQ.0)GOTO650 IF(NC.EQ.1)GOTO750 IF(NC.EQ.2)GOTO850 IEND=0 GOTO1050 C 250 IF(NC.EQ.0)GOTO260 GOTO270 260 NC=1 ICHAR(NC)=PLUS 270 NC=NC+1 ICHAR(NC)=IA(I) I=I+1 IF(I.LE.MAXCOL)GOTO160 IEND=1 GOTO1050 C 350 IF(NC.EQ.0)GOTO360 WRITE(IPR,999) WRITE(IPR,2001) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 360 NC=1 ICHAR(NC)=IA(I) I=I+1 IF(I.LE.MAXCOL)GOTO160 WRITE(IPR,999) WRITE(IPR,2002) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 C 450 IF(NC.EQ.0)GOTO460 WRITE(IPR,999) WRITE(IPR,2003) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 460 NC=1 ICHAR(NC)=IA(I) I=I+1 IF(I.LE.MAXCOL)GOTO160 WRITE(IPR,999) WRITE(IPR,2004) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 C 550 IF(NC.EQ.0)GOTO560 IF(NC.EQ.1)GOTO570 IF(NDP.EQ.0)GOTO580 WRITE(IPR,999) WRITE(IPR,2005) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 580 NC=NC+1 ICHAR(NC)=IA(I) NDP=NDP+1 I=I+1 IF(I.LE.MAXCOL)GOTO160 IEND=1 GOTO1050 570 NC=2 ICHAR(NC)=IA(I) NDP=NDP+1 I=I+1 IF(I.LE.MAXCOL)GOTO160 WRITE(IPR,999) WRITE(IPR,2006) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 560 NC=1 ICHAR(NC)=PLUS NC=2 ICHAR(NC)=IA(I) NDP=NDP+1 I=I+1 IF(I.LE.MAXCOL)GOTO160 WRITE(IPR,999) WRITE(IPR,2007) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 C 650 I=I+1 IF(I.LE.MAXCOL)GOTO160 GOTO120 C 750 WRITE(IPR,999) WRITE(IPR,2008) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 C 850 IF(ICHAR(1).EQ.PLUS.AND.ICHAR(2).EQ.POINT)GOTO860 IF(ICHAR(1).EQ.MINUS.AND.ICHAR(2).EQ.POINT)GOTO870 IEND=0 GOTO1050 860 WRITE(IPR,999) WRITE(IPR,2009) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 870 WRITE(IPR,999) WRITE(IPR,2010) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 C C C 1050 DO1100J=2,NC IF(ICHAR(J).EQ.POINT)GOTO1150 1100 CONTINUE J=NC+1 NCP1=NC+1 ICHAR(NCP1)=POINT NC=NCP1 C 1150 LOCPT=J NUMINT=J-2 NUMDEC=NC-J SUM=0.0 IF(NUMINT.EQ.0)GOTO1450 ISTART=2 ISTOP=NUMINT+1 IPOWER=-1 DO1200J=ISTART,ISTOP JREV=ISTOP-J+2 DO1300K=1,10 IF(ICHAR(JREV).EQ.IC(K))GOTO1350 1300 CONTINUE WRITE(IPR,999) WRITE(IPR,2024) WRITE(IPR,2025)(ICHAR(L),L=1,41) WRITE(IPR,2023)(IA(L),L=1,80) WRITE(IPR,2022)NUMCRD WRITE(IPR,999) RETURN C 1350 Y=K-1 IPOWER=IPOWER+1 SUM=SUM+Y*(10.0**IPOWER) 1200 CONTINUE C 1450 IF(NUMDEC.EQ.0)GOTO1750 ISTART=LOCPT+1 ISTOP=NC IPOWER=0 DO1500J=ISTART,ISTOP DO1600K=1,10 IF(ICHAR(J).EQ.IC(K))GOTO1650 1600 CONTINUE WRITE(IPR,999) WRITE(IPR,2026) WRITE(IPR,2025)(ICHAR(L),L=1,41) WRITE(IPR,2023)(IA(L),L=1,80) WRITE(IPR,2022)NUMCRD WRITE(IPR,999) RETURN C 1650 Y=K-1 IPOWER=IPOWER+1 SUM=SUM+Y/(10.0**IPOWER) 1500 CONTINUE C 1750 IF(ICHAR(1).EQ.MINUS)SUM=-SUM N=N+1 X(N)=SUM IF(IEND.EQ.1)GOTO120 I=I+1 IF(I.LE.MAXCOL)GOTO150 GOTO120 1950 WRITE(IPR,999) IF(NUMCRD.EQ.0)GOTO1960 WRITE(IPR,2300) WRITE(IPR,2301)IRD WRITE(IPR,2302)MINCOL,MAXCOL WRITE(IPR,2303)(ISTOR1(J),J=1,80) WRITE(IPR,2304)(ISTOR2(J),J=1,80) 1960 WRITE(IPR,2305)NUMCRD WRITE(IPR,2306)N WRITE(IPR,999) WRITE(IPR,999) RETURN C 999 FORMAT(1H ) 2001 FORMAT(1H ,103H***** PUNCHED INPUT ERROR--A PLUS HAS OCCURRED IN T 1HE MIDDLE OF SOME DATA VALUE ON THE CARD BELOW *****) 2002 FORMAT(1H , 94H***** PUNCHED INPUT ERROR--THE LAST DATA VALUE ON T 1HE CARD BELOW CONSISTS OF ONLY A PLUS *****) 2003 FORMAT(1H ,104H***** PUNCHED INPUT ERROR--A MINUS HAS OCCURRED IN 1THE MIDDLE OF SOME DATA VALUE ON THE CARD BELOW *****) 2004 FORMAT(1H , 95H***** PUNCHED INPUT ERROR--THE LAST DATA VALUE ON T 1HE CARD BELOW CONSISTS OF ONLY A MINUS *****) 2005 FORMAT(1H , 94H***** PUNCHED INPUT ERROR--SOME DATA VALUE ON THE C 1ARD BELOW HAS MULTIPLE DECIMAL POINTS *****) 2006 FORMAT(1H ,125H***** PUNCHED INPUT ERROR--THE LAST DATA VALUE ON T 1HE CARD BELOW CONSISTS OF ONLY A +. OR OF ONLY A -. 1 *****) 2007 FORMAT(1H ,103H***** PUNCHED INPUT ERROR--THE LAST DATA VALUE ON T 1HE CARD BELOW CONSISTS OF ONLY A DECIMAL POINT *****) 2008 FORMAT(1H ,109H***** PUNCHED INPUT ERROR--SOME DATA VALUE ON THE C 1ARD BELOW CONSISTS OF ONLY A PLUS OR OF ONLY A MINUS *****) 2009 FORMAT(1H , 97H***** PUNCHED INPUT ERROR--SOME DATA VALUE ON THE C 1ARD BELOW CONSISTS OF ONLY A +. *****) 2010 FORMAT(1H , 97H***** PUNCHED INPUT ERROR--SOME DATA VALUE ON THE C 1ARD BELOW CONSISTS OF ONLY A -. *****) 2021 FORMAT(1H , 98H THIS ILLEGAL DATA VALUE AND ALL SUBSEQUENT DA 1TA VALUES ON THIS CARD (ONLY) HAVE BEEN DELETED) 2022 FORMAT(1H , 24H THIS CARD WAS THE ,I7,27H-TH DATA CARD THAT W 1AS READ) 2023 FORMAT(1H , 33H THE CARD IS AS FOLLOWS-- ,80A1) 2024 FORMAT(1H ,121H***** PROGRAMMING ERROR IN THE READ SUBROUTINE-- 1A NON-NUMERIC CHARACTER WAS ENCOUNTERED IN CONVERTING THE INTEGER 1PART) 2025 FORMAT(1H , 38H OF THE FOLLOWING DATA VALUE-- ,41A1) 2026 FORMAT(1H ,121H***** PROGRAMMING ERROR IN THE READ SUBROUTINE-- 1A NON-NUMERIC CHARACTER WAS ENCOUNTERED IN CONVERTING THE DECIMAL 1PART) 2031 FORMAT(80A1) 2300 FORMAT(1H , 35HOUTPUT FROM THE READ SUBROUTINE--) 2301 FORMAT(1H , 31HTHE INPUT UNIT DEVICE NUMBER = ,I7) 2302 FORMAT(1H , 53HTHE SCANNING INTERVAL FOR EACH DATA CARD WAS COLUMN 1 ,I3, 17H THROUGH COLUMN ,I3, 12H (INCLUSIVE)) 2303 FORMAT(1H , 41HTHE (ENTIRE) FIRST DATA CARD READ WAS ,80A1) 2304 FORMAT(1H , 41HTHE (ENTIRE) LAST DATA CARD READ WAS ,80A1) 2305 FORMAT(1H , 47HTHE TOTAL NUMBER OF DATA CARDS READ WAS ,I7) 2306 FORMAT(1H , 47HTHE TOTAL NUMBER (= N) OF DATA VALUES READ WAS ,I7) END SUBROUTINE READG(IRD,ICOL1,ICOL2,X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT READG C C PURPOSE--THIS SUBROUTINE PERFORMS A FORMAT-FREE READ C OF DATA FROM INPUT UNIT = IRD. C ONLY THE CARD COLUMNS BETWEEN ICOL1 AND ICOL2 C (INCLUSIVELY) ARE SCANNED FOR THE READ. C THIS SUBROUTINE IS IDENTICAL TO THE READ SUBROUTINE C EXCEPT THAT THE READ SUBROUTINE ASSUMES INPUT UNIT 5, C WHEREAS THIS READG SUBROUTINE ALLOWS THE ANALYST C TO SPECIFY THE INPUT UNIT. C THIS SUBROUTINE GIVES THE DATA ANALYST THE ABILITY C TO GET DATA INTO THE MACHINE C FROM A VARIETY OF INPUT SOURCES C (CARD, TAPE, DISC, ETC.) C WITHOUT HAVING C TO WORRY ABOUT AND SPECIFY FORMATS. C THE DATA CARD IMAGES MAY BE MADE C WITHOUT REGARD TO ANY PARTICULAR FORMAT C AND MAY BE ENTERED INTO THE MACHINE C WITHOUT DEFINING ANY FORMATS. C INPUT ARGUMENTS--IRD = THE INTEGER VALUE SPECIFYING C THE INPUT UNIT FROM WHICH C THE CARD IMAGES WILL COME. C --ICOL1 = THE INTEGER CARD COLUMN NUMBER C WHICH DEFINES THE LOWER BOUND C (INCLUSIVELY) OF THE INTERVAL C ON EACH CARD IMAGE TO BE SCANNED C FOR THE READ. C --ICOL2 = THE INTEGER CARD COLUMN NUMBER C WHICH DEFINES THE UPPER BOUND C (INCLUSIVELY) OF THE INTERVAL C ON EACH CARD IMAGE TO BE SCANNED C FOR THE READ. C OUTPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR C INTO WHICH THE READ DATA VALUES C WILL BE SEQUENTIALLY PLACED. C --N = THE INTEGER VALUE C WHICH WILL EQUAL THE NUMBER OF DATA C VALUES WHICH WERE READ. C OUTPUT--THE SINGLE PRECISION VECTOR X WHICH C WILL CONTAIN THE READ C DATA VALUES, AND C THE INTEGER VALUE N WHICH WILL C EQUAL THE NUMBER OF DATA VALUES C READ INTO X. C ALSO, 7 LINES OF SUMMARY INFORMATION C WILL BE GENERATED-- C REGARDING WHAT WAS IN FACT READ INTO THE MACHINE-- C 1) THE VALUES OF ICOL1 AND ICOL2; C 2) THE (ENTIRE) FIRST DATA CARD READ; C 3) THE (ENTIRE) LAST DATA CARD READ; C 4) THE TOTAL NUMBER OF DATA CARDS READ; C 5) THE TOTAL NUMBER OF DATA VALUES READ. C PRINTING--YES. C RESTRICTIONS--ICOL1 AND ICOL2 MUST BE BETWEEN 1 AND 80, C INCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--ADJACENT DATA VALUES ON THE SAME CARD C MUST BE SEPARATED BY AT LEAST 1 BLANK C OR 1 ALPHABETIC CHARACTER, OR BY ANY C COMBINATION OF BLANKS AND ALPHABETIC C CHARACTERS. IN THIS CONTEXT, AN C ALPHABETIC CHARACTER IS ANY CHARACTER C OTHER THAN 0, 1, 2, ..., 9, +, -, OR .. C IN EFFECT, THEREFORE, ALL ALPHABETIC INFORMATION C IN THE INTERVAL DEFINED BY ICOL1 AND ICOL2 C (INCLUSIVELY) IS IGNORED FOR READING PURPOSES. C ALL INFORMATION (BOTH NUMERIC AND ALPHABETIC) C OUTSIDE THE DEFINED INTERVAL IS ALSO IGNORED C FOR READING PURPOSES. C COMMENT--THE DATA VALUES ON THE CARDS ARE FREE-FORMAT. C THEY MAY BE EITHER INTEGER OR FLOATING POINT C (THAT IS, WITHOUT OR WITH THE DECIMAL POINTS). C EXPONENTIAL FLOATING POINT FORMAT (E FORMAT) C IS NOT PERMITTED. C ALL DATA, WHETHER WITHOUT OR WITH THE DECIMAL POINT C ON THE CARDS, WILL BE READ INTO THE MACHINE C INTO THE X VECTOR AND WILL RESIDE THERE AS FLOATING C POINT NUMBERS. C COMMENT--ANY PARTICULAR DATA VALUE MUST START AND END C ON THE SAME DATA CARD; DATA VALUES MAY NOT C START ON ONE CARD AND FINISH ON THE NEXT. C VARIOUS ILLEGAL COMBINATIONS (SUCH AS C MULTIPLE DECIMAL POINTS, MULTIPLE PLUSSES OR C MINUSES, INCOMPLETE VALUES CONSISTING ONLY C OF A DECIMAL POINT, OR ONLY OF A SIGN AND A DECIMAL C POINT, ETC. ARE NOT ACCEPTED AND THE C DATA ANALYST WILL BE INFORMED OF THE EXISTENCE OF C SUCH BY AN ERROR DIAGNOSTIC. C IN THE EVENT OF SUCH AN ILLEGAL COMBINATION, C THAT 'NUMBER' AND ALL REMAINING NUMBERS ON THAT CARD WILL C WILL BE IGNORED (NOT READ INTO THE MACHINE) C AND THE NEXT DATA CARD WILL THEN C BE READ. C COMMENT--THIS SUBROUTINE WILL CONTINUOUSLY AND C SEQUENTIALLY READ CARDS UNTIL A CARD WITH C THE WORD END (SOMEWHERE BETWEEN C COLUMNS ICOL1 AND ICOL2 (INCLUSIVELY) C IS ENCOUNTERED. C TO TERMINATE A DATA SET, THE ANALYST SHOULD C APPEND SUCH A CARD WHICH HAS THE WORD C END SOMEWHERE IN THE INTERVAL C DEFINED BY ICOL1 AND ICOL2. C FOR EXAMPLE, IF ICOL1 = 1 AND ICOL2 = 20, C THEN A SEPARATE CARD WITH END C IN COLUMNS 1, 2, AND 3, OR C IN COLUMNS 10, 11, AND 12, ETC. C WOULD TERMINATE THE READ. C IT IS IMPORTANT TO APPEND SUCH A CARD-- C FAILURE TO DO SO WILL RESULT IN AN INCOMPLETE C DATA SET OR (ON SOME COMPUTERS) AN C UNPREDICTABLE RUN TERMINATION. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--DECEMBER 1972. C UPDATED --AUGUST 1974. C UPDATED --NOVEMBER 1975. C UPDATED --OCTOBER 1976. C C--------------------------------------------------------------------- C CHARACTER*4 PLUS,MINUS,POINT,BLANK CHARACTER*4 ALPHAE,ALPHAN,ALPHAD CHARACTER*4 IC CHARACTER*4 IA CHARACTER*4 ICHAR CHARACTER*4 ISTOR1 CHARACTER*4 ISTOR2 C DIMENSION X(1) DIMENSION IA(80),ICHAR(41),IC(10) DIMENSION ISTOR1(80),ISTOR2(80) C DATA PLUS,MINUS,POINT,BLANK /'+','-','.',' '/ DATA ALPHAE,ALPHAN,ALPHAD /'E','N','D'/ DATA IC(1),IC(2),IC(3),IC(4),IC(5),IC(6),IC(7),IC(8),IC(9),IC(10) 1/'0','1','2','3','4','5','6','7','8','9'/ C N=0 IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C MINCOL=ICOL1 MAXCOL=ICOL2 IF(ICOL2.LT.ICOL1)MINCOL=ICOL2 IF(ICOL2.LT.ICOL1)MAXCOL=ICOL1 IF(MINCOL.LT.1.OR.MAXCOL.GT.80)GOTO51 GOTO90 51 WRITE(IPR,41) WRITE(IPR,42) WRITE(IPR,43)ICOL1,ICOL2 RETURN 90 CONTINUE 41 FORMAT(1H ,103H***** FATAL ERROR--THE FIRST OR SECOND (OR BOTH) IN 1PUT ARGUMENT TO THE READG SUBROUTINE IS OUTSIDE THE) 42 FORMAT(1H , 37H ALLOWABLE (1,80) INTERVAL *****) 43 FORMAT(1H , 41H***** THE VALUE OF THE FIRST ARGUMENT IS ,I7, 42H 1AND THE VALUE OF THE SECOND ARGUMENT IS ,I7,6H *****) C C-----START POINT----------------------------------------------------- C C NUMCRD=0 120 READ(IRD,2031,END=1950)(IA(I),I=1,80) DO101J=1,78 IF(IA(J).NE.ALPHAE)GOTO101 JP1=J+1 IF(IA(JP1).NE.ALPHAN)GOTO101 JP2=J+2 IF(IA(JP2).NE.ALPHAD)GOTO101 GOTO1950 101 CONTINUE 102 NUMCRD=NUMCRD+1 IF(NUMCRD.EQ.1)GOTO103 DO104J=1,80 ISTOR2(J)=IA(J) 104 CONTINUE GOTO105 103 DO106J=1,80 ISTOR1(J)=IA(J) ISTOR2(J)=IA(J) 106 CONTINUE 105 I=MINCOL C 150 DO100J=1,41 ICHAR(J)=BLANK 100 CONTINUE NC=0 NDP=0 160 DO200J=1,10 IF(IA(I).EQ.IC(J))GOTO250 200 CONTINUE IF(IA(I).EQ.PLUS)GOTO350 IF(IA(I).EQ.MINUS)GOTO450 IF(IA(I).EQ.POINT)GOTO550 IF(NC.EQ.0)GOTO650 IF(NC.EQ.1)GOTO750 IF(NC.EQ.2)GOTO850 IEND=0 GOTO1050 C 250 IF(NC.EQ.0)GOTO260 GOTO270 260 NC=1 ICHAR(NC)=PLUS 270 NC=NC+1 ICHAR(NC)=IA(I) I=I+1 IF(I.LE.MAXCOL)GOTO160 IEND=1 GOTO1050 C 350 IF(NC.EQ.0)GOTO360 WRITE(IPR,999) WRITE(IPR,2001) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 360 NC=1 ICHAR(NC)=IA(I) I=I+1 IF(I.LE.MAXCOL)GOTO160 WRITE(IPR,999) WRITE(IPR,2002) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 C 450 IF(NC.EQ.0)GOTO460 WRITE(IPR,999) WRITE(IPR,2003) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 460 NC=1 ICHAR(NC)=IA(I) I=I+1 IF(I.LE.MAXCOL)GOTO160 WRITE(IPR,999) WRITE(IPR,2004) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 C 550 IF(NC.EQ.0)GOTO560 IF(NC.EQ.1)GOTO570 IF(NDP.EQ.0)GOTO580 WRITE(IPR,999) WRITE(IPR,2005) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 580 NC=NC+1 ICHAR(NC)=IA(I) NDP=NDP+1 I=I+1 IF(I.LE.MAXCOL)GOTO160 IEND=1 GOTO1050 570 NC=2 ICHAR(NC)=IA(I) NDP=NDP+1 I=I+1 IF(I.LE.MAXCOL)GOTO160 WRITE(IPR,999) WRITE(IPR,2006) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 560 NC=1 ICHAR(NC)=PLUS NC=2 ICHAR(NC)=IA(I) NDP=NDP+1 I=I+1 IF(I.LE.MAXCOL)GOTO160 WRITE(IPR,999) WRITE(IPR,2007) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 C 650 I=I+1 IF(I.LE.MAXCOL)GOTO160 GOTO120 C 750 WRITE(IPR,999) WRITE(IPR,2008) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 C 850 IF(ICHAR(1).EQ.PLUS.AND.ICHAR(2).EQ.POINT)GOTO860 IF(ICHAR(1).EQ.MINUS.AND.ICHAR(2).EQ.POINT)GOTO870 IEND=0 GOTO1050 860 WRITE(IPR,999) WRITE(IPR,2009) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 870 WRITE(IPR,999) WRITE(IPR,2010) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 C C C 1050 DO1100J=2,NC IF(ICHAR(J).EQ.POINT)GOTO1150 1100 CONTINUE J=NC+1 NCP1=NC+1 ICHAR(NCP1)=POINT NC=NCP1 C 1150 LOCPT=J NUMINT=J-2 NUMDEC=NC-J SUM=0.0 IF(NUMINT.EQ.0)GOTO1450 ISTART=2 ISTOP=NUMINT+1 IPOWER=-1 DO1200J=ISTART,ISTOP JREV=ISTOP-J+2 DO1300K=1,10 IF(ICHAR(JREV).EQ.IC(K))GOTO1350 1300 CONTINUE WRITE(IPR,999) WRITE(IPR,2024) WRITE(IPR,2025)(ICHAR(L),L=1,41) WRITE(IPR,2023)(IA(L),L=1,80) WRITE(IPR,2022)NUMCRD WRITE(IPR,999) RETURN C 1350 Y=K-1 IPOWER=IPOWER+1 SUM=SUM+Y*(10.0**IPOWER) 1200 CONTINUE C 1450 IF(NUMDEC.EQ.0)GOTO1750 ISTART=LOCPT+1 ISTOP=NC IPOWER=0 DO1500J=ISTART,ISTOP DO1600K=1,10 IF(ICHAR(J).EQ.IC(K))GOTO1650 1600 CONTINUE WRITE(IPR,999) WRITE(IPR,2026) WRITE(IPR,2025)(ICHAR(L),L=1,41) WRITE(IPR,2023)(IA(L),L=1,80) WRITE(IPR,2022)NUMCRD WRITE(IPR,999) RETURN C 1650 Y=K-1 IPOWER=IPOWER+1 SUM=SUM+Y/(10.0**IPOWER) 1500 CONTINUE C 1750 IF(ICHAR(1).EQ.MINUS)SUM=-SUM N=N+1 X(N)=SUM IF(IEND.EQ.1)GOTO120 I=I+1 IF(I.LE.MAXCOL)GOTO150 GOTO120 1950 WRITE(IPR,999) IF(NUMCRD.EQ.0)GOTO1960 WRITE(IPR,2300) WRITE(IPR,2301)IRD WRITE(IPR,2302)MINCOL,MAXCOL WRITE(IPR,2303)(ISTOR1(J),J=1,80) WRITE(IPR,2304)(ISTOR2(J),J=1,80) 1960 WRITE(IPR,2305)NUMCRD WRITE(IPR,2306)N WRITE(IPR,999) WRITE(IPR,999) RETURN C 999 FORMAT(1H ) 2001 FORMAT(1H ,103H***** INPUT DATA ERROR--A PLUS HAS OCCURRED IN T 1HE MIDDLE OF SOME DATA VALUE ON THE CARD BELOW *****) 2002 FORMAT(1H , 94H***** INPUT DATA ERROR--THE LAST DATA VALUE ON T 1HE CARD BELOW CONSISTS OF ONLY A PLUS *****) 2003 FORMAT(1H ,104H***** INPUT DATA ERROR--A MINUS HAS OCCURRED IN 1THE MIDDLE OF SOME DATA VALUE ON THE CARD BELOW *****) 2004 FORMAT(1H , 95H***** INPUT DATA ERROR--THE LAST DATA VALUE ON T 1HE CARD BELOW CONSISTS OF ONLY A MINUS *****) 2005 FORMAT(1H , 94H***** INPUT DATA ERROR--SOME DATA VALUE ON THE C 1ARD BELOW HAS MULTIPLE DECIMAL POINTS *****) 2006 FORMAT(1H ,125H***** INPUT DATA ERROR--THE LAST DATA VALUE ON T 1HE CARD BELOW CONSISTS OF ONLY A +. OR OF ONLY A -. 1 *****) 2007 FORMAT(1H ,103H***** INPUT DATA ERROR--THE LAST DATA VALUE ON T 1HE CARD BELOW CONSISTS OF ONLY A DECIMAL POINT *****) 2008 FORMAT(1H ,109H***** INPUT DATA ERROR--SOME DATA VALUE ON THE C 1ARD BELOW CONSISTS OF ONLY A PLUS OR OF ONLY A MINUS *****) 2009 FORMAT(1H , 97H***** INPUT DATA ERROR--SOME DATA VALUE ON THE C 1ARD BELOW CONSISTS OF ONLY A +. *****) 2010 FORMAT(1H , 97H***** INPUT DATA ERROR--SOME DATA VALUE ON THE C 1ARD BELOW CONSISTS OF ONLY A -. *****) 2021 FORMAT(1H ,104H THIS ILLEGAL DATA VALUE AND ALL SUBSEQUENT DA 1TA VALUES ON THIS CARD IMAGE (ONLY) HAVE BEEN DELETED) 2022 FORMAT(1H , 30H THIS CARD IMAGE WAS THE ,I7,33H-TH DATA CARD 1IMAGE THAT WAS READ) 2023 FORMAT(1H , 39H THE CARD IMAGE IS AS FOLLOWS-- ,80A1) 2024 FORMAT(1H ,121H***** PROGRAMMING ERROR IN THE READG SUBROUTINE-- 1A NON-NUMERIC CHARACTER WAS ENCOUNTERED IN CONVERTING THE INTEGER 1PART) 2025 FORMAT(1H , 38H OF THE FOLLOWING DATA VALUE-- ,41A1) 2026 FORMAT(1H ,121H***** PROGRAMMING ERROR IN THE READG SUBROUTINE-- 1A NON-NUMERIC CHARACTER WAS ENCOUNTERED IN CONVERTING THE DECIMAL 1PART) 2031 FORMAT(80A1) 2300 FORMAT(1H , 35HOUTPUT FROM THE READG SUBROUTINE--) 2301 FORMAT(1H , 31HTHE INPUT UNIT DEVICE NUMBER = ,I7) 2302 FORMAT(1H , 59HTHE SCANNING INTERVAL FOR EACH DATA CARD IMAGE WAS 1COLUMN ,I3, 17H THROUGH COLUMN ,I3, 12H (INCLUSIVE)) 2303 FORMAT(1H , 47HTHE (ENTIRE) FIRST DATA CARD IMAGE READ WAS , 180A1) 2304 FORMAT(1H , 47HTHE (ENTIRE) LAST DATA CARD IMAGE READ WAS , 180A1) 2305 FORMAT(1H , 47HTHE TOTAL NUMBER OF DATA CARD IMAGES READ WAS , ) 1I7) 2306 FORMAT(1H , 47HTHE TOTAL NUMBER (= N) OF DATA VALUES READ WAS ,I7) C END SUBROUTINE RELSD(X,N,IWRITE,XRELSD) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT RELSD C C PURPOSE--THIS SUBROUTINE COMPUTES THE C SAMPLE RELATIVE STANDARD DEVIATION C OF THE DATA IN THE INPUT VECTOR X. C THE SAMPLE RELATIVE STANDARD DEVIATION = (THE SAMPLE C STANDARD DEVIATION)/(THE SAMPLE MEAN). C THE DENOMINATOR N-1 IS USED IN COMPUTING THE C SAMPLE STANDARD DEVIATION. C THE SAMPLE RELATIVE STANDARD DEVIATION IS ALTERNATIVELY C REFERRED TO AS THE SAMPLE COEFFICIENT OF VARIATION. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --IWRITE = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL SUPPRESS C THE PRINTING OF THE C SAMPLE RELATIVE STANDARD DEVIATION C AS IT IS COMPUTED; C OR (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0), C LIKE, SAY, 1) WILL CAUSE C THE PRINTING OF THE C SAMPLE RELATIVE STANDARD DEVIATION C AT THE TIME IT IS COMPUTED. C OUTPUT ARGUMENTS--XRELSD = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE RELATIVE C STANDARD DEVIATION. C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SAMPLE RELATIVE STANDARD DEVIATION. C PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO C INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR C CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 47, 233. C --SNEDECOR AND COCHRAN, STATISTICAL METHODS, C EDITION 6, 1967, PAGES 62-65. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --MARCH 1975. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C AN=N IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD XRELSD=0.0 GOTO201 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XRELSD=0.0 GOTO201 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE RELSD SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 RELSD SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE RELSD SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C SUM=0.0 DO100I=1,N SUM=SUM+X(I) 100 CONTINUE XMEAN=SUM/AN SUM=0.0 DO200I=1,N SUM=SUM+(X(I)-XMEAN)**2 200 CONTINUE VAR=SUM/(AN-1.0) SD=SQRT(VAR) XRELSD=100.0*SD/XMEAN C 201 IF(IWRITE.EQ.0)RETURN WRITE(IPR,999) WRITE(IPR,205)N,XRELSD 205 FORMAT(' THE RELATIVE STANDARD DEVIATION (= STANDARD ', 1'DEVIATION/MEAN) FOR THE ',I6,' OBSERVATIONS IS ', 1E12.8,' PERCENT') 999 FORMAT(1H ) RETURN END SUBROUTINE REPLAC(X,N,XMIN,XMAX,XNEW) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT REPLAC C C PURPOSE--THIS SUBROUTINE REPLACES (WITH THE VALUE XNEW) C ALL OBSERVATIONS IN THE C SINGLE PRECISION VECTOR X WHICH ARE INSIDE C THE CLOSED (INCLUSIVE) INTERVAL C DEFINED BY XMIN AND XMAX. C ALL OBSERVATIONS OUTSIDE OF C THIS INTERVAL ARE LEFT UNCHANGED. C THUS ALL OBSERVATIONS IN X WHICH ARE C EQUAL TO OR LARGER THAN XMIN AND C EQUAL TO OR SMALLER THAN XMAX, C WILL BE REPLACED BY XNEW. C THIS SUBROUTINE (AND THE C RETAIN AND DELETE SUBROUTINES) C GIVES THE DATA ANALYST THE ABILITY TO C EASILY 'CLEAN UP' A DATA SET WHICH HAS C MISSING AND/OR OUTLYING OBSERVATIONS C SO THAT A MORE APPROPRIATE SUBSEQUENT C DATA ANALYSIS MAY BE PERFORMED. C FOR EXAMPLE, REPLACEMENT OF AN OUTLIER WITH C A MORE APPROPRIATE VALUE CAN EASILY C BE DONE BY THIS SUBROUTINE. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --XMIN = THE SINGLE PRECISION VALUE C WHICH DEFINES THE LOWER LIMIT C (INCLUSIVELY) OF THE PARTICULAR C INTERVAL OF INTEREST FOR REPLACEMENT. C --XMAX = THE SINGLE PRECISION VALUE C WHICH DEFINES THE UPPER LIMIT C (INCLUSIVELY) OF THE PARTICULAR C INTERVAL OF INTEREST FOR REPLACEMENT. C --XNEW = THE SINGLE PRECISION VALUE C WITH WHICH ALL OF THE C OBSERVATIONS IN THE INTERVAL C OF INTEREST C WILL BE REPLACED. C OUTPUT--THE SINGLE PRECISION VECTOR X C IN WHICH ONLY THOSE VALUES INSIDE C (INCLUSIVELY) THE INTERVAL OF INTEREST C HAVE BEEN REPLACED BY XNEW. C ALSO, 6 LINES OF SUMMARY INFORMATION C WILL BE GENERATED INDICATING C 1) WHAT THE INTERVAL OF INTEREST WAS; C 2) WHAT THE REPLACEMENT VALUE WAS; C 3) HOW MANY OBSERVATIONS WERE REPLACED; C 4) WHAT THE SAMPLE SIZE WAS (N); C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--THIS SUBROUTINE MAY BE USEFULLY EMPLOYED C IN CONJUNCTION WITH THE DATAPAC C PLOTTING SUBROUTINES INASMUCH C AS THE LATTER HAVE BEEN C SET UP WITH THE CONVENTION C THAT ALL VALUES IN THE VERTICAL AXIS C VECTOR OR HORIZONTAL AXIS VECTOR C WHICH ARE EQUAL TO OR IN EXCESS OF 10.0**10 C WILL BE AUTOMATICALLY IGNORED C IN THE PLOT (THAT IS, NOT PLOTTED). C THIS CONVENTION GREATLY SIMPLIFIES THE PROBLEM C OF PLOTTING WHEN SOME ELEMENTS IN THE VERTICAL C OR HORIZONTAL AXIS VECTORS C ARE 'MISSING DATA', OR WHEN WE PURPOSELY C WANT TO IGNORE CERTAIN ELEMENTS IN THESE VECTORS C FOR PLOTTING PURPOSES (THAT IS, WE DO NOT C WANT CERTAIN ELEMENTS TO BE PLOTTED). C TO CAUSE SPECIFIC ELEMENTS IN THE VERTICAL C OR HORIZONTAL AXIS VECTORS TO BE C IGNORED, WE REPLACE THE ELEMENTS BEFOREHAND C (BY USE OF THE REPLAC SUBROUTINE) C BY SOME LARGE VALUE (LIKE, SAY, 10.0**10) AND C THEY WILL SUBSEQUENTLY BE IGNORED IN THE PLOTTING C SUBROUTINES. C COMMENT--THIS IS ONE OF THE FEW SUBRUTINES IN DATAPAC C IN WHICH THE INPUT VECTOR X IS ALTERED. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--NOVEMBER 1972. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) 90 CONTINUE 9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE REPLAC SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 REPLAC SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE REPLAC SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C POINTL=XMIN POINTU=XMAX IF(XMIN.GT.XMAX)POINTL=XMAX IF(XMIN.GT.XMAX)POINTU=XMIN C K=0 DO100I=1,N IF(X(I).LT.POINTL.OR.X(I).GT.POINTU)GOTO100 K=K+1 X(I)=XNEW 100 CONTINUE NDEL=N-K C C WRITE OUT A BRIEF SUMMARY C WRITE(IPR,999) WRITE(IPR,101) WRITE(IPR,105)POINTL,POINTU WRITE(IPR,106) WRITE(IPR,107) WRITE(IPR,108) WRITE(IPR,109)XNEW WRITE(IPR,110)N WRITE(IPR,115)K WRITE(IPR,120)NDEL 101 FORMAT(1H ,35HOUTPUT FROM THE REPLAC SUBROUTINE--) 105 FORMAT(1H ,7X,26HONLY OBSERVATIONS BETWEEN ,E15.8,5H AND ,E15.8) 106 FORMAT(1H ,7X,31H(INCLUSIVE) HAVE BEEN REPLACED.) 107 FORMAT(1H ,7X,41HALL OBSERVATIONS OUTSIDE OF THIS INTERVAL) 108 FORMAT(1H ,7X,25HHAVE BEEN LEFT UNCHANGED.) 109 FORMAT(1H ,7X,25HTHE REPLACEMENT VALUE IS ,E15.8) 110 FORMAT(1H ,7X,40HTHE INPUT NUMBER OF OBSERVATIONS IS ,I6) 115 FORMAT(1H ,7X,40HTHE NUMBER OF OBSERVATIONS REPLACED IS ,I6) 120 FORMAT(1H ,7X,40HTHE NUMBER OF OBSERVATIONS UNCHANGED IS ,I6) 999 FORMAT(1H ) C RETURN END SUBROUTINE RETAIN(X,N,XMIN,XMAX,NEWN) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT RETAIN C C PURPOSE--THIS SUBROUTINE RETAINS ALL OBSERVATIONS IN THE C SINGLE PRECISION VECTOR X WHICH ARE INSIDE C THE CLOSED (INCLUSIVE) INTERVAL C DEFINED BY XMIN AND XMAX, C WHILE DELETING ALL OBSERVATIONS OUTSIDE OF C THIS INTERVAL. C THUS ALL OBSERVATIONS IN X WHICH ARE SMALLER C THAN XMIN OR LARGER THAN XMAX ARE DELETED FROM X. C THIS SUBROUTINE (AND THE C REPLAC AND DELETE SUBROUTINES) C GIVES THE DATA ANALYST THE ABILITY TO C EASILY 'CLEAN UP' A DATA SET WHICH HAS C MISSING AND/OR OUTLYING OBSERVATIONS C SO THAT A MORE APPROPRIATE SUBSEQUENT C DATA ANALYSIS MAY BE PERFORMED. C FOR EXAMPLE, A TRIMMED SAMPLE CAN EASILY C BE CONSTRUCTED BY USE OF THIS SUBROUTINE. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --XMIN = THE SINGLE PRECISION VALUE C WHICH DEFINES THE LOWER LIMIT C (INCLUSIVELY) OF THE PARTICULAR C INTERVAL OF INTEREST TO BE RETAINED. C --XMAX = THE SINGLE PRECISION VALUE C WHICH DEFINES THE UPPER LIMIT C (INCLUSIVELY) OF THE PARTICULAR C INTERVAL OF INTEREST TO BE RETAINED. C OUTPUT ARGUMENTS--NEWN = THE INTEGER NUMBER OF OBSERVATIONS C REMAINING (RETAINED) IN X AFTER ALL C OF THE OBSERVATIONS OUTSIDE THE C INTERVAL OF INTEREST HAVE BEEN C DELETED. C OUTPUT--THE SINGLE PRECISION VECTOR X C IN WHICH ONLY THOSE VALUES INSIDE C (INCLUSIVELY) THE INTERVAL OF INTEREST C HAVE BEEN RETAINED, AND C THE INTEGER VALUE NEWN C WHICH GIVES THE NUMBER OF C OBSERVATIONS RETAINED IN X. C ALSO, 6 LINES OF SUMMARY INFORMATION C WILL BE GENERATED INDICATING C 1) WHAT THE INTERVAL OF INTEREST WAS; C 2) HOW MANY OBSERVATIONS WERE DELETED; C 3) WHAT THE OLD (ORIGINAL) SAMPLE SIZE WAS (N); C 4) WHAT THE NEW SAMPLE SIZE IS (NEWN). C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--IN THE END, AFTER THIS SUBROUTINE HAS C MADE WHATEVER DELETIONS ARE APPROPRIATE, C THE OUTPUT VECTOR X WILL BE 'PACKED'; C THAT IS, NO 'HOLES' WILL EXIST IN THE C VECTOR X--ALL OF THE RETAINED ELEMENTS C OF X WILL BE PACKED INTO THE FIRST AVAILABLE C LOCATIONS IN X, WHILE THE REMAINDER C OF THE N LOCATIONS IN X WILL BE ZERO-FILLED. C COMMENT--IN THE MAIN (CALLING) ROUTINE, IT IS C PERMISSABLE (IF THE ANALYST SO DESIRES) C TO USE THE SAME VARIABLE NAME C IN THE FIFTH ARGUMENT AS USED IN THE SECOND C ARGUMENT IN THE CALLING SEQUENCE TO THIS C RETAIN SUBROUTINE--NO CONFLICT WILL RESULT C IN THE INTERNAL OPERATION OF THE RETAIN C SUBROUTINE. FOR EXAMPLE, IT IS PERMISSIBLE C TO HAVE CALL RETAIN(X,N,-10.0,10.0,N) C IN WHICH THE VARIABLE NAME N IS USED C AS BOTH THE SECOND AND FIFTH ARGUMENTS. C COMMENT--THIS IS ONE OF THE FEW SUBROUTINES IN DATAPAC C IN WHICH THE INPUT VECTOR X IS ALTERED. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--NOVEMBER 1972. C UPDATED --JULY 1974. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) 90 CONTINUE 9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE RETAIN SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 RETAIN SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE RETAIN SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C POINTL=XMIN POINTU=XMAX IF(XMIN.GT.XMAX)POINTL=XMAX IF(XMIN.GT.XMAX)POINTU=XMIN C NOLD=N K=0 DO100I=1,NOLD IF(X(I).LT.POINTL.OR.X(I).GT.POINTU)GOTO100 K=K+1 X(K)=X(I) 100 CONTINUE NEWN=K NDEL=NOLD-NEWN C NEWNP1=NEWN+1 IF(NEWNP1.GT.NOLD)GOTO250 DO200I=NEWNP1,NOLD X(I)=0.0 200 CONTINUE 250 CONTINUE C C WRITE OUT A BRIEF SUMMARY C WRITE(IPR,999) WRITE(IPR,101) WRITE(IPR,105)POINTL,POINTU WRITE(IPR,106) WRITE(IPR,107) WRITE(IPR,108) WRITE(IPR,110)NOLD WRITE(IPR,115)NEWN WRITE(IPR,120)NDEL 101 FORMAT(1H ,35HOUTPUT FROM THE RETAIN SUBROUTINE--) 105 FORMAT(1H ,7X,26HONLY OBSERVATIONS BETWEEN ,E15.8,5H AND ,E15.8) 106 FORMAT(1H ,7X,31H(INCLUSIVE) HAVE BEEN RETAINED.) 107 FORMAT(1H ,7X,41HALL OBSERVATIONS OUTSIDE OF THIS INTERVAL) 108 FORMAT(1H ,7X,18HHAVE BEEN DELETED.) 110 FORMAT(1H ,7X,44HTHE INPUT NUMBER OF OBSERVATIONS (IN X) IS ,I6) 115 FORMAT(1H ,7X,44HTHE OUTPUT NUMBER OF OBSERVATIONS (IN X) IS ,I6) 120 FORMAT(1H ,7X,44HTHE NUMBER OF OBSERVATIONS DELETED IS ,I6) 999 FORMAT(1H ) C RETURN END SUBROUTINE RUNS(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT RUNS C C PURPOSE--THIS SUBROUTINE PERFORMS A RUNS ANALYSIS C OF THE DATA IN THE INPUT VECTOR X. C THE ANALYSIS CONSISTS OF FIRST DETERMINING C THE OBSERVED NUMBER OF RUNS FROM THE DATA, C AND THEN COMPUTING C THE EXPECTED NUMBER OF RUNS, C THE STANDARD DEVIATION OF THE NUMBER OF RUNS, C AND THE RESULTING STANDARDIZED STATISTIC C FOR THE NUMBER OF RUNS FOR RUNS OF VARIOUS C LENGTHS. C THIS IS DONE FOR RUNS UP, RUNS DOWN, AND C RUNS UP AND DOWN. C THIS RUNS ANSLYSIS IS A USEFUL DISTRIBUTION-FREE C TEST OF THE RANDOMNESS OF A DATA SET. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--4 PAGES OF AUTOMATIC PRINTOUT C CONSISTING OF THE OBSERVED NUMBER, C EXPECTED NUMBER, STANDARD DEVIATION C AND RESULTING STANDARDIZED STATISTIC C FOR RUNS OF VARIOUS LENGTHS. C AND THE CUMULATIVE FREQUENCY. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 15000. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--LEVENE AND WOLFOWITZ, ANNALS OF MATHEMATICAL C STATISTICS, 1944, PAGES 58-69; C ESPECIALLY PAGES 60, 63, AND 64. C REFERENCES--BRADLEY, DISTRIBUTION-FREE STATISTICAL TESTS, C 1968, CHAPTER 12, PAGES 271-282. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(15000) DIMENSION NRUL(16), NRDL(16), NRTL(16), NRULG(16), NRDLG(16) DIMENSION NRTLG(16) DIMENSION ENRUL(16),ENRTL(16),ENRULG(16),ENRTLG(16) DIMENSION SNRUL(16),SNRTL(16),SNRULG(16),SNRTLG(16) DIMENSION ZNRUL(16),ZNRDL(16),ZNRTL(16),ZNRULG(16),ZNRDLG(16) DIMENSION ZNRTLG(16) DIMENSION C1(15),C2(15),C3(15),C4(15) DIMENSION ANRUL(16),ANRDL(16),ANRTL(16) DIMENSION ANRULG(16),ANRDLG(16),ANRTLG(16) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)) C DATA C1(1),C1(2),C1(3),C1(4),C1(5),C1(6),C1(7),C1(8),C1(9),C1(10), 1C1(11),C1(12),C1(13),C1(14),C1(15) 1/ .4236111111E+00, .1126675485E+00, .4191688713E-01, 1 .1076912487E-01, .2003959238E-02, .3023235799E-03, 1 .3911555473E-04, .4459038843E-05, .4551105210E-06, 1 .4207466837E-07, .3555930927E-08, .2768273257E-09, 1 .1997821524E-10, .1343876568E-11, .8465610177E-13/ DATA C2(1),C2(2),C2(3),C2(4),C2(5),C2(6),C2(7),C2(8),C2(9),C2(10), 1C2(11),C2(12),C2(13),C2(14),C2(15) 1/-.4819444444E+00, -.1628284832E+00, -.9690696649E-01, 1 -.3778106786E-01, -.9289228716E-02, -.1724429252E-02, 1 -.2638557888E-03, -.3466965096E-04, -.4004129153E-05, 1 -.4130382587E-06, -.3851876069E-07, -.3279103786E-08, 1 -.2568491117E-09, -.1863433868E-10, -.1259220466E-11/ DATA C3(1),C3(2),C3(3),C3(4),C3(5),C3(6),C3(7),C3(8),C3(9),C3(10), 1C3(11),C3(12),C3(13),C3(14),C3(15) 1/ .1777777778E+00, .7916666667E-01, .4738977072E-01, 1 .1274801587E-01, .2338606059E-02, .3461358734E-03, 1 .4407121770E-04, .4960020603E-05, .5010387575E-06, 1 .4592883352E-07, .3854170274E-08, .2982393839E-09, 1 .2141205844E-10, .1433843200E-11, .8996663214E-13/ DATA C4(1),C4(2),C4(3),C4(4),C4(5),C4(6),C4(7),C4(8),C4(9),C4(10), 1C4(11),C4(12),C4(13),C4(14),C4(15) 1/-.3222222222E+00, -.5972222222E-01, -.1130268959E+00, 1 -.4696428571E-01, -.1123273065E-01, -.2025170849E-02, 1 -.3029410411E-03, -.3912824548E-04, -.4459234519E-05, 1 -.4551128785E-06, -.4207469124E-07, -.3555931110E-08, 1 -.2768273269E-09, -.1997821525E-10, -.1343876568E-11/ C IPR=6 IUPPER=15000 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE RUNS SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 RUNS SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** FATAL ERROR-- THE SECOND INPUT ARGUME 1NT TO THE RUNS SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C FORM THE SEQUENTIAL DIFFERENCE TABLE C NM1=N-1 DO100I=1,NM1 IP1=I+1 Y(I)=X(IP1)-X(I) 100 CONTINUE C C ZERO-OUT THE 6 'NUMBER OF RUNS' VECTORS C DO200I=1,16 NRUL(I)=0 NRDL(I)=0 NRTL(I)=0 NRULG(I)=0 NRDLG(I)=0 NRTLG(I)=0 200 CONTINUE C C DETERMINE THE NUMBER OF RUNS UP OF LENGTH EXACTLY I C AND THE NUMBER OF RUNS DOWN OF LENGTH EXACTLY I C DETERMINE THE LENGTH OF THE LONGEST RUN UP C AND THE LENGTH OF THE LONGEST RUN DOWN C LENUP=0 LENDN=0 MAXLNU=0 MAXLND=0 DO300I=1,NM1 IF(Y(I).EQ.0.0.AND.LENUP.GE.1)LENUP=LENUP+1 IF(Y(I).EQ.0.0.AND.LENDN.GE.1)LENDN=LENDN+1 IF(Y(I).EQ.0.0.AND.LENUP.EQ.0.AND.LENDN.EQ.0)LENUP=LENUP+1 IF(Y(I).GT.0.0.AND.LENDN.GE.1.AND.LENDN.LE.15)NRDL(LENDN)=NRDL(LEN 1DN)+1 IF(Y(I).GT.0.0.AND.LENDN.GE.1.AND.LENDN.GE.16)NRDL(16)=NRDL(16)+1 IF(Y(I).GT.0.0)LENDN=0 IF(Y(I).GT.0.0)LENUP=LENUP+1 IF(Y(I).LT.0.0.AND.LENUP.GE.1.AND.LENUP.LE.15)NRUL(LENUP)=NRUL(LEN 1UP)+1 IF(Y(I).LT.0.0.AND.LENUP.GE.1.AND.LENUP.GE.16)NRUL(16)=NRUL(16)+1 IF(Y(I).LT.0.0)LENUP=0 IF(Y(I).LT.0.0)LENDN=LENDN+1 IF(I.EQ.NM1. AND.LENDN.GE.1.AND.LENDN.LE.15)NRDL(LENDN)=NRDL(LEN 1DN)+1 IF(I.EQ.NM1. AND.LENDN.GE.1.AND.LENDN.GE.16)NRDL(16)=NRDL(16)+1 IF(I.EQ.NM1. AND.LENUP.GE.1.AND.LENUP.LE.15)NRUL(LENUP)=NRUL(LEN 1UP)+1 IF(I.EQ.NM1. AND.LENUP.GE.1.AND.LENUP.GE.16)NRUL(16)=NRUL(16)+1 IF(LENUP.GT.MAXLNU)MAXLNU=LENUP IF(LENDN.GT.MAXLND)MAXLND=LENDN 300 CONTINUE C C DETERMINE THE NUMBER OF RUNS TOTAL OF LENGTH EXACTLY I C AND THE LENGTH OF THE LONGEST RUN UP OR DOWN C DO400I=1,16 NRTL(I)=NRUL(I)+NRDL(I) 400 CONTINUE MAXLNT=MAXLNU IF(MAXLND.GT.MAXLNU)MAXLNT=MAXLND C C DETERMINE THE NUMBER OF RUNS UP OF LENGTH I OR MORE C AND THE NUMBER OF RUNS DOWN OF LENGTH I OR MORE C AND THE NUMBER OF RUNS TOTAL OF LENGTH I OR MORE C NRULG(16)=NRUL(16) NRDLG(16)=NRDL(16) NRTLG(16)=NRTL(16) DO500I=1,15 J=16-I JP1=J+1 NRULG(J)=NRULG(JP1)+NRUL(J) NRDLG(J)=NRDLG(JP1)+NRDL(J) NRTLG(J)=NRTLG(JP1)+NRTL(J) 500 CONTINUE C C DETERMINE THE NUMBER OF POSITIVE, ZERO, AND NEGATIVE ENTRIES C IN THE DIFFERENCE TABLE. IF RANDOM, THE NUMBER OF POSITIVE SHOULD BE C APPROXIMATELY EQUAL TO THE NUMBER OF NEGATIVE C NNEG=0 NZER=0 NPOS=0 DO800I=1,NM1 IF(Y(I).LT.0.0)NNEG=NNEG+1 IF(Y(I).EQ.0.0)NZER=NZER+1 IF(Y(I).GT.0.0)NPOS=NPOS+1 800 CONTINUE C C COMPUTE THE EXPECTED NUMBER OF RUNS UP OF LENGTH EXACTLY I = C THE EXPECTED NUMBER OF RUNS DOWN OF LENGTH EXACTLY I = C ONE HALF THE EXPECTED NUMBER OF RUNS TOTAL OF LENGTH EXACTLY I C DEN=6.0 DO2000I=1,15 AI=I ENRUL(I)=AN*(AI*AI+3.0*AI+1.0)-(AI*AI*AI+3.0*AI*AI-AI-4.0) DEN=DEN*(AI+3.0) ENRUL(I)=ENRUL(I)/DEN ENRTL(I)=2.0*ENRUL(I) 2000 CONTINUE C C COMPUTE THE EXPECTED NUMBER OF RUNS UP OF LENGTH I OR MORE = C THE EXPECTED NUMBER OF RUNS DOWN OF LENGTH I OR MORE = C ONE HALF THE EXPECTED NUMBER OF RUNS TOTAL OF LENGTH I OR MORE C DEN=2.0 DO2100I=1,15 AI=I ENRULG(I)=AN*(AI+1.0)-(AI*AI+AI-1.0) DEN=DEN*(AI+2.0) ENRULG(I)=ENRULG(I)/DEN ENRTLG(I)=2.0*ENRULG(I) 2100 CONTINUE C C COMPUTE THE STANDARD DEV. OF THE NUMBER OF RUNS UP OF LENGTH EXACTLY I = C THE STANDARD DEV. OF THE NUMBER OF RUNS DOWN OF LENGTH EXACTLY I = C SQRT(0.5)* THE STAND. DEV. OF THE NUMBER OF RUNS TOTAL OF LENGTH EXACTLY I C DO2500I=1,15 SNRTL(I)=SQRT(C1(I)*AN+C2(I)) SNRUL(I)=SQRT(0.5)*SNRTL(I) 2500 CONTINUE C C COMPUTE THE STAND. DEV. OF THE NUMBER OF RUNS UP OF LENGTH I OR MORE = C THE STAND. DEV. OF THE NUMBER OF RUNS DOWN OF LENGTH I OR MORE = C SQRT(0.5)* THE STAND. DEV. OF THE NUMBER OF RUNS TOTAL OF LENGTH I OR MORE C DO2600I=1,15 SNRTLG(I)=SQRT(C3(I)*AN+C4(I)) SNRULG(I)=SQRT(0.5)*SNRTLG(I) 2600 CONTINUE C C FORM Z STATISTICS C DO3100I=1,15 STAT=NRUL(I) ZNRUL(I)=(STAT -ENRUL(I))/SNRUL(I) STAT=NRDL(I) ZNRDL(I)=(STAT -ENRUL(I))/SNRUL(I) STAT=NRTL(I) ZNRTL(I)=(STAT -ENRTL(I))/SNRTL(I) STAT=NRULG(I) ZNRULG(I)=(STAT -ENRULG(I))/SNRULG(I) STAT=NRDLG(I) ZNRDLG(I)=(STAT -ENRULG(I))/SNRULG(I) STAT=NRTLG(I) ZNRTLG(I)=(STAT -ENRTLG(I))/SNRTLG(I) 3100 CONTINUE C DO3200I=1,15 ANRUL(I)=NRUL(I) ANRDL(I)=NRDL(I) ANRTL(I)=NRTL(I) ANRULG(I)=NRULG(I) ANRDLG(I)=NRDLG(I) ANRTLG(I)=NRTLG(I) 3200 CONTINUE C C WRITE EVERYTHING OUT C IMAX=15 WRITE(IPR,998) WRITE(IPR,4002) WRITE(6,999) WRITE(6,999) WRITE(6,999) WRITE(6,999) WRITE(6,999) WRITE(IPR,4004) WRITE(6,999) WRITE(6,999) WRITE(IPR,4006) WRITE(IPR,999) DO4050I=1,IMAX WRITE(IPR,4060)I,ANRUL(I),ENRUL(I),SNRUL(I),ZNRUL(I) 4050 CONTINUE WRITE(6,999) WRITE(6,999) WRITE(6,999) WRITE(6,999) WRITE(6,999) WRITE(IPR,4064) WRITE(6,999) WRITE(6,999) WRITE(IPR,4006) WRITE(IPR,999) DO4070I=1,IMAX WRITE(IPR,4060)I,ANRULG(I),ENRULG(I),SNRULG(I),ZNRULG(I) 4070 CONTINUE WRITE(IPR,998) WRITE(IPR,4102) WRITE(6,999) WRITE(6,999) WRITE(6,999) WRITE(6,999) WRITE(6,999) WRITE(IPR,4104) WRITE(6,999) WRITE(6,999) WRITE(IPR,4006) WRITE(IPR,999) DO4150I=1,IMAX WRITE(IPR,4060)I,ANRDL(I),ENRUL(I),SNRUL(I),ZNRDL(I) 4150 CONTINUE WRITE(6,999) WRITE(6,999) WRITE(6,999) WRITE(6,999) WRITE(6,999) WRITE(IPR,4164) WRITE(6,999) WRITE(6,999) WRITE(IPR,4006) WRITE(IPR,999) DO4170I=1,IMAX WRITE(IPR,4060)I,ANRDLG(I),ENRULG(I),SNRULG(I),ZNRDLG(I) 4170 CONTINUE WRITE(IPR,998) WRITE(IPR,4202) WRITE(6,999) WRITE(6,999) WRITE(6,999) WRITE(6,999) WRITE(6,999) WRITE(IPR,4204) WRITE(6,999) WRITE(6,999) WRITE(IPR,4006) WRITE(IPR,999) DO4250I=1,IMAX WRITE(IPR,4060)I,ANRTL(I),ENRTL(I),SNRTL(I),ZNRTL(I) 4250 CONTINUE WRITE(6,999) WRITE(6,999) WRITE(6,999) WRITE(6,999) WRITE(6,999) WRITE(IPR,4264) WRITE(6,999) WRITE(6,999) WRITE(IPR,4006) WRITE(IPR,999) DO4270I=1,IMAX WRITE(IPR,4060)I,ANRTLG(I),ENRTLG(I),SNRTLG(I),ZNRTLG(I) 4270 CONTINUE WRITE(IPR,998) WRITE(IPR,4601)MAXLNU WRITE(IPR,4602)MAXLND WRITE(IPR,4603)MAXLNT WRITE(IPR,999) WRITE(IPR,4611)NPOS WRITE(IPR,4612)NNEG WRITE(IPR,4613)NZER 4002 FORMAT(1H ,48X,7HRUNS UP) 4102 FORMAT(1H ,48X,9HRUNS DOWN) 4202 FORMAT(1H ,40X,32HRUNS TOTAL = RUNS UP + RUNS DOWN) 4004 FORMAT(1H ,27X,52HSTATISTIC = NUMBER OF RUNS UP OF LENGTH EXACT 1LY I) 4104 FORMAT(1H ,27X,52HSTATISTIC = NUMBER OF RUNS DOWN OF LENGTH EXACT 1LY I) 4204 FORMAT(1H ,27X,52HSTATISTIC = NUMBER OF RUNS TOTAL OF LENGTH EXACT 1LY I) 4064 FORMAT(1H ,27X,52HSTATISTIC = NUMBER OF RUNS UP OF LENGTH I OR 1MORE) 4164 FORMAT(1H ,27X,52HSTATISTIC = NUMBER OF RUNS DOWN OF LENGTH I OR 1MORE) 4264 FORMAT(1H ,27X,52HSTATISTIC = NUMBER OF RUNS TOTAL OF LENGTH I OR 1MORE) 4006 FORMAT(1H ,105HI = LENGTH OF RUN VALUE OF STAT EXP( 1STAT) SD(STAT) (STAT-EXP(STAT))/SD(STAT)) 4060 FORMAT(1H ,4X,I4,13X,6X,F7.1,13X,F8.4,12X,F8.4,11X,F8.2) 4601 FORMAT(1H ,39HLENGTH OF THE LONGEST RUN UP = ,I5) 4602 FORMAT(1H ,39HLENGTH OF THE LONGEST RUN DOWN = ,I5) 4603 FORMAT(1H ,39HLENGTH OF THE LONGEST RUN UP OR DOWN = ,I5) 4611 FORMAT(1H ,33HNUMBER OF POSITIVE DIFFERENCES = ,I5) 4612 FORMAT(1H ,33HNUMBER OF NEGATIVE DIFFERENCES = ,I5) 4613 FORMAT(1H ,33HNUMBER OF ZERO DIFFERENCES = ,I5) 4010 FORMAT(1H ,2(I4,2X,F7.1,2X,F8.4,2X,F8.4,2X,F8.2,8X)) 4605 FORMAT(1H ,I6,2X,I6,2X,I6) 998 FORMAT(1H1) 999 FORMAT(1H ) RETURN END SUBROUTINE SAMPP(X,N,P,IWRITE,PP) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT SAMPP C C PURPOSE--THIS SUBROUTINE COMPUTES THE C SAMPLE 100P PERCENT POINT C (WHERE P IS BETWEEN 0.0 AND 1.0, EXCLUSIVELY) C OF THE DATA IN THE INPUT VECTOR X. C THE SAMPLE 100P PERCENT POINT = IS THAT POINT IN WHICH C 100P PERCENT OF THE DATA IN THE SAMPLE IS BELOW. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --P = THE SINGLE PRECISION FRACTION VALUE C (BETWEEN 0.0 AND 1.0, EXCLUSIVELY) C WHICH DEFINES THE DESIRED PERCENT C POINT TO BE COMPUTED. C --IWRITE = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL SUPPRESS C THE PRINTING OF THE C SAMPLE 100P PERCENT POINT C AS IT IS COMPUTED; C OR (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0), C LIKE, SAY, 1) WILL CAUSE C THE PRINTING OF THE C SAMPLE 100P PERCENT POINT C AT THE TIME IT IS COMPUTED. C OUTPUT ARGUMENTS--PP = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE 100P PERCENT POINT. C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SAMPLE 100P PERCENT POINT. C PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO C INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR C CONDITION EXISTS. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 15000. C --THE INPUT ARGUMENTS N AND P SHOULD BE SUCH THAT C THE PRODUCT OF N+1 AND P IS NOT SMALLER THAN 1 NOR C LARGER THAN N. THIS RESTRICTION IS DUE TO THE C INTRINSIC DIFFICULTY OF ESTIMATING C SAMPLE PERCENT POINTS SMALLER THAN THE OBSERVED C SAMPLE MINIMUM OR LARGER THAN THE OBSERVED C SAMPLE MAXIMUM. C IF (N+1)P IS SMALLER THAN 1, AN ERROR MESSAGE WILL C BE PRINTED OUT AND PP WILL BE SET TO -999999999.0 C IF(N+1)P IS LARGER THAN N, AN ERROR MESSAGE WILL C BE PRINTED OUT AND PP WILL BE SET TO 999999999.0. C OTHER DATAPAC SUBROUTINES NEEDED--SORT. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 236-239, C 243. C --MOOD AND GRABLE, 'INTRODUCTION TO THE THEORY C OF STATISTICS, EDITION 2, 1963, PAGES 406-407. C --SNEDECOR AND COCHRAN, STATISTICAL METHODS, C EDITION 6, 1967, PAGE 125. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--DECEMBER 1974. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(15000) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)) C IPR=6 IUPPER=15000 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C AN=N ANP1=N+1 AJ=P*ANP1 J=AJ JP1=J+1 IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 IF(J.LT.1)GOTO60 IF(JP1.GT.N)GOTO65 HOLD=X(1) DO70I=2,N IF(X(I).NE.HOLD)GOTO90 70 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) PP=X(1) RETURN 60 WRITE(IPR,48) WRITE(IPR,51)N,P PP=-999999999.0 RETURN 65 WRITE(IPR,49) WRITE(IPR,51)N,P PP=999999999.0 RETURN 90 CONTINUE 9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE SAMPP SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 SAMPP SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE SAMPP SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) 48 FORMAT(1H ,48HTHE THIRD INPUT ARGUMENT IS SMALLER THAN 1/(N+1), 1 32H = 1/(SECOND INPUT ARGUMENT + 1)) 49 FORMAT(1H ,47HTHE THIRD INPUT ARGUMENT IS LARGER THAN N/(N+1), 1 54H = (SECOND INPUT ARGUMENT)/(SECOND INPUT ARGUMENT + 1)) 51 FORMAT(1H ,46H*****THE VALUE OF THE SECOND INPUT ARGUMENT = ,I8, 142H THE VALUE OF THE THIRD INPUT ARGUMENT = ,E20.10,5H*****) C C-----START POINT----------------------------------------------------- C CALL SORT(X,N,Y) C AJINT=J W=1.0-(AJ-AJINT) PP=W*Y(J)+(1.0-W)*Y(JP1) C HUNP=100.0*P IF(IWRITE.EQ.0)RETURN WRITE(IPR,205)HUNP,N,PP 205 FORMAT(1H ,14HTHE EMPIRICAL ,F9.5,22H PERCENT POINT OF THE , 1 I6,17H OBSERVATIONS IS ,F16.7) C RETURN END SUBROUTINE SCALE(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT SCALE C C PURPOSE--THIS SUBROUTINE COMPUTES 4 ESTIMATES OF THE C SCALE (VARIATION, SCATTER, DISPERSION) C OF THE DATA IN THE INPUT VECTOR X. C THE 4 ESTIMATORS EMPLOYED ARE-- C 1) THE SAMPLE RANGE; C 2) THE SAMPLE STANDARD DEVIATION; C 3) THE SAMPLE RELATIVE STANDARD DEVIATION; AND C 4) THE SAMPLE VARIANCE. C NOTE THAT N-1 (RATHER THAN N) C IS USED IN THE DIVISOR IN THE C COMPUTATION OF THE SAMPLE STANDARD C DEVIATION, THE SAMPLE RELATIVE C STANDARD DEVIATION, AND THE C SAMPLE VARIANCE. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--1/4 PAGE OF AUTOMATIC OUTPUT C CONSISTING OF THE FOLLOWING 4 C ESTIMATES OF SCALE C FOR THE DATA IN THE INPUT VECTOR X-- C 1) THE SAMPLE RANGE; C 2) THE SAMPLE STANDARD DEVIATION; C 3) THE SAMPLE RELATIVE STANDARD DEVIATION; AND C 4) THE SAMPLE VARIANCE. C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--THE SAMPLE RELATIVE STANDARD DEVIATION C IS THE SAMPLE STANDARD DEVIATION RELATIVE C TO THE MAGNITUDE OF THE SAMPLE MEAN. C THE RELATIVE SAMPLE STANDARD DEVIATION C IS EXPRESSED AS A PERCENT. C THE RELATIVE SAMPLE STANDARD DEVIATION C IS EQUIVALENTLY CALLED THE C SAMPLE COEFFICIENT OF VARIATION. C REFERENCES--DIXON AND MASSEY, PAGES 19 AND 21 C --SNEDECOR AND COCHRAN, PAGE 62 C --DIXON AND MASSEY, PAGES 14, 70, AND 71 C --CROW, JOURNAL OF THE AMERICAN STATISTICAL ASSOCIATION, C PAGES 357 AND 387 C --KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 1, EDITION 2, 1963, PAGE 8. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C XRANGE=0.0 XSD=0.0 XRELSD=0.0 XVAR=0.0 IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XRANGE=0.0 XSD=0.0 XRELSD=0.0 GOTO301 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE SCALE SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 SCALE SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE SCALE SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C DETERMINE THE SAMPLE MINIMUM AND THE SAMPLE MAXIMUM, C THEN COMPUTE THE SAMPLE RANGE. C XMIN=X(1) XMAX=X(1) DO100I=1,N IF(X(I).LT.XMIN)XMIN=X(I) IF(X(I).GT.XMAX)XMAX=X(I) 100 CONTINUE XRANGE=XMAX-XMIN C C COMPUTE THE SAMPLE VARIANCE, C AND THEN THE SAMPLE STANDARDD DEVIATION. C SUM=0.0 DO150I=1,N SUM=SUM+X(I) 150 CONTINUE XMEAN=SUM/AN SUM=0.0 DO200I=1,N SUM=SUM+(X(I)-XMEAN)**2 200 CONTINUE XVAR=SUM/(AN-1.0) XSD=SQRT(XVAR) C C COMPUTE THE SAMPLE RELATIVE STANDARD DEVIATION; C THAT IS, THE SAMPLE STANDARD DEVIATION RELATIVE C TO THE MAGNITUDE OF THE SAMPLE MEAN. C THE RESULTING SAMPLE STANDARD DEVIATION IS EXPRESSED C AS A PERCENT. C XRELSD=100.0*XSD/XMEAN IF(XRELSD.LT.0.0)XRELSD=-XRELSD C C WRITE EVERYTHING OUT C 301 DO300I=1,5 WRITE(IPR,999) 300 CONTINUE WRITE(IPR,305) WRITE(IPR,999) WRITE(IPR,310)N WRITE(IPR,999) WRITE(IPR,999) WRITE(IPR,315)XRANGE WRITE(IPR,320)XSD WRITE(IPR,325)XVAR WRITE(IPR,330)XRELSD C 305 FORMAT(1H ,30X,32HESTIMATES OF THE SCALE PARAMETER) 310 FORMAT(1H ,34X,21H(THE SAMPLE SIZE N = ,I5,1H)) 315 FORMAT(1H ,42HTHE SAMPLE RANGE IS ,E15.8) 320 FORMAT(1H ,42HTHE SAMPLE STANDARD DEVIATION IS ,E15.8) 325 FORMAT(1H ,42HTHE SAMPLE VARIANCE IS ,E15.8) 330 FORMAT(1H ,42HTHE SAMPLE RELATIVE STANDARD DEVIATION IS ,E15.8,8H 1PERCENT) 999 FORMAT(1H ) C RETURN END SUBROUTINE SD(X,N,IWRITE,XSD) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT SD C C PURPOSE--THIS SUBROUTINE COMPUTES THE C SAMPLE STANDARD DEVIATION (WITH DENOMINATOR N-1) C OF THE DATA IN THE INPUT VECTOR X. C THE SAMPLE STANDARD DEVIATION = SQRT((THE SUM OF THE C SQUARED DEVIATIONS ABOUT THE SAMPLE MEAN)/(N-1)). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --IWRITE = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL SUPPRESS C THE PRINTING OF THE C SAMPLE STANDARD DEVIATION C AS IT IS COMPUTED; C OR (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0), C LIKE, SAY, 1) WILL CAUSE C THE PRINTING OF THE C SAMPLE STANDARD DEVIATION C AT THE TIME IT IS COMPUTED. C OUTPUT ARGUMENTS--XSD = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE STANDARD DEVIATION. C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SAMPLE STANDARD DEVIATION (WITH DENOMINATOR N-1). C PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO C INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR C CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--SNEDECOR AND COCHRAN, STATISTICAL METHODS, C EDITION 6, 1967, PAGE 44. C --DIXON AND MASSEY, INTRODUCTION TO STATISTICAL C ANALYSIS, EDITION 2, 1957, PAGES 19, 76. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C AN=N IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD XSD=0.0 GOTO201 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XSD=0.0 GOTO201 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE SD SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 SD SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE SD SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C SUM=0.0 DO100I=1,N SUM=SUM+X(I) 100 CONTINUE XMEAN=SUM/AN SUM=0.0 DO200I=1,N SUM=SUM+(X(I)-XMEAN)**2 200 CONTINUE VAR=SUM/(AN-1.0) XSD=SQRT(VAR) C 201 IF(IWRITE.EQ.0)RETURN WRITE(IPR,999) WRITE(IPR,205)N,XSD 205 FORMAT(1H ,37HTHE SAMPLE STANDARD DEVIATION OF THE ,I6,17H OBSERVA 1TIONS IS ,E15.8) 999 FORMAT(1H ) RETURN END SUBROUTINE SKIPR(NLHEAD) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT SKIPR C C PURPOSE--THIS SUBROUTINE READS THROUGH (SKIPS OVER) C NLHEAD LINES FROM INPUT UNIT = 5. C IF HEADER INFORMATION EXISTS AT THE C BEGINNING OF A DATA FILE, THIS SUBROUTINE C IS CONVENIENT FOR READING THROUGH C (SKIPPING OVER) THAT HEADER INFORMATION. C INPUT ARGUMENTS--NLHEAD = THE INTEGER NUMBER OF CARD C IMAGES TO BE READ THROUGH C (SKIPPED OVER). C OUTPUT--NONE. C PRINTING--NO. C RESTRICTIONS--NLHEAD IS A NON-NEGATIVE INTEGER VARIABLE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--INTEGER. C LANGUAGE--ANSI FORTRAN. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --MAY 1976. C UPDATED --OCTOBER 1976. C C--------------------------------------------------------------------- C IRD=5 IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(NLHEAD.LT.0)GOTO55 GOTO90 55 WRITE(IPR,8) WRITE(IPR,47)NLHEAD RETURN 90 CONTINUE 8 FORMAT(1H , 87H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 SKIPR SUBROUTINE IS NEGATIVE *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C C SKIP OVER THE HEADER LABEL C IF(NLHEAD.EQ.0)RETURN DO100I=1,NLHEAD READ(IRD,105)IA 105 FORMAT(A1) 100 CONTINUE C RETURN END SUBROUTINE SORT(X,N,Y) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT SORT C C PURPOSE--THIS SUBROUTINE SORTS (IN ASCENDING ORDER) C THE N ELEMENTS OF THE SINGLE PRECISION VECTOR X C AND PUTS THE RESULTING N SORTED VALUES INTO THE C SINGLE PRECISION VECTOR Y. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C OBSERVATIONS TO BE SORTED. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR C INTO WHICH THE SORTED DATA VALUES C FROM X WILL BE PLACED. C OUTPUT--THE SINGLE PRECISION VECTOR Y C CONTAINING THE SORTED C (IN ASCENDING ORDER) VALUES C OF THE SINGLE PRECISION VECTOR X. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THE DIMENSIONS OF THE VECTORS IL AND IU C (DEFINED AND USED INTERNALLY WITHIN C THIS SUBROUTINE) DICTATE THE MAXIMUM C ALLOWABLE VALUE OF N FOR THIS SUBROUTINE. C IF IL AND IU EACH HAVE DIMENSION K, C THEN N MAY NOT EXCEED 2**(K+1) - 1. C FOR THIS SUBROUTINE AS WRITTEN, THE DIMENSIONS C OF IL AND IU HAVE BEEN SET TO 36, C THUS THE MAXIMUM ALLOWABLE VALUE OF N IS C APPROXIMATELY 137 BILLION. C SINCE THIS EXCEEDS THE MAXIMUM ALLOWABLE C VALUE FOR AN INTEGER VARIABLE IN MANY COMPUTERS, C AND SINCE A SORT OF 137 BILLION ELEMENTS C IS PRESENTLY IMPRACTICAL AND UNLIKELY, C THEN THERE IS NO PRACTICAL RESTRICTION C ON THE MAXIMUM VALUE OF N FOR THIS SUBROUTINE. C (IN LIGHT OF THE ABOVE, NO CHECK OF THE C UPPER LIMIT OF N HAS BEEN INCORPORATED C INTO THIS SUBROUTINE.) C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--THE SMALLEST ELEMENT OF THE VECTOR X C WILL BE PLACED IN THE FIRST POSITION C OF THE VECTOR Y, C THE SECOND SMALLEST ELEMENT IN THE VECTOR X C WILL BE PLACED IN THE SECOND POSITION C OF THE VECTOR Y, ETC. C COMMENT--THE INPUT VECTOR X REMAINS UNALTERED. C COMMENT--IF THE ANALYST DESIRES A SORT 'IN PLACE', C THIS IS DONE BY HAVING THE SAME C OUTPUT VECTOR AS INPUT VECTOR IN THE CALLING SEQUENCE. C THUS, FOR EXAMPLE, THE CALLING SEQUENCE C CALL SORT(X,N,X) C IS ALLOWABLE AND WILL RESULT IN C THE DESIRED 'IN-PLACE' SORT. C COMMENT--THE SORTING ALGORTHM USED HEREIN C IS THE BINARY SORT. C THIS ALGORTHIM IS EXTREMELY FAST AS THE C FOLLOWING TIME TRIALS INDICATE. C THESE TIME TRIALS WERE CARRIED OUT ON THE C UNIVAC 1108 EXEC 8 SYSTEM AT NBS C IN AUGUST OF 1974. C BY WAY OF COMPARISON, THE TIME TRIAL VALUES C FOR THE EASY-TO-PROGRAM BUT EXTREMELY C INEFFICIENT BUBBLE SORT ALGORITHM HAVE C ALSO BEEN INCLUDED-- C NUMBER OF RANDOM BINARY SORT BUBBLE SORT C NUMBERS SORTED C N = 10 .002 SEC .002 SEC C N = 100 .011 SEC .045 SEC C N = 1000 .141 SEC 4.332 SEC C N = 3000 .476 SEC 37.683 SEC C N = 10000 1.887 SEC NOT COMPUTED C REFERENCES--CACM MARCH 1969, PAGE 186 (BINARY SORT ALGORITHM C BY RICHARD C. SINGLETON). C --CACM JANUARY 1970, PAGE 54. C --CACM OCTOBER 1970, PAGE 624. C --JACM JANUARY 1961, PAGE 41. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1),Y(1) DIMENSION IU(36),IL(36) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD DO61I=1,N Y(I)=X(I) 61 CONTINUE RETURN 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) Y(1)=X(1) RETURN 90 CONTINUE 9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE SORT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 SORT SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE SORT SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C C COPY THE VECTOR X INTO THE VECTOR Y DO100I=1,N Y(I)=X(I) 100 CONTINUE C C CHECK TO SEE IF THE INPUT VECTOR IS ALREADY SORTED C NM1=N-1 DO200I=1,NM1 IP1=I+1 IF(Y(I).LE.Y(IP1))GOTO200 GOTO250 200 CONTINUE RETURN 250 M=1 I=1 J=N 305 IF(I.GE.J)GOTO370 310 K=I MID=(I+J)/2 AMED=Y(MID) IF(Y(I).LE.AMED)GOTO320 Y(MID)=Y(I) Y(I)=AMED AMED=Y(MID) 320 L=J IF(Y(J).GE.AMED)GOTO340 Y(MID)=Y(J) Y(J)=AMED AMED=Y(MID) IF(Y(I).LE.AMED)GOTO340 Y(MID)=Y(I) Y(I)=AMED AMED=Y(MID) GOTO340 330 Y(L)=Y(K) Y(K)=TT 340 L=L-1 IF(Y(L).GT.AMED)GOTO340 TT=Y(L) 350 K=K+1 IF(Y(K).LT.AMED)GOTO350 IF(K.LE.L)GOTO330 LMI=L-I JMK=J-K IF(LMI.LE.JMK)GOTO360 IL(M)=I IU(M)=L I=K M=M+1 GOTO380 360 IL(M)=K IU(M)=J J=L M=M+1 GOTO380 370 M=M-1 IF(M.EQ.0)RETURN I=IL(M) J=IU(M) 380 JMI=J-I IF(JMI.GE.11)GOTO310 IF(I.EQ.1)GOTO305 I=I-1 390 I=I+1 IF(I.EQ.J)GOTO370 AMED=Y(I+1) IF(Y(I).LE.AMED)GOTO390 K=I 395 Y(K+1)=Y(K) K=K-1 IF(AMED.LT.Y(K))GOTO395 Y(K+1)=AMED GOTO390 END SUBROUTINE SORTC(X,Y,N,XS,YC) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT SORTC C C PURPOSE--THIS SUBROUTINE SORTS (IN ASCENDING ORDER) C THE N ELEMENTS OF THE SINGLE PRECISION VECTOR X, C PUTS THE RESULTING N SORTED VALUES INTO THE C SINGLE PRECISION VECTOR XS, C REARRANGES THE ELEMENTS OF THE VECTOR Y C (ACCORDING TO THE SORT ON X), C AND PUTS THE REARRANGED Y VALUES C INTO THE SINGLE PRECISION VECTOR YC. C THIS SUBROUTINE GIVES THE DATA ANALYST C THE ABILITY TO SORT ONE DATA VECTOR C WHILE 'CARRYING ALONG' THE ELEMENTS C OF A SECOND DATA VECTOR. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C OBSERVATIONS TO BE SORTED. C --Y = THE SINGLE PRECISION VECTOR OF C OBSERVATIONS TO BE 'CARRIED ALONG', C THAT IS, TO BE REARRANGED ACCORDING C TO THE SORT ON X. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT ARGUMENTS--XS = THE SINGLE PRECISION VECTOR C INTO WHICH THE SORTED DATA VALUES C FROM X WILL BE PLACED. C --YC = THE SINGLE PRECISION VECTOR C INTO WHICH THE REARRANGED C (ACCORDING TO THE SORT OF THE C VECTOR X) VALUES OF THE VECTOR Y C WILL BE PLACED. C OUTPUT--THE SINGLE PRECISION VECTOR XS C CONTAINING THE SORTED C (IN ASCENDING ORDER) VALUES C OF THE SINGLE PRECISION VECTOR X, AND C THE SINGLE PRECISION VECTOR YC C CONTAINING THE REARRANGED C (ACCORDING TO THE SORT ON X) C VALUES OF THE VECTOR Y. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THE DIMENSIONS OF THE VECTORS IL AND IU C (DEFINED AND USED INTERNALLY WITHIN C THIS SUBROUTINE) DICTATE THE MAXIMUM C ALLOWABLE VALUE OF N FOR THIS SUBROUTINE. C IF IL AND IU EACH HAVE DIMENSION K, C THEN N MAY NOT EXCEED 2**(K+1) - 1. C FOR THIS SUBROUTINE AS WRITTEN, THE DIMENSIONS C OF IL AND IU HAVE BEEN SET TO 36, C THUS THE MAXIMUM ALLOWABLE VALUE OF N IS C APPROXIMATELY 137 BILLION. C SINCE THIS EXCEEDS THE MAXIMUM ALLOWABLE C VALUE FOR AN INTEGER VARIABLE IN MANY COMPUTERS, C AND SINCE A SORT OF 137 BILLION ELEMENTS C IS PRESENTLY IMPRACTICAL AND UNLIKELY, C THEN THERE IS NO PRACTICAL RESTRICTION C ON THE MAXIMUM VALUE OF N FOR THIS SUBROUTINE. C (IN LIGHT OF THE ABOVE, NO CHECK OF THE C UPPER LIMIT OF N HAS BEEN INCORPORATED C INTO THIS SUBROUTINE.) C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--THE SMALLEST ELEMENT OF THE VECTOR X C WILL BE PLACED IN THE FIRST POSITION C OF THE VECTOR XS, C THE SECOND SMALLEST ELEMENT IN THE VECTOR X C WILL BE PLACED IN THE SECOND POSITION C OF THE VECTOR XS, C ETC. C COMMENT--THE ELEMENT IN THE VECTOR Y CORRESPONDING C TO THE SMALLEST ELEMENT IN X C WILL BE PLACED IN THE FIRST POSITION C OF THE VECTOR YC, C THE ELEMENT IN THE VECTOR Y CORRESPONDING C TO THE SECOND SMALLEST ELEMENT IN X C WILL BE PLACED IN THE SECOND POSITION C OF THE VECTOR YC, C ETC. C COMMENT--THE INPUT VECTOR X REMAINS UNALTERED. C COMMENT--IF THE ANALYST DESIRES A SORT 'IN PLACE', C THIS IS DONE BY HAVING THE SAME C OUTPUT VECTOR AS INPUT VECTOR IN THE CALLING SEQUENCE. C THUS, FOR EXAMPLE, THE CALLING SEQUENCE C CALL SORTC(X,Y,N,X,YC) C IS ALLOWABLE AND WILL RESULT IN C THE DESIRED 'IN-PLACE' SORT. C COMMENT--THE SORTING ALGORTHM USED HEREIN C IS THE BINARY SORT. C THIS ALGORTHIM IS EXTREMELY FAST AS THE C FOLLOWING TIME TRIALS INDICATE. C THESE TIME TRIALS WERE CARRIED OUT ON THE C UNIVAC 1108 EXEC 8 SYSTEM AT NBS C IN AUGUST OF 1974. C BY WAY OF COMPARISON, THE TIME TRIAL VALUES C FOR THE EASY-TO-PROGRAM BUT EXTREMELY C INEFFICIENT BUBBLE SORT ALGORITHM HAVE C ALSO BEEN INCLUDED-- C NUMBER OF RANDOM BINARY SORT BUBBLE SORT C NUMBERS SORTED C N = 10 .002 SEC .002 SEC C N = 100 .011 SEC .045 SEC C N = 1000 .141 SEC 4.332 SEC C N = 3000 .476 SEC 37.683 SEC C N = 10000 1.887 SEC NOT COMPUTED C REFERENCES--CACM MARCH 1969, PAGE 186 (BINARY SORT ALGORITHM C BY RICHARD C. SINGLETON). C --CACM JANUARY 1970, PAGE 54. C --CACM OCTOBER 1970, PAGE 624. C --JACM JANUARY 1961, PAGE 41. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1),Y(1),XS(1),YC(1) DIMENSION IU(36),IL(36) C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IPR=6 IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD DO61I=1,N XS(I)=X(I) YC(I)=Y(I) 61 CONTINUE RETURN 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XS(1)=X(1) YC(1)=Y(1) RETURN 90 CONTINUE 9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE SORTC SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 SORTC SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE SORTC SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C C COPY THE VECTOR X INTO THE VECTOR XS DO100I=1,N XS(I)=X(I) 100 CONTINUE C C COPY THE VECTOR Y INTO THE VECTOR YS C DO150I=1,N YC(I)=Y(I) 150 CONTINUE C C CHECK TO SEE IF THE INPUT VECTOR IS ALREADY SORTED C NM1=N-1 DO200I=1,NM1 IP1=I+1 IF(XS(I).LE.XS(IP1))GOTO200 GOTO250 200 CONTINUE RETURN 250 M=1 I=1 J=N 305 IF(I.GE.J)GOTO370 310 K=I MID=(I+J)/2 AMED=XS(MID) BMED=YC(MID) IF(XS(I).LE.AMED)GOTO320 XS(MID)=XS(I) YC(MID)=YC(I) XS(I)=AMED YC(I)=BMED AMED=XS(MID) BMED=YC(MID) 320 L=J IF(XS(J).GE.AMED)GOTO340 XS(MID)=XS(J) YC(MID)=YC(J) XS(J)=AMED YC(J)=BMED AMED=XS(MID) BMED=YC(MID) IF(XS(I).LE.AMED)GOTO340 XS(MID)=XS(I) YC(MID)=YC(I) XS(I)=AMED YC(I)=BMED AMED=XS(MID) BMED=YC(MID) GOTO340 330 XS(L)=XS(K) YC(L)=YC(K) XS(K)=TX YC(K)=TY 340 L=L-1 IF(XS(L).GT.AMED)GOTO340 TX=XS(L) TY=YC(L) 350 K=K+1 IF(XS(K).LT.AMED)GOTO350 IF(K.LE.L)GOTO330 LMI=L-I JMK=J-K IF(LMI.LE.JMK)GOTO360 IL(M)=I IU(M)=L I=K M=M+1 GOTO380 360 IL(M)=K IU(M)=J J=L M=M+1 GOTO380 370 M=M-1 IF(M.EQ.0)RETURN I=IL(M) J=IU(M) 380 JMI=J-I IF(JMI.GE.11)GOTO310 IF(I.EQ.1)GOTO305 I=I-1 390 I=I+1 IF(I.EQ.J)GOTO370 AMED=XS(I+1) BMED=YC(I+1) IF(XS(I).LE.AMED)GOTO390 K=I 395 XS(K+1)=XS(K) YC(K+1)=YC(K) K=K-1 IF(AMED.LT.XS(K))GOTO395 XS(K+1)=AMED YC(K+1)=BMED GOTO390 END SUBROUTINE SORTP(X,N,Y,XPOS) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT SORTP C C PURPOSE--THIS SUBROUTINE SORTS (IN ASCENDING ORDER) C THE N ELEMENTS OF THE SINGLE PRECISION VECTOR X, C PUTS THE RESULTING N SORTED VALUES INTO THE C SINGLE PRECISION VECTOR Y, C AND PUTS THE POSITION (IN THE ORIGINAL VECTOR X) C OF EACH OF THE SORTED VALUES. C INTO THE SINGLE PRECISION VECTOR XPOS. C THIS SUBROUTINE GIVES THE DATA ANALYST C NOT ONLY THE ABILITY TO DETERMINE C WHAT THE MIN AND MAX (FOR EXAMPLE) C OF THE DATA SET ARE, BUT ALSO C WHERE IN THE ORIGINAL DATA SET C THE MIN AND MAX OCCUR. C THIS IS ESPECIALLY USEFUL FOR C LARGE DATA SETS. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C OBSERVATIONS TO BE SORTED. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR C INTO WHICH THE SORTED DATA VALUES C FROM X WILL BE PLACED. C --XPOS = THE SINGLE PRECISION VECTOR C INTO WHICH THE POSITIONS C (IN THE ORIGINAL VECTOR X) C OF THE SORTED VALUES C WILL BE PLACED. C OUTPUT--THE SINGLE PRECISION VECTOR XS C CONTAINING THE SORTED C (IN ASCENDING ORDER) VALUES C OF THE SINGLE PRECISION VECTOR X, AND C THE SINGLE PRECISION VECTOR XPOS C CONTAINING THE POSITIONS C (IN THE ORIGINAL VECTOR X) C OF THE SORTED VALUES. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THE DIMENSIONS OF THE VECTORS IL AND IU C (DEFINED AND USED INTERNALLY WITHIN C THIS SUBROUTINE) DICTATE THE MAXIMUM C ALLOWABLE VALUE OF N FOR THIS SUBROUTINE. C IF IL AND IU EACH HAVE DIMENSION K, C THEN N MAY NOT EXCEED 2**(K+1) - 1. C FOR THIS SUBROUTINE AS WRITTEN, THE DIMENSIONS C OF IL AND IU HAVE BEEN SET TO 36, C THUS THE MAXIMUM ALLOWABLE VALUE OF N IS C APPROXIMATELY 137 BILLION. C SINCE THIS EXCEEDS THE MAXIMUM ALLOWABLE C VALUE FOR AN INTEGER VARIABLE IN MANY COMPUTERS, C AND SINCE A SORT OF 137 BILLION ELEMENTS C IS PRESENTLY IMPRACTICAL AND UNLIKELY, C THEN THERE IS NO PRACTICAL RESTRICTION C ON THE MAXIMUM VALUE OF N FOR THIS SUBROUTINE. C (IN LIGHT OF THE ABOVE, NO CHECK OF THE C UPPER LIMIT OF N HAS BEEN INCORPORATED C INTO THIS SUBROUTINE.) C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--THE SMALLEST ELEMENT OF THE VECTOR X C WILL BE PLACED IN THE FIRST POSITION C OF THE VECTOR Y, C THE SECOND SMALLEST ELEMENT IN THE VECTOR X C WILL BE PLACED IN THE SECOND POSITION C OF THE VECTOR Y, C ETC. C COMMENT--THE POSITION (1 THROUGH N) IN X C OF THE SMALLEST ELEMENT IN X C WILL BE PLACED IN THE FIRST POSITION C OF THE VECTOR XPOS, C THE POSITION (1 THROUGH N) IN X C OF THE SECOND SMALLEST ELEMENT IN X C WILL BE PLACED IN THE SECOND POSITION C OF THE VECTOR XPOS, C ETC. C ALTHOUGH THESE POSITIONS ARE NECESSARILY C INTEGRAL VALUES FROM 1 TO N, IT IS TO BE C NOTED THAT THEY ARE OUTPUTED AS SINGLE C PRECISION INTEGERS IN THE SINGLE PRECISION C VECTOR XPOS. C XPOS IS SINGLE PRECISION SO AS TO BE C CONSISTENT WITH THE FACT THAT ALL C VECTOR ARGUMENTS IN ALL OTHER C DATAPAC SUBROUTINES ARE SINGLE PRECISION. C COMMENT--THE INPUT VECTOR X REMAINS UNALTERED. C COMMENT--IF THE ANALYST DESIRES A SORT 'IN PLACE', C THIS IS DONE BY HAVING THE SAME C OUTPUT VECTOR AS INPUT VECTOR IN THE CALLING SEQUENCE. C THUS, FOR EXAMPLE, THE CALLING SEQUENCE C CALL SORTP(X,N,X,XPOS) C IS ALLOWABLE AND WILL RESULT IN C THE DESIRED 'IN-PLACE' SORT. C COMMENT--THE SORTING ALGORTHM USED HEREIN C IS THE BINARY SORT. C THIS ALGORTHIM IS EXTREMELY FAST AS THE C FOLLOWING TIME TRIALS INDICATE. C THESE TIME TRIALS WERE CARRIED OUT ON THE C UNIVAC 1108 EXEC 8 SYSTEM AT NBS C IN AUGUST OF 1974. C BY WAY OF COMPARISON, THE TIME TRIAL VALUES C FOR THE EASY-TO-PROGRAM BUT EXTREMELY C INEFFICIENT BUBBLE SORT ALGORITHM HAVE C ALSO BEEN INCLUDED-- C NUMBER OF RANDOM BINARY SORT BUBBLE SORT C NUMBERS SORTED C N = 10 .002 SEC .002 SEC C N = 100 .011 SEC .045 SEC C N = 1000 .141 SEC 4.332 SEC C N = 3000 .476 SEC 37.683 SEC C N = 10000 1.887 SEC NOT COMPUTED C REFERENCES--CACM MARCH 1969, PAGE 186 (BINARY SORT ALGORITHM C BY RICHARD C. SINGLETON). C --CACM JANUARY 1970, PAGE 54. C --CACM OCTOBER 1970, PAGE 624. C --JACM JANUARY 1961, PAGE 41. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1),Y(1),XPOS(1) DIMENSION IU(36),IL(36) C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IPR=6 IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD DO61I=1,N Y(I)=X(I) XPOS(I)=I 61 CONTINUE RETURN 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) Y(1)=X(1) XPOS(1)=1.0 RETURN 90 CONTINUE 9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE SORTP SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 SORTP SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE SORTP SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C C COPY THE VECTOR X INTO THE VECTOR Y DO100I=1,N Y(I)=X(I) 100 CONTINUE C C DEFINE THE XPOS (POSITION) VECTOR. BEFORE SORTING, THIS WILL C BE A VECTOR WHOSE I-TH ELEMENT IS EQUAL TO I. C DO150I=1,N XPOS(I)=I 150 CONTINUE C C CHECK TO SEE IF THE INPUT VECTOR IS ALREADY SORTED C NM1=N-1 DO200I=1,NM1 IP1=I+1 IF(Y(I).LE.Y(IP1))GOTO200 GOTO250 200 CONTINUE RETURN 250 M=1 I=1 J=N 305 IF(I.GE.J)GOTO370 310 K=I MID=(I+J)/2 AMED=Y(MID) BMED=XPOS(MID) IF(Y(I).LE.AMED)GOTO320 Y(MID)=Y(I) XPOS(MID)=XPOS(I) Y(I)=AMED XPOS(I)=BMED AMED=Y(MID) BMED=XPOS(MID) 320 L=J IF(Y(J).GE.AMED)GOTO340 Y(MID)=Y(J) XPOS(MID)=XPOS(J) Y(J)=AMED XPOS(J)=BMED AMED=Y(MID) BMED=XPOS(MID) IF(Y(I).LE.AMED)GOTO340 Y(MID)=Y(I) XPOS(MID)=XPOS(I) Y(I)=AMED XPOS(I)=BMED AMED=Y(MID) BMED=XPOS(MID) GOTO340 330 Y(L)=Y(K) XPOS(L)=XPOS(K) Y(K)=TT XPOS(K)=ITT 340 L=L-1 IF(Y(L).GT.AMED)GOTO340 TT=Y(L) ITT=XPOS(L) 350 K=K+1 IF(Y(K).LT.AMED)GOTO350 IF(K.LE.L)GOTO330 LMI=L-I JMK=J-K IF(LMI.LE.JMK)GOTO360 IL(M)=I IU(M)=L I=K M=M+1 GOTO380 360 IL(M)=K IU(M)=J J=L M=M+1 GOTO380 370 M=M-1 IF(M.EQ.0)RETURN I=IL(M) J=IU(M) 380 JMI=J-I IF(JMI.GE.11)GOTO310 IF(I.EQ.1)GOTO305 I=I-1 390 I=I+1 IF(I.EQ.J)GOTO370 AMED=Y(I+1) BMED=XPOS(I+1) IF(Y(I).LE.AMED)GOTO390 K=I 395 Y(K+1)=Y(K) XPOS(K+1)=XPOS(K) K=K-1 IF(AMED.LT.Y(K))GOTO395 Y(K+1)=AMED XPOS(K+1)=BMED GOTO390 END SUBROUTINE SPCORR(X,Y,N,IWRITE,SPC) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT SPCORR C C PURPOSE--THIS SUBROUTINE COMPUTES THE C SPEARMAN RANK CORRELATION COEFFICIENT C BETWEEN THE 2 SETS OF DATA IN THE INPUT VECTORS X AND Y. C THE SPEARMAN RANK CORRELATION COEFFICIENT WILL BE A C SINGLE PRECISION VALUE BETWEEN -1.0 AND 1.0 C (INCLUSIVELY). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C WHICH CONSTITUTE THE FIRST SET C OF DATA. C --Y = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS C WHICH CONSTITUTE THE SECOND SET C OF DATA. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X, OR EQUIVALENTLY, C THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR Y. C --IWRITE = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL SUPPRESS C THE PRINTING OF THE C SPEARMAN RANK CORRELATION COEFFICIENT C AS IT IS COMPUTED; C OR (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0), C LIKE, SAY, 1) WILL CAUSE C THE PRINTING OF THE C SPEARMAN CORRELATION COEFFICIENT C AT THE TIME IT IS COMPUTED. C OUTPUT ARGUMENTS--SPC = THE SINGLE PRECISION VALUE OF THE C COMPUTED SPEARMAN RANK CORRELATION C COEFFICIENT BETWEEN THE 2 SETS OF DATA C IN THE INPUT VECTORS X AND Y. C THIS SINGLE PRECISION VALUE C WILL BE BETWEEN -1.0 AND 1.0 C (INCLUSIVELY). C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SPEARMAN RANK CORRELATION COEFFICIENT BETWEEN THE 2 SETS C OF DATA IN THE INPUT VECTORS X AND Y. C PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO C INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR C CONDITION EXISTS. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C OTHER DATAPAC SUBROUTINES NEEDED--RANK AND SORT. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 2, EDITION 1, 1961, PAGES 476-477. C --SNEDECOR AND COCHRAN, STATISTICAL METHODS, C EDITION 6, 1967, PAGES 193-195. C --DIXON AND MASSEY, INTRODUCTION TO STATISTICAL C ANALYSIS, EDITION 2, 1957, PAGES 294-295. C --MOOD AND GRABLE, 'INTRODUCTION TO THE THEORY C OF STATISTICS, EDITION 2, 1963, PAGE 424. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --OCTOBER 1974. C UPDATED --JANUARY 1975. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1),Y(1) DIMENSION XR(7500),YR(7500) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (XR(1),WS(1)),(YR(1),WS(7501)) C IPR=6 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C AN=N SPC=0.0 IFLAG=0 IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO65 60 CONTINUE WRITE(IPR, 9)HOLD IFLAG=1 65 HOLD=Y(1) DO70I=2,N IF(Y(I).NE.HOLD)GOTO80 70 CONTINUE WRITE(IPR,19)HOLD IFLAG=1 80 IF(IFLAG.EQ.1)RETURN GOTO90 50 WRITE(IPR,27)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,28) RETURN 90 CONTINUE 9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE SPCORR SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 19 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT (A VECTOR) TO THE SPCORR SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 27 FORMAT(' ***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE SP', 1'CORR SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *', 1'****') 28 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE THIRD INPUT ARGUME 1NT TO THE SPCORR SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C CALL RANK(X,N,XR) CALL RANK(Y,N,YR) SUM=0.0 DO100I=1,N SUM=SUM+(XR(I)-YR(I))**2 100 CONTINUE SPC =1.0-(6.0*SUM/((AN-1.0)*AN*(AN+1.0))) C IF(IWRITE.NE.0)WRITE(IPR,105)N,SPC 105 FORMAT(1H ,59HTHE SPEARMAN RANK CORRELATION COEFFICIENT OF THE 2 S 1ETS OF ,I6,17H OBSERVATIONS IS ,F14.5) RETURN END SUBROUTINE STMOM3(X,N,IWRITE,XSMOM3) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT STMOM3 C C PURPOSE--THIS SUBROUTINE COMPUTES THE C SAMPLE STANDARDIZED THIRD CENTRAL MOMENT C OF THE DATA IN THE INPUT VECTOR X. C THE SAMPLE STANDARDIZED THIRD CENTRAL MOMENT = C (THE SAMPLE THIRD CENTRAL MOMENT)/((THE SAMPLE C STANDARD DEVIATION)**3). C N (RATHER THAN N-1) HAS BEEN USED IN THE DENOMINATOR C IN THE CALCULATION OF BOTH THE SAMPLE THIRD CENTRAL C MOMENT AND THE SAMPLE STANDARD DEVIATION. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --IWRITE = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL SUPPRESS C THE PRINTING OF THE C SAMPLE STANDARDIZED THIRD CENTRAL C MOMENT AS IT IS COMPUTED; C OR (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0), C LIKE, SAY, 1) WILL CAUSE C THE PRINTING OF THE C SAMPLE STANDARDIZED THIRD CENTRAL C MOMENT AT THE TIME IT IS COMPUTED. C OUTPUT ARGUMENTS--XSMOM3 = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE STANDARDIZED THIRD C CENTRAL MOMENT. C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SAMPLE STANDARDIZED THIRD CENTRAL MOMENT. C PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO C INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR C CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 85, C 234, 243, 297-298, 305. C --SNEDECOR AND COCHRAN, STATISTICAL METHODS, C EDITION 6, 1967, PAGES 86-90. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(*) IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C AN=N IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD XSMOM3=0.0 GOTO201 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XSMOM3=0.0 GOTO201 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE STMOM3 SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 STMOM3 SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE STMOM3 SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C SUM=0.0 DO100I=1,N SUM=SUM+X(I) 100 CONTINUE XMEAN=SUM/AN SUM2=0.0 SUM3=0.0 DO200I=1,N SUM2=SUM2+(X(I)-XMEAN)**2 SUM3=SUM3+(X(I)-XMEAN)**3 200 CONTINUE SUM3=SUM3/AN VB=SUM2/AN XSMOM3=SUM3/(VB**1.5) C 201 IF(IWRITE.EQ.0)RETURN WRITE(IPR,999) WRITE(IPR,205)N,XSMOM3 205 FORMAT(1H , 54HTHE SAMPLE STANDARDIZED THIRD CENTRAL MOMENT FOR T 1HE ,I6,17H OBSERVATIONS IS ,E15.8) 999 FORMAT(1H ) RETURN END SUBROUTINE STMOM4(X,N,IWRITE,XSMOM4) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT STMOM4 C C PURPOSE--THIS SUBROUTINE COMPUTES THE C SAMPLE STANDARDIZED FOURTH CENTRAL MOMENT C OF THE DATA IN THE INPUT VECTOR X. C THE SAMPLE STANDARDIZED FOURTH CENTRAL MOMENT = C (THE SAMPLE FOURTH CENTRAL MOMENT)/((THE SAMPLE C STANDARD DEVIATION)**4). C N (RATHER THAN N-1) HAS BEEN USED IN THE DENOMINATOR C IN THE CALCULATION OF BOTH THE SAMPLE FOURTH CENTRAL C MOMENT AND THE SAMPLE STANDARD DEVIATION. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --IWRITE = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL SUPPRESS C THE PRINTING OF THE C SAMPLE STANDARDIZED FOURTH CENTRAL C MOMENT AS IT IS COMPUTED; C OR (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0), C LIKE, SAY, 1) WILL CAUSE C THE PRINTING OF THE C SAMPLE STANDARDIZED FOURTH CENTRAL C MOMENT AT THE TIME IT IS COMPUTED. C OUTPUT ARGUMENTS--XSMOM4 = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE STANDARDIZED FOURTH C CENTRAL MOMENT. C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SAMPLE STANDARDIZED FOURTH CENTRAL MOMENT. C PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO C INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR C CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF C STATISTICS, VOLUME 1, EDITION 2, 1963, PAGES 85, 243. C --SNEDECOR AND COCHRAN, STATISTICAL METHODS, C EDITION 6, 1967, PAGES 86-90. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C AN=N IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD XSMOM4=0.0 GOTO201 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XSMOM4=0.0 GOTO201 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE STMOM4 SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 STMOM4 SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE STMOM4 SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C SUM=0.0 DO100I=1,N SUM=SUM+X(I) 100 CONTINUE XMEAN=SUM/AN SUM2=0.0 SUM4=0.0 DO200I=1,N SUM2=SUM2+(X(I)-XMEAN)**2 SUM4=SUM4+(X(I)-XMEAN)**4 200 CONTINUE VB=SUM2/AN SUM4=SUM4/AN XSMOM4=SUM4/(VB*VB) C 201 IF(IWRITE.EQ.0)RETURN WRITE(IPR,999) WRITE(IPR,205)N,XSMOM4 205 FORMAT(1H , 54HTHE SAMPLE STANDARDIZED FOURTH CENTRAL MOMENT FOR T 1HE ,I6,17H OBSERVATIONS IS ,E15.8) 999 FORMAT(1H ) RETURN END SUBROUTINE SUBSE1(X,N,D,DMIN,DMAX,Y,NY) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT SUBSE1 C C PURPOSE--THIS SUBROUTINE CARRIES OVER INTO Y ALL OBSERVATIONS C OF THE SINGLE PRECISION VECTOR X FOR WHICH THE C CORRESPONDING ELEMENTS IN THE C SINGLE PRECISION VECTOR D ARE INSIDE C THE CLOSED (INCLUSIVE) INTERVAL C DEFINED BY DMIN AND DMAX, C WHILE NOT CARRYING OVER ANY OBSERVATIONS OF X C CORRESPONDING TO ELEMENTS OF D C OUTSIDE OF THIS INTERVAL. C THE INPUT VECTOR X IS ITSELF UNALTERED; C THOSE ELEMENTS OF X TO BE RETAINED ARE C COPIED OVER INTO THE SINGLE PRECISION C OUTPUT VECTOR Y. C THUS ALL OBSERVATIONS OF X WHICH C CORRESPOND TO ELEMENTS IN D WHICH ARE SMALLER C THAN DMIN OR LARGER THAN DMAX ARE C NOT COPIED OVER INTO Y. C THE USE OF THIS SUBROUTINE C GIVES THE DATA ANALYST THE CAPABILITY TO C EASILY EXTRACT SUBSETS OF THE DATA C PRIOR TO DATA ANALYSIS ON EACH SUBSET. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --D = THE SINGLE PRECISION VECTOR C WHICH 'DEFINES' THE VARIOUS C POSSIBLE SUBSETS OF X. C --DMIN = THE SINGLE PRECISION VALUE C WHICH DEFINES THE LOWER LIMIT C (INCLUSIVELY) OF THE PARTICULAR C SUBSET OF INTEREST TO BE RETAINED. C --DMAX = THE SINGLE PRECISION VALUE C WHICH DEFINES THE UPPER LIMIT C (INCLUSIVELY) OF THE PARTICULAR C SUBSET OF INTEREST TO BE RETAINED. C OUTPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR C CONTAINING ONLY THOSE ELEMENTS C OF X CORRESPONDING TO C VALUES OF THE D VECTOR C IN THE INTERVAL DMIN TO DMAX C (INCLUSIVE). C --NY = THE INTEGER NUMBER OF RETAINED C OBSERVATIONS COPIED INTO C THE VECTOR Y. C OUTPUT--THE SINGLE PRECISION VECTOR Y C INTO WHICH HAVE BEEN COPIED C ONLY THOSE VALUES OF X WHICH C CORRESPOND TO VALUES C IN THE D VECTOR INSIDE C (INCLUSIVELY) THE INTERVAL OF C INTEREST, AND C THE INTEGER VALUE NY C WHICH GIVES THE NUMBER OF C OBSERVATIONS COPIED INTO Y. C ALSO, 12 LINES OF SUMMARY INFORMATION C WILL BE GENERATED INDICATING C 1) WHAT THE INTERVAL OF INTEREST WAS C IN THE D VECTOR; C 2) HOW MANY OBSERVATIONS WERE DELETED; C 3) WHAT THE SAMPLE SIZE OF X WAS (N); C 4) WHAT THE SAMPLE SIZE OF Y WAS (NY); C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--THE INPUT VECTOR X IS NOT ALTERED C BY APPLICATION OF THIS SUBROUTINE. C THIS IS THE MAJOR DISTINCTION C BETWEEN THIS SUBROUTINE AND, SAY, C THE SUBSET SUBROUTINE. C IT IS THUS SEEN THAT THIS (SUBSE1) C SUBROUTINE IS THE PREFERABLE OF THE 2 C (SUBSET VERSUS SUBSE1) C FOR HANDLING THE PROBLEM OF C SEQUENTIALLY EXTRACTING EACH POSSIBLE C SUBSET OF X (FOR THE PURPOSE OF C ANALYZING EACH INDIVIDUAL SUBSET). C INASMUCH AS THE ORIGINAL X VECTOR C REMAINS UNCHANGED, THE ANALYST C CAN ALWAYS OPERATE ON IT WITH C SUBSE1 IN SEQUENTIALLY EXTRACTING C SUBSETS OF INTEREST. C COMMENT--IN THE END, AFTER THIS SUBROUTINE HAS C MADE WHATEVER DELETIONS ARE APPROPRIATE, C THE OUTPUT VECTOR Y WILL BE 'PACKED'; C THAT IS, NO 'HOLES' WILL EXIST IN THE C VECTOR Y--ALL OF THE RETAINED ELEMENTS C OF Y WILL BE PACKED INTO THE FIRST AVAILABLE C LOCATIONS IN Y, WHILE THE REMAINDER C OF THE N LOCATIONS IN Y WILL BE ZERO-FILLED. C COMMENT--ALTHOUGH THERE C MAY BE A CORRESPONDANCE BETWEEN THE C ELEMENTS OF THE X AND D VECTORS C BEFORE APPLICATION OF C THIS SUBROUTINE, THERE WILL C BE NO CORRESPONDANCE BETWEEN C Y AND D (DUE TO THE PACKING OF C THE RETAINED ELEMENTS IN Y) C AFTER APPLICATION OF THIS SUBROUTINE. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--APRIL 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(1) DIMENSION D(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) 90 CONTINUE 9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE SUBSE1 SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 SUBSE1 SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE SUBSE1 SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C POINTL=DMIN POINTU=DMAX IF(DMIN.GT.DMAX)POINTL=DMAX IF(DMIN.GT.DMAX)POINTU=DMIN C K=0 DO100I=1,N IF(D(I).LT.POINTL.OR.D(I).GT.POINTU)GOTO100 K=K+1 Y(K)=X(I) 100 CONTINUE NY=K NDEL=N-NY C C WRITE OUT A BRIEF SUMMARY C WRITE(IPR,999) WRITE(IPR,101) WRITE(IPR,111)POINTL,POINTU WRITE(IPR,160) WRITE(IPR,161) WRITE(IPR,162) WRITE(IPR,163) WRITE(IPR,164) WRITE(IPR,165) WRITE(IPR,166) WRITE(IPR,185)N WRITE(IPR,190)NY WRITE(IPR,195)NDEL 101 FORMAT(1H ,35HOUTPUT FROM THE SUBSE1 SUBROUTINE--) 111 FORMAT(1H ,7X,26HD1 LIMITS (INCLUSIVE)-- ,E15.8,5H AND ,E15.8) 160 FORMAT(1H ,7X,28HONLY THOSE OBSERVATIONS IN X) 161 FORMAT(1H ,7X,27HWILL BE CARRIED OVER INTO Y) 162 FORMAT(1H ,7X,40HFOR WHICH THE CORRESPONDING ELEMENTS OF , 1 2HD1) 163 FORMAT(1H ,7X,37HARE SIMULTANEOUSLY WITHIN (INCLUSIVE)) 164 FORMAT(1H ,7X,21HEACH SPECIFIED LIMIT.) 165 FORMAT(1H ,7X,40HNO OBSERVATIONS OUTSIDE OF THIS INTERVAL) 166 FORMAT(1H ,7X,30HHAVE BEEN CARRIED OVER INTO Y.) 185 FORMAT(1H ,7X,44HTHE INPUT NUMBER OF OBSERVATIONS (IN X) IS ,I6) 190 FORMAT(1H ,7X,44HTHE OUTPUT NUMBER OF OBSERVATIONS (IN Y) IS ,I6) 195 FORMAT(1H ,7X,44HTHE NUMBER OF OBSERVATIONS DELETED IS ,I6) 999 FORMAT(1H ) C RETURN END SUBROUTINE SUBSE2(X,N,D1,D1MIN,D1MAX,D2,D2MIN,D2MAX,Y,NY) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT SUBSE2 C C PURPOSE--THIS SUBROUTINE CARRIES OVER INTO Y ALL OBSERVATIONS C OF THE SINGLE PRECISION VECTOR X FOR WHICH THE C CORRESPONDING ELEMENTS IN THE C SINGLE PRECISION VECTOR D1 ARE INSIDE C THE CLOSED (INCLUSIVE) INTERVAL C DEFINED BY D1MIN AND D1MAX, C AND ALSO FOR WHICH THE C CORRESPONDING ELEMENTS IN THE C SINGLE PRECISION VECTOR D2 ARE INSIDE C THE CLOSED (INCLUSIVE) INTERVAL C DEFINED BY D2MIN AND D2MAX. C NO OBSERVATIONS IN X C CORRESPONDING TO ELEMENTS OF D1 OR D2 C OUTSIDE OF THEIR RESPECTIVE INTERVALS C ARE CARRIED OVER INTO Y. C THE INPUT VECTOR X IS ITSELF UNALTERED; C THOSE ELEMENTS OF X TO BE RETAINED ARE C COPIED OVER INTO THE SINGLE PRECISION C OUTPUT VECTOR Y. C THUS ALL OBSERVATIONS OF X WHICH C CORRESPOND TO ELEMENTS IN D1 WHICH ARE SMALLER C THAN D1MIN OR LARGER THAN D1MAX, OR WHICH C CORRESPOND TO ELEMENTS IN D2 WHICH ARE SMALLER C THAN D2MIN OR LARGER THAN D2MAX, C ARE NOT COPIED OVER INTO Y. C THE USE OF THIS SUBROUTINE C GIVES THE DATA ANALYST THE CAPABILITY TO C EASILY EXTRACT SUBSETS OF THE DATA C PRIOR TO DATA ANALYSIS ON EACH SUBSET. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --D1 = A SINGLE PRECISION VECTOR C WHICH (IN CONJUNCTION WITH D2) C 'DEFINES' THE VARIOUS C POSSIBLE SUBSETS OF X. C --D1MIN = THE SINGLE PRECISION VALUE C WHICH DEFINES IN D1 THE LOWER LIMIT C (INCLUSIVELY) OF THE PARTICULAR C SUBSET OF INTEREST TO BE RETAINED. C --D1MAX = THE SINGLE PRECISION VALUE C WHICH DEFINES IN D1 THE UPPER LIMIT C (INCLUSIVELY) OF THE PARTICULAR C SUBSET OF INTEREST TO BE RETAINED. C --D2 = A SINGLE PRECISION VECTOR C WHICH (IN CONJUNCTION WITH D2) C 'DEFINES' THE VARIOUS C POSSIBLE SUBSETS OF X. C --D2MIN = THE SINGLE PRECISION VALUE C WHICH DEFINES IN D2 THE LOWER LIMIT C (INCLUSIVELY) OF THE PARTICULAR C SUBSET OF INTEREST TO BE RETAINED. C --D2MAX = THE SINGLE PRECISION VALUE C WHICH DEFINES IN D2 THE UPPER LIMIT C (INCLUSIVELY) OF THE PARTICULAR C SUBSET OF INTEREST TO BE RETAINED. C OUTPUT ARGUMENTS--Y = THE SINGLE PRECISION VECTOR C CONTAINING ONLY THOSE ELEMENTS C OF X SIMULTANEOUSLY CORRESPONDING TO C VALUES OF THE D1 VECTOR C IN THE INTERVAL D1MIN TO D1MAX C (INCLUSIVE), AND C VALUES OF THE D2 VECTOR C IN THE INTERVAL D2MIN TO D2MAX C (INCLUSIVE). C --NY = THE INTEGER NUMBER OF RETAINED C OBSERVATIONS COPIED INTO C THE VECTOR Y. C OUTPUT--THE SINGLE PRECISION VECTOR Y C INTO WHICH HAVE BEEN COPIED C ONLY THOSE VALUES OF X WHICH C SIMULTANEOUSLY CORRESPOND TO VALUES C IN THE D1 AND D2 VECTORS INSIDE C (INCLUSIVELY) THE RESPECTIVE C INTERVALS OF INTEREST, AND C THE INTEGER VALUE NY C WHICH GIVES THE NUMBER OF C OBSERVATIONS COPIED INTO Y. C ALSO, 13 LINES OF SUMMARY INFORMATION C WILL BE GENERATED INDICATING C 1) WHAT THE INTERVAL OF INTEREST WAS C IN THE D1 VECTOR; C 2) WHAT THE INTERVAL OF INTEREST WAS C IN THE D2 VECTOR; C 3) HOW MANY OBSERVATIONS WERE DELETED; C 4) WHAT THE SAMPLE SIZE OF X WAS (N); C 5) WHAT THE SAMPLE SIZE OF Y WAS (NY); C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--THE INPUT VECTOR X IS NOT ALTERED C BY APPLICATION OF THIS SUBROUTINE. C THIS IS A MAJOR DISTINCTION C BETWEEN THIS SUBROUTINE AND, SAY, C THE SUBSET SUBROUTINE. C COMMENT--IN THE END, AFTER THIS SUBROUTINE HAS C MADE WHATEVER DELETIONS ARE APPROPRIATE, C THE OUTPUT VECTOR Y WILL BE 'PACKED'; C THAT IS, NO 'HOLES' WILL EXIST IN THE C VECTOR Y--ALL OF THE RETAINED ELEMENTS C OF Y WILL BE PACKED INTO THE FIRST AVAILABLE C LOCATIONS IN Y, WHILE THE REMAINDER C OF THE N LOCATIONS IN Y WILL BE ZERO-FILLED. C COMMENT--ALTHOUGH THERE C MAY BE A CORRESPONDANCE BETWEEN C THE ELEMENTS OF THE X AND D1 VECTORS C AND ELEMENTS OF THE X AND D2 VECTORS C BEFORE APPLICATION OF C THIS SUBROUTINE, THERE WILL C BE NO CORRESPONDANCE BETWEEN C Y AND D1, AND Y AND D2 C (DUE TO THE PACKING OF C THE RETAINED ELEMENTS IN Y) C AFTER APPLICATION OF THIS SUBROUTINE. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(1) DIMENSION D1(1) DIMENSION D2(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) 90 CONTINUE 9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE SUBSE2 SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 SUBSE2 SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE SUBSE2 SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C POIN1L=D1MIN POIN1U=D1MAX IF(D1MIN.GT.D1MAX)POIN1L=D1MAX IF(D1MIN.GT.D1MAX)POIN1U=D1MIN C POIN2L=D2MIN POIN2U=D2MAX IF(D2MIN.GT.D2MAX)POIN2L=D2MAX IF(D2MIN.GT.D2MAX)POIN2U=D2MIN K=0 DO100I=1,N IF(D1(I).LT.POIN1L.OR.D1(I).GT.POIN1U)GOTO100 IF(D2(I).LT.POIN2L.OR.D2(I).GT.POIN2U)GOTO100 K=K+1 Y(K)=X(I) 100 CONTINUE NY=K NDEL=N-NY C C WRITE OUT A BRIEF SUMMARY C WRITE(IPR,999) WRITE(IPR,101) WRITE(IPR,111)POIN1L,POIN1U WRITE(IPR,112)POIN2L,POIN2U WRITE(IPR,160) WRITE(IPR,161) WRITE(IPR,162) WRITE(IPR,163) WRITE(IPR,164) WRITE(IPR,165) WRITE(IPR,166) WRITE(IPR,185)N WRITE(IPR,190)NY WRITE(IPR,195)NDEL 101 FORMAT(1H ,35HOUTPUT FROM THE SUBSE2 SUBROUTINE--) 111 FORMAT(1H ,7X,26HD1 LIMITS (INCLUSIVE)-- ,E15.8,5H AND ,E15.8) 112 FORMAT(1H ,7X,26HD2 LIMITS (INCLUSIVE)-- ,E15.8,5H AND ,E15.8) 160 FORMAT(1H ,7X,28HONLY THOSE OBSERVATIONS IN X) 161 FORMAT(1H ,7X,27HWILL BE CARRIED OVER INTO Y) 162 FORMAT(1H ,7X,40HFOR WHICH THE CORRESPONDING ELEMENTS OF , 1 9HD1 AND D2) 163 FORMAT(1H ,7X,37HARE SIMULTANEOUSLY WITHIN (INCLUSIVE)) 164 FORMAT(1H ,7X,21HEACH SPECIFIED LIMIT.) 165 FORMAT(1H ,7X,40HNO OBSERVATIONS OUTSIDE OF THIS INTERVAL) 166 FORMAT(1H ,7X,30HHAVE BEEN CARRIED OVER INTO Y.) 185 FORMAT(1H ,7X,44HTHE INPUT NUMBER OF OBSERVATIONS (IN X) IS ,I6) 190 FORMAT(1H ,7X,44HTHE OUTPUT NUMBER OF OBSERVATIONS (IN Y) IS ,I6) 195 FORMAT(1H ,7X,44HTHE NUMBER OF OBSERVATIONS DELETED IS ,I6) 999 FORMAT(1H ) C RETURN END SUBROUTINE SUBSET(X,N,D,DMIN,DMAX,NEWN) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT SUBSET C C PURPOSE--THIS SUBROUTINE RETAINS ALL OBSERVATIONS IN THE C SINGLE PRECISION VECTOR X FOR WHICH THE C CORRESPONDING ELEMENTS IN THE C SINGLE PRECISION VECTOR D ARE INSIDE C THE CLOSED (INCLUSIVE) INTERVAL C DEFINED BY DMIN AND DMAX, C WHILE DELETING ALL OBSERVATIONS IN X C CORRESPONDING TO ELEMENTS OF D C OUTSIDE OF THIS INTERVAL. C THUS ALL OBSERVATIONS IN X WHICH C CORRESPOND TO ELEMENTS IN D WHICH ARE SMALLER C THAN DMIN OR LARGER THAN DMAX ARE DELETED FROM X. C THE USE OF THIS SUBROUTINE C GIVES THE DATA ANALYST THE CAPABILITY TO C EASILY EXTRACT SUBSETS OF THE DATA C PRIOR TO DATA ANALYSIS ON EACH SUBSET. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --D = THE SINGLE PRECISION VECTOR C WHICH 'DEFINES' THE VARIOUS C POSSIBLE SUBSETS OF X. C --DMIN = THE SINGLE PRECISION VALUE C WHICH DEFINES THE LOWER LIMIT C (INCLUSIVELY) OF THE PARTICULAR C SUBSET OF INTEREST TO BE RETAINED. C --DMAX = THE SINGLE PRECISION VALUE C WHICH DEFINES THE UPPER LIMIT C (INCLUSIVELY) OF THE PARTICULAR C SUBSET OF INTEREST TO BE RETAINED. C OUTPUT ARGUMENTS--NEWN = THE INTEGER NUMBER OF OBSERVATIONS C REMAINING (RETAINED) IN X AFTER ALL C OF THE OBSERVATIONS IN X C HAVE BEEN DELETED WHICH C CORRESPOND TO VALUES IN THE C VECTOR D OUTSIDE THE C INTERVAL OF INTEREST. C OUTPUT--THE SINGLE PRECISION VECTOR X C IN WHICH ONLY THOSE VALUES C HAVE BEEN RETAINED WHICH C CORRESPOND TO VALUES C IN THE D VECTOR INSIDE C (INCLUSIVELY) THE INTERVAL OF C INTEREST, AND C THE INTEGER VALUE NEWN C WHICH GIVES THE NUMBER OF C OBSERVATIONS RETAINED IN X. C ALSO, 12 LINES OF SUMMARY INFORMATION C WILL BE GENERATED INDICATING C 1) WHAT THE INTERVAL OF INTEREST WAS C IN THE D VECTOR; C 2) HOW MANY OBSERVATIONS WERE DELETED; C 3) WHAT THE OLD (ORIGINAL) SAMPLE SIZE WAS (N); C 4) WHAT THE NEW SAMPLE SIZE IS (NEWN). C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--IN THE END, AFTER THIS SUBROUTINE HAS C MADE WHATEVER DELETIONS ARE APPROPRIATE, C THE OUTPUT VECTOR X WILL BE 'PACKED'; C THAT IS, NO 'HOLES' WILL EXIST IN THE C VECTOR X--ALL OF THE RETAINED ELEMENTS C OF X WILL BE PACKED INTO THE FIRST AVAILABLE C LOCATIONS IN X, WHILE THE REMAINDER C OF THE N LOCATIONS IN X WILL BE ZERO-FILLED. C COMMENT--CAUTION IS TO BE EXERCISED IN C USING THIS SUBROUTINE FOR THE C FOLLOWING REASON--THE INPUT VECTOR X C IS IRREVOCABLY ALTERED BY APPLICATION C OF THIS SUBROUTINE. ALTHOUGH THERE C MAY BE A CORRESPONDANCE BETWEEN THE C ELEMENTS OF THE X AND D VECTORS C BEFORE APPLICATION OF C THIS SUBROUTINE, THERE WILL C BE NO CORRESPONDANCE BETWEEN C X AND D (DUE TO THE PACKING OF C THE RETAINED ELEMENTS OF X) C AFTER APPLICATION OF THIS SUBROUTINE. C TO SUCCESSIVELY EXTRACT EACH POSSIBLE C SUBSET OF X, IT IS C RECOMMENDED THAT THE C ANALYST USE THE SUBSA2 C SUBROUTINE WHICH LEAVES C THE ORIGINAL INPUT VECTOR X C UNALTERED AND OUTPUTS THE C RETAINED ELEMENTS IN A C SEPARATE SECOND VECTOR Y. C COMMENT--IN THE MAIN (CALLING) ROUTINE, IT IS C PERMISSABLE (IF THE ANALYST SO DESIRES) C TO USE THE SAME VARIABLE NAME C IN THE SIXTH ARGUMENT AS USED IN THE SECOND C ARGUMENT IN THE CALLING SEQUENCE TO THIS C SUBSET SUBROUTINE--NO CONFLICT WILL RESULT C IN THE INTERNAL OPERATION OF THE SUBSET C SUBROUTINE. FOR EXAMPLE, IT IS PERMISSIBLE C TO HAVE CALL SUBSET(X,N,D,0.5,1.5,N) C IN WHICH THE VARIABLE NAME N IS USED C AS BOTH THE SECOND AND SIXTH ARGUMENTS. C COMMENT--THIS IS ONE OF THE FEW SUBROUTINES IN DATAPAC C IN WHICH THE INPUT VECTOR X IS ALTERED. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION D(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) 90 CONTINUE 9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE SUBSET SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 SUBSET SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE SUBSET SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C POINTL=DMIN POINTU=DMAX IF(DMIN.GT.DMAX)POINTL=DMAX IF(DMIN.GT.DMAX)POINTU=DMIN C NOLD=N K=0 DO100I=1,NOLD IF(D(I).LT.POINTL.OR.D(I).GT.POINTU)GOTO100 K=K+1 X(K)=X(I) 100 CONTINUE NEWN=K NDEL=NOLD-NEWN C NEWNP1=NEWN+1 IF(NEWNP1.GT.NOLD)GOTO250 DO200I=NEWNP1,NOLD X(I)=0.0 200 CONTINUE 250 CONTINUE C C WRITE OUT A BRIEF SUMMARY C WRITE(IPR,999) WRITE(IPR,101) WRITE(IPR,105)POINTL,POINTU WRITE(IPR,110) WRITE(IPR,111) WRITE(IPR,112) WRITE(IPR,113) WRITE(IPR,114) WRITE(IPR,115) WRITE(IPR,116) WRITE(IPR,120)NOLD WRITE(IPR,125)NEWN WRITE(IPR,130)NDEL 101 FORMAT(1H ,35HOUTPUT FROM THE SUBSET SUBROUTINE--) 105 FORMAT(1H ,7X,26HD LIMITS (INCLUSIVE)-- ,E15.8,5H AND ,E15.8) 110 FORMAT(1H ,7X,28HONLY THOSE OBSERVATIONS IN X) 111 FORMAT(1H ,7X,16HWILL BE RETAINED) 112 FORMAT(1H ,7X,40HFOR WHICH THECORRESPONDING ELEMENTS OF D) 113 FORMAT(1H ,7X,22HARE WITHIN (INCLUSIVE)) 114 FORMAT(1H ,7X,21HTHE SPECIFIED LIMITS.) 115 FORMAT(1H ,7X,41HALL OBSERVATIONS OUTSIDE OF THIS INTERVAL) 116 FORMAT(1H ,7X,23HHAVE BEEN DELETED IN X.) 120 FORMAT(1H ,7X,44HTHE INPUT NUMBER OF OBSERVATIONS (IN X) IS ,I6) 125 FORMAT(1H ,7X,44HTHE OUTPUT NUMBER OF OBSERVATIONS (IN X) IS ,I6) 130 FORMAT(1H ,7X,44HTHE NUMBER OF OBSERVATIONS DELETED IS ,I6) 999 FORMAT(1H ) C RETURN END SUBROUTINE TAIL(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT TAIL C C PURPOSE--THIS SUBROUTINE PERFOMS A SYMMETRIC DISTRIBUTION C TAIL LENGTH ANALYSIS C ON THE DATA IN THE INPUT VECTOR X. C THE ANALYSIS CONSISTS OF THE FOLLOWING-- C 1) VARIOUS TEST STATISTICS TO TEST C THE SPECIFIC HYPOTHESIS OF NORMALITY; C 2) A UNIFORM PROBABILITY PLOT C (A SHORT-TAILED DISTRIBUTION); C 3) A NORMAL PROBAIBLITY PLOT C (A MODERATE-TAILED DISTRIBUTION); C 4) A TUKEY LAMBDA = -0.5 PROBABILTY PLOT C (A MODERATE-LONG-TAILED DISTRIBTION); C 5) A CAUCHY PROBABILITY PLOT C (A LONG-TAILED DISTRIBUTION); C 6) A DETERMINATION OF THE BEST-FIT C SYMMETRIC DISTRIBUTION C TO THE DATA SET FROM AN C ADMISSABLE SET CONSISTING OF C 43 SYMMETRIC DISTRIBUTIONS. C THE ADMISSABLE SET OF SYMMETRIC C DISTRIBUTIONS CONSIDERED INCLUDES THE C UNIFORM, NORMAL, LOGISTIC, C DOUBLE EXPONENTIAL, CAUCHY, AND C 37 DISTRIBUTIONS DRAWN FROM THE C THE TUKEY LAMBDA DISTRIBUTIONAL FAMILY. C THE GOODNESS OF FIT CRITERION IS THE MAXIMUM PROBABILITY C PLOT CORRELATION COEFFICIENT CRITERION. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--6 PAGES OF AUTOMATIC PRINTOUT-- C 1) VARIOUS TEST STATISTICS FOR NORMALITY; C 2) A UNIFORM PROBABILITY PLOT; C 3) A NORMAL PROBAIBLITY PLOT; C 4) A TUKEY LAMBDA = -0.5 PROBABILTY PLOT; C 5) A CAUCHY PROBABILITY PLOT; C 6) A DETERMINATION OF THE BEST-FIT C SYMMETRIC DISTRIBUTION C TO THE DATA SET. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 3000. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, NORPPF, PLOT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ALOG, ALOG10, EXP, C SIN, COS, ATAN. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCE--FILLIBEN (1972), 'TECHNIQUES FOR TAIL LENGTH C ANALYSIS', PROCEEDINGS OF THE EIGHTEENTH C CONFERENCE ON THE DESIGN OF EXPERIMENTS IN C ARMY RESEARCH AND TESTING, PAGES 425-450. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C UNPUBLISHED MANUSCRIPT. C --JOHNSON AND KOTZ (1970), CONTINUOUS UNIVARIATE C DISTRIBUTIONS-1, PAGES 250-271. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C CHARACTER*4 IFLAG1 CHARACTER*4 IFLAG2 CHARACTER*4 IFLAG3 CHARACTER*4 ILINE1 CHARACTER*4 ILINE2 C CHARACTER*4 ALPHAM CHARACTER*4 ALPHAA CHARACTER*4 BLANK CHARACTER*4 HYPHEN CHARACTER*4 ALPHAI CHARACTER*4 ALPHAX C DIMENSION X(*) DIMENSION Y(3000),Z(3000),YM(3000) DIMENSION P(3000),PTENTH(3000) DIMENSION CORR(50),IFLAG1(50),IFLAG2(50),IFLAG3(50) DIMENSION ILINE1(130),ILINE2(130) DIMENSION XLINE(13) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(Z(1),WS(3001)),(YM(1),WS(6001)) EQUIVALENCE (P(1),WS(9001)),(PTENTH(1),WS(12001)) C DATA ALPHAM,ALPHAA/'M','A'/ DATA BLANK,HYPHEN,ALPHAI,ALPHAX/' ','-','I','X'/ DATA PICONS/3.14159265358979/ DATA CONSTN/.3989422804/ C IPR=6 IUPPER=3000 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD RETURN 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE TAIL SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 TAIL SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE TAIL SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C COMPUTE THE SAMPLE MEAN C SUM=0.0 DO100I=1,N SUM=SUM+X(I) 100 CONTINUE XBAR=SUM/AN C C COMPUTE S, BIASED S, B1, AND B2 C SUM2=0.0 SUM3=0.0 SUM4=0.0 DO200I=1,N DEL=X(I)-XBAR A2=DEL*DEL A3=DEL*A2 A4=A2*A2 SUM2=SUM2+A2 SUM3=SUM3+A3 SUM4=SUM4+A4 200 CONTINUE AM2=SUM2/AN AM3=SUM3/AN AM4=SUM4/AN S=SQRT(SUM2/(AN-1.0)) BS=SQRT(AM2) B1=AM3/(BS**3) B2=AM4/(BS**4) C C COMPUTE THE EXPECTED VALUE AND STANDARD DEVIATION OF B1 AND B2 C UNDER THE NORMALITY ASSUMPTION C REFERENCE--CRAMER, PAGE 386 C EB1=0.0 SDB1=6.0*(AN-2.0)/((AN+1.0)*(AN+3.0)) SDB1=SQRT(SDB1) ZB1=(B1-EB1)/SDB1 EB2=3.0-6.0/(AN+1.0) SDB2=24.0*AN*(AN-2.0)*(AN-3.0)/((AN+1.0)*(AN+1.0)*(AN+3.0)*(AN+5.0 1)) ZB2=(B2-EB2)/SDB2 C C COMPUTE GEARY'S STATISTIC C SUM=0.0 DO300I=1,N SUM=SUM+ABS(X(I)-XBAR) 300 CONTINUE EANDEV=SUM/AN GEARY=EANDEV/BS C C COMPUTE THE EXPECTED VALUE AND STANDARD DEVIATION C OF GEARY'S STATISTIC UNDER THE NORMALITY ASSUMPTION C REFERENCE--BIOMETRIKA, 1936, PAGE 296 C AA=SQRT(2.0/PICONS) BB=SQRT(2.0/(AN-1.0)) IF(N.GE.100)CC=SQRT(AN/2.0)*(1.0-(1.0/(8.0*AN/2.0))+(1.0/(128.0*AN 1*AN/4.0))) IF(N.GE.100)GOTO350 COEF=1.0 IMAX=N-1 IEVODD=N-2*(N/2) IMIN=2 IF(IEVODD.EQ.0)IMIN=3 IF(IMIN.GT.IMAX)GOTO310 DO320I=IMIN,IMAX,2 AI=I COEF=((AI-1.0)/AI)*COEF 320 CONTINUE 310 COEF=COEF*(AN-1.0) IF(IEVODD.EQ.0)GOTO330 COEF=COEF*(SQRT(PICONS)/2.0) GOTO340 330 COEF=COEF/SQRT(PICONS) 340 CC=COEF 350 EGEARY=AA/(BB*CC) DD=(2.0/PICONS)*SQRT(AN*(AN-2.0)) ARG=1.0/(AN-1.0) ARG=ARG/SQRT(1.0-ARG*ARG) EE=ATAN(ARG) SDGEAR=(1.0/AN)*(1.0+DD+EE) SDGEAR=SDGEAR-EGEARY*EGEARY SDGEAR=SQRT(SDGEAR) ZGEARY=(GEARY-EGEARY)/SDGEAR C C SORT THE DATA, C THEN COMPUTE RANGE/S. C CALL SORT(X,N,Y) RS=(Y(N)-Y(1))/S C C COMPUTE THE EXPECTED VALUE AND STANDARD DEVIATION OF THE RANGE/S C UNDER THE NORMALITY ASSUMPTION C REFERENCE--BIOMETRIKA, 1954, PAGE 483 C G=.33000598+((AN-2.0)**.16)/41.785 PN=(AN-G)/(AN-2.0*G+1.0) P1=1.0-PN CALL NORPPF(PN,RPN) CALL NORPPF(P1,RP1) EXN=RPN EX1=RP1 ER=EXN-EX1 CALL NORPPF(P1,PPFNOR) SFP1=1.0/(CONSTN*EXP(-(PPFNOR*PPFNOR)/2.0)) CALL NORPPF(PN,PPFNOR) SFPN=1.0/(CONSTN*EXP(-(PPFNOR*PPFNOR)/2.0)) VARXN=PN*(1.0-PN)*SFPN*SFPN/(AN+2.0) EXNSQ=VARXN+EXN*EXN COX1XN=P1*P1*SFP1*SFPN/(AN+2.0) EX1XN=COX1XN+EX1*EXN ERSQ=2.0*(EXNSQ-EX1XN) ES=BB*CC ESSQ=1.0 ERS=ER/ES ERSSQ=ERSQ/ESSQ VARRS=ERSSQ-ERS*ERS SDRS=SQRT(VARRS) ZRS=(RS-ERS)/SDRS C C COMPUTE THE WILK-SHAPIRO STATISTIC C AL=ALOG10(AN) GAMMA=.327511+.058212*AL-.009776*AL*AL SUM=0.0 IF(N.LE.20)ARG=N IF(N.GT.20)ARG=N+1 ASUBN=SQRT((1.0+(1.0/(4.0*ARG)))/SQRT(ARG)) ASUB1=-ASUBN SUM=SUM+ASUB1*Y(1)+ASUBN*Y(N) IF(N.LE.2)GOTO510 NM1=N-1 DO500I=2,NM1 AI=I PI=(AI-GAMMA)/(AN-2.0*GAMMA+1.0) CALL NORPPF(PI,EI) COEFI =2.0*EI /SQRT(-2.722+4.083*AN) SUM=SUM+COEFI*Y(I) 500 CONTINUE 510 WILKSH=SUM*SUM/(AN*BS*BS) C C COMPUTE THE EXPECTED VALUE AND STANDARD DEVIATION OF THE WILK-SHAPIRO C STATISTIC UNDER THE NORMALITY ASSUMPTION C REFERENCE--JJF APPROXIMATION TO MOMENTS ON PAGE 601 OF BIOMETRIKA (1965) C IF(N.EQ.3)EWILKS=.9135 IF(N.EQ.4)EWILKS=.9012 IF(N.GE.5)EWILKS=.9026+(AN-5.0)/(44.608+13.593*SQRT(AN)+10.267*AN) IF(N.EQ.3)SDWILK=.0755 IF(N.EQ.4)SDWILK=.0719 IF(N.GE.5)SDWILK=.0670+(AN-5.0)/(-42.368-5.026*SQRT(AN)-14.925*AN) ZWILKS=(WILKSH-EWILKS)/SDWILK C C COMPUTE THE CORRELATION COEFFICIENT BETWEEN THE ORDERED OBSERVATIONS C AND THE ORDER STATISIC MEDIANS FROM 44 DIFFERENT SYMMETRIC DISTRIBUTIONS C NUMDIS=44 NHALF=N/2 NHALFP=NHALF+1 IEVODD=N-2*(N/2) CALL UNIMED(N,Z) DO950I=1,N PTENTH(I)=Z(I)**(0.1) 950 CONTINUE DO1000IDIS=1,NUMDIS IF(IDIS.EQ.20)GOTO1199 IF(IDIS.EQ.22)GOTO1299 IF(IDIS.EQ.23)GOTO1399 IF(IDIS.EQ.33)GOTO1499 IF(IDIS.LT.20)IDIS2=IDIS IF(IDIS.EQ.21)IDIS2=IDIS-1 IF(23.LT.IDIS.AND.IDIS.LT.33)IDIS2=IDIS-2 IF(33.LT.IDIS)IDIS2=IDIS-3 ALAMBA=-(0.1)*FLOAT(IDIS2)+2.1 IF(IDIS.EQ. 1)GOTO1009 IF(IDIS.EQ.11)GOTO1019 IF(IDIS.EQ.24)GOTO1029 IF(IDIS.EQ.34)GOTO1039 IF(IDIS.EQ.44)GOTO1049 GOTO1059 1009 DO1010I=1,NHALF IREV=N-I+1 P(I)=Z(I)*Z(I) P(IREV)=Z(IREV)*Z(IREV) YM(I)=(P(I)-P(IREV))/ALAMBA YM(IREV)=-YM(I) 1010 CONTINUE IF(IEVODD.EQ.1)YM(NHALFP)=0.0 GOTO1999 1019 DO1020I=1,NHALF IREV=N-I+1 P(I)=Z(I) P(IREV)=Z(IREV) YM(I)=(P(I)-P(IREV))/ALAMBA YM(IREV)=-YM(I) 1020 CONTINUE IF(IEVODD.EQ.1)YM(NHALFP)=0.0 GOTO1999 1029 DO1030I=1,NHALF IREV=N-I+1 P(I)=Z(I)**(-0.1) P(IREV)=Z(IREV)**(-0.1) YM(I)=(P(I)-P(IREV))/ALAMBA YM(IREV)=-YM(I) 1030 CONTINUE IF(IEVODD.EQ.1)YM(NHALFP)=0.0 GOTO1999 1039 DO1040I=1,NHALF P(IREV)=1.0/Z(IREV) P(I)=1.0/Z(I) IREV=N-I+1 YM(I)=(P(I)-P(IREV))/ALAMBA YM(IREV)=-YM(I) 1040 CONTINUE IF(IEVODD.EQ.1)YM(NHALFP)=0.0 GOTO1999 1049 DO1050I=1,NHALF IREV=N-I+1 P(I)=1.0/(Z(I)*Z(I)) P(IREV)=1.0/(Z(IREV)*Z(IREV)) YM(I)=(P(I)-P(IREV))/ALAMBA YM(IREV)=-YM(I) 1050 CONTINUE IF(IEVODD.EQ.1)YM(NHALFP)=0.0 GOTO1999 1059 DO1060I=1,NHALF IREV=N-I+1 P(I)=P(I)/PTENTH(I) P(IREV)=P(IREV)/PTENTH(IREV) YM(I)=(P(I)-P(IREV))/ALAMBA YM(IREV)=-YM(I) 1060 CONTINUE IF(IEVODD.EQ.1)YM(NHALFP)=0.0 GOTO1999 1199 DO1200I=1,NHALF IREV=N-I+1 CALL NORPPF(Z(I),YM(I)) YM(IREV)=-YM(I) 1200 CONTINUE IF(IEVODD.EQ.1)YM(NHALFP)=0.0 GOTO1999 1299 DO1300I=1,NHALF IREV=N-I+1 YM(I)=ALOG(Z(I)/(1.0-Z(I))) YM(IREV)=-YM(I) 1300 CONTINUE IF(IEVODD.EQ.1)YM(NHALFP)=0.0 GOTO1999 1399 DO1400I=1,NHALF IREV=N-I+1 IF(Z(I).LE.0.5)YM(I)=ALOG(2.0*Z(I)) IF(Z(I).GT.0.5)YM(I)=-ALOG(2.0*(1.0-Z(I))) YM(IREV)=-YM(I) 1400 CONTINUE IF(IEVODD.EQ.1)YM(NHALFP)=0.0 GOTO1999 1499 DO1500I=1,NHALF IREV=N-I+1 ARG=PICONS*Z(I) YM(I)=-COS(ARG)/SIN(ARG) YM(IREV)=-YM(I) 1500 CONTINUE IF(IEVODD.EQ.1)YM(NHALFP)=0.0 1999 SUM1=0.0 SUM2=0.0 DO2100I=1,N SUM1=SUM1+Y(I)*YM(I) SUM2=SUM2+YM(I)*YM(I) 2100 CONTINUE SUM2=SQRT(SUM2) SUM3=S*SQRT(AN-1.0) CORR(IDIS)=SUM1/(SUM2*SUM3) 1000 CONTINUE C C DETERMINE THAT DISTRIBUTION WITH THE MAXIMUM PROB PLOT CORR COEFFICIENT C IDISMX=1 CORRMX=CORR(1) DO2200IDIS=1,NUMDIS IF(CORR(IDIS).GT.CORRMX)IDISMX=IDIS IF(CORR(IDIS).GT.CORRMX)CORRMX=CORR(IDIS) 2200 CONTINUE DO2300IDIS=1,NUMDIS IFLAG1(IDIS)=BLANK IFLAG2(IDIS)=BLANK IFLAG3(IDIS)=BLANK IF(IDIS.EQ.IDISMX)GOTO2350 GOTO2300 2350 IFLAG1(IDIS)=ALPHAM IFLAG2(IDIS)=ALPHAA IFLAG3(IDIS)=ALPHAX 2300 CONTINUE CC=CORR(20) C C COMPUTE THE EXPECTED VALUE AND STANDARD DEVIATION OF THE PROBABILITY PLOT C CORRELATION COEFFICIENT UNDER THE NORMALITY ASSUMPTION C REFERENCE--JJF UNPUBLISHED MANUSCRIPT C IF(N.EQ.2)ECC=1.0 IF(N.EQ.3)ECC=.95492958 IF(N.GE.4)ECC=.94947355+(AN-4.0)/(196.815-2.9418*SQRT(AN)+19.7916* 1AN) IF(N.EQ.2)SDCC=99999999.9999 IF(N.EQ.3)SDCC=.04007697 IF(N.GE.4)SDCC=.039492+(AN-4.0)/(-127.0-25.3*AN) ZCC=(CC-ECC)/SDCC C C WRITE OUT THE NORMAL TAIL LENGTH STATISTICS PAGE C WRITE(IPR,998) WRITE(IPR,810) WRITE(IPR,999) WRITE(IPR,821)N WRITE(IPR,822)XBAR WRITE(IPR,823)S WRITE(IPR,999) WRITE(IPR,830) WRITE(IPR,831) WRITE(IPR,832) WRITE(IPR,833) WRITE(IPR,834) DO840I=1,6 WRITE(IPR,999) 840 CONTINUE WRITE(IPR,850) WRITE(IPR,851) WRITE(IPR,999) WRITE(IPR,999) WRITE(IPR,860) WRITE(IPR,999) WRITE(IPR,871)B1,EB1,SDB1,ZB1 WRITE(IPR,872) WRITE(IPR,873)B2,EB2,SDB2,ZB2 WRITE(IPR,874) WRITE(IPR,875)GEARY,EGEARY,SDGEAR,ZGEARY WRITE(IPR,876) WRITE(IPR,877)RS,ERS,SDRS,ZRS WRITE(IPR,878) WRITE(IPR,879)WILKSH,EWILKS,SDWILK,ZWILKS WRITE(IPR,880) WRITE(IPR,881)CC,ECC,SDCC,ZCC WRITE(IPR,882) C C COMPUTE THE LINE PLOT WHICH SHOWS THE DISTRIBUTION OF THE OBSERVED C VALUES IN TERMS OF MULTIPLES OF SAMPLE STANDARD DEVIATIONS AWAY FROM C THE SAMPLE MEAN C DO 900I=1,130 ILINE1(I)=BLANK ILINE2(I)=BLANK 900 CONTINUE ICOUNT=0 DO920I=1,N MX=10.0*(((X(I)-XBAR)/S)+6.0)+0.5 MX=MX+7 IF(MX.LT. 7.OR.MX.GT.127)ICOUNT=ICOUNT+1 IF(MX.LT. 7.OR.MX.GT.127)GOTO920 ILINE1(MX)=ALPHAX 920 CONTINUE DO940I=7,127 ILINE2(I)=HYPHEN 940 CONTINUE DO960I=7,127,10 ILINE2(I)=ALPHAI 960 CONTINUE XLINE(7)=XBAR DO3315I=1,6 IREV=13-I+1 AI=I XLINE(I)=XBAR-(7.0-AI)*S XLINE(IREV)=XBAR+(7.0-AI)*S 3315 CONTINUE C C WRITE OUT THE LINE PLOT SHOWING THE DEVIATIONS OF THE OBSERVATIONS C ABOUT THE SAMPLE MEAN IN TERMS OF MULTIPLES OF THE SAMPLE STANDARD C DEVIATION C DO3305I=1,8 3305 WRITE(IPR,999) WRITE(IPR,3310) WRITE(IPR,999) WRITE(IPR,999) WRITE(IPR,3321)(ILINE1(I),I=1,130) WRITE(IPR,3321)(ILINE2(I),I=1,130) WRITE(IPR,3323) WRITE(IPR,3326)(XLINE(I),I=1,13) WRITE(IPR,999) WRITE(IPR,3324)ICOUNT C C GENERATE UNIFORM, NORMAL, LAMBDA = -0.5, AND CAUCHY PROBABILITY PLOTS C NHALF=(N/2)+1 CALL PLOT(Y,Z ,N) WRITE(IPR,3501)N WRITE(IPR,3510)CORR(11) DO4100I=1,NHALF IREV=N-I+1 CALL NORPPF(Z(I),YM(I)) YM(IREV)=-YM(I) 4100 CONTINUE CALL PLOT(Y,YM,N) WRITE(IPR,3502)N WRITE(IPR,3510)CORR(20) ALAMBA=-0.5 DO4200I=1,NHALF IREV=N-I+1 Q=Z(I) YM(I)=(Q**ALAMBA-(1.0-Q)**ALAMBA)/ALAMBA YM(IREV)=-YM(I) 4200 CONTINUE CALL PLOT(Y,YM,N) WRITE(IPR,3503)ALAMBA,N WRITE(IPR,3510)CORR(28) DO4300I=1,NHALF IREV=N-I+1 ARG=PICONS*Z(I) YM(I)=-COS(ARG)/SIN(ARG) YM(IREV)=-YM(I) 4300 CONTINUE CALL PLOT(Y,YM,N) WRITE(IPR,3504)N WRITE(IPR,3510)CORR(33) C C WRITE OUT THE PROBABILITY PLOT CORRELATION COEFFICIENT PAGE C WRITE(IPR,998) DO2400IDIS=1,NUMDIS IF(IDIS.EQ.20)GOTO2110 IF(IDIS.EQ.22)GOTO2120 IF(IDIS.EQ.23)GOTO2130 IF(IDIS.EQ.33)GOTO2140 IF(IDIS.LT.20)IDIS2=IDIS IF(IDIS.EQ.21)IDIS2=IDIS-1 IF(23.LT.IDIS.AND.IDIS.LT.33)IDIS2=IDIS-2 IF(33.LT.IDIS)IDIS2=IDIS-3 ALAMBA=-(0.1)*FLOAT(IDIS2)+2.1 WRITE(IPR,2105)N,ALAMBA,CORR(IDIS),IFLAG1(IDIS),IFLAG2(IDIS), 1IFLAG3(IDIS) GOTO2400 2110 WRITE(IPR,2115)N,CORR(IDIS),IFLAG1(IDIS),IFLAG2(IDIS),IFLAG3(IDIS) GOTO2400 2120 WRITE(IPR,2125)N,CORR(IDIS),IFLAG1(IDIS),IFLAG2(IDIS),IFLAG3(IDIS) GOTO2400 2130 WRITE(IPR,2135)N,CORR(IDIS),IFLAG1(IDIS),IFLAG2(IDIS),IFLAG3(IDIS) GOTO2400 2140 WRITE(IPR,2145)N,CORR(IDIS),IFLAG1(IDIS),IFLAG2(IDIS),IFLAG3(IDIS) 2400 CONTINUE C 810 FORMAT(1H ,48X,20HTAIL LENGTH ANALYSIS) 821 FORMAT(1H ,46X,21H(THE SAMPLE SIZE N = ,I5,1H)) 822 FORMAT(1H ,40X,19H(THE SAMPLE MEAN = ,E15.8,1H)) 823 FORMAT(1H ,35X,33H(THE SAMPLE STANDARD DEVIATION = ,E15.8,1H)) 830 FORMAT(1H ,35X,63HREFERENCE--SHAPIRO, WILK, AND CHEN, JASA, 1968, 1PAGES 1343-1372) 831 FORMAT(1H ,35X,32HREFERENCE--CRAMER, PAGES 386-387) 832 FORMAT(1H ,35X,49HREFERENCE--GEARY, BIOMETRIKA, 1947, PAGES 209-24 12) 833 FORMAT(1H ,35X,76HREFERENCE--BIOMETRIKA TABLES, VOLUME 1, PAGES 67 1-69, 59-60, 207-208, AND 200) 834 FORMAT(1H ,35X,60HREFERENCE--SHAPIRO AND WILK, BIOMETRIKA, 1965, P 1AGES 591-611) 850 FORMAT(1H ,49X,22HTAIL LENGTH STATISTICS) 851 FORMAT(1H ,5X,106HTHE EXPECTED VALUE AND STANDARD DEVIATION OF STA 1TISTICS ON THIS PAGE ARE BASED ON THE NORMALITY ASSUMPTION) 860 FORMAT(1H ,128H FORM OF STATISTIC VALUE OF 1STAT EXP(STAT) SD(STAT) (STAT-EXP(STAT))/SD(STAT) TABL 1E REFERENCE) 871 FORMAT(1H ,41HSTANDARDIZED THIRD CENTRAL MOMENT , F10.5, 16X,F10.5,2X,F10.5,9X,F10.5,13X,17HBIOMETRIKA TABLES) 872 FORMAT(1H ,111X,16HVOL. 1, PAGE 207) 873 FORMAT(1H ,41HSTANDARDIZED FOURTH CENTRAL MOMENT , F10.5, 16X,F10.5,2X,F10.5,9X,F10.5,13X,17HBIOMETRIKA TABLES) 874 FORMAT(1H ,111X,16HVOL. 1, PAGE 208) 875 FORMAT(1H ,41HGEARY STATISTIC (MEAN DEVIATION/S) , F10.5, 16X,F10.5,2X,F10.5,9X,F10.5,13X,17HBIOMETRIKA TABLES) 876 FORMAT(1H ,111X,16HVOL. 1, PAGE 207) 877 FORMAT(1H ,41HRANGE/S , F10.5, 16X,F10.5,2X,F10.5,9X,F10.5,13X,17HBIOMETRIKA TABLES) 878 FORMAT(1H ,111X,16HVOL. 1, PAGE 200) 879 FORMAT(1H ,41HWILK-SHAPIRO STATISTIC (BLUE FOR SCALE/S), F10.5, 16X,F10.5,2X,F10.5,9X,F10.5,13X,17HBIOMETRIKA (1965)) 880 FORMAT(1H ,111X,8HPAGE 605) 881 FORMAT(1H ,41HPROBABILITY PLOT CORRELATION COEFFICIENT , F10.5, 16X,F10.5,2X,F10.5,9X,F10.5,13X,15HUNPUBLISHED JJF) 882 FORMAT(1H ,111X,10HMANUSCRIPT) 2105 FORMAT(1H ,28HTHE CORRELATION BETWEEN THE ,I6,60H ORDERED OBS. AND 1 THE ORDER STAT. MEDIANS FROM THE LAMBDA = ,F4.1,10H DIST. IS ,F8. 15,1X,3A1) 2115 FORMAT(1H ,28HTHE CORRELATION BETWEEN THE ,I6,74H ORDERED OBS. AND 1 THE ORDER STAT. MEDIANS FROM THE NORMAL DISTRIBUTION IS ,F8.5,1X, 13A1) 2125 FORMAT(1H ,28HTHE CORRELATION BETWEEN THE ,I6,74H ORDERED OBS. AND 1 THE ORDER STAT. MEDIANS FROM THE LOGISTIC DIST. IS ,F8.5,1X, 13A1) 2135 FORMAT(1H ,28HTHE CORRELATION BETWEEN THE ,I6,74H ORDERED OBS. AND 1 THE ORDER STAT. MEDIANS FROM THE DOUBLE EXP. DIST. IS ,F8.5,1X, 13A1) 2145 FORMAT(1H ,28HTHE CORRELATION BETWEEN THE ,I6,74H ORDERED OBS. AND 1 THE ORDER STAT. MEDIANS FROM THE CAUCHY DISTRIBUTION IS ,F8.5,1X, 13A1) 3310 FORMAT(1H ,131HLINE PLOT SHOWING THE DISTRIBUTION OF THE OBSERVATI 1ONS ABOUT THE SAMPLE MEAN IN TERMS OF MULTIPLES OF THE SAMPLE STAN 1DARD DEVIATION) 3321 FORMAT(1H ,130A1) 3323 FORMAT(1H , 127H -6 -5 -4 -3 -2 1 -1 0 1 2 3 4 1 5 6) 3324 FORMAT(1H ,10X,I5,105H OBSERVATIONS WERE IN EXCESS OF 6 SAMPLE STA 1NDARD DEVIATIONS FROM THE SAMPLE MEAN AND SO WERE NOT PLOTTED) 3326 FORMAT(1H ,13F10.4) 3501 FORMAT(1H ,35X,47HUNIFORM PROBABILITY PLOT (THE SAMPLE SIZE N = , 1I5,1H)) 3502 FORMAT(1H ,35X,46HNORMAL PROBABILITY PLOT (THE SAMPLE SIZE N = ,I 15,1H)) 3503 FORMAT(1H ,35X,9HLAMBDA = ,F4.1,40H PROBABILITY PLOT (THE SAMPLE 1SIZE N = ,I5,1H)) 3504 FORMAT(1H ,35X,46HCAUCHY PROBABILITY PLOT (THE SAMPLE SIZE N = ,I 15,1H)) 3510 FORMAT(1H , 34X,44H(PROBABILITY PLOT CORRELATION COEFFICIENT = ,F8 1.5,1H)) 998 FORMAT(1H1) 999 FORMAT(1H ) C RETURN END SUBROUTINE TCDF(X,NU,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT TCDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR STUDENT'S T DISTRIBUTION C WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU. C THIS DISTRIBUTION IS DEFINED FOR ALL X. C THE PROBABILITY DENSITY FUNCTION IS GIVEN C IN THE REFERENCES BELOW. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C X SHOULD BE NON-NEGATIVE. C --NU = THE INTEGER NUMBER OF DEGREES C OF FREEDOM. C NU SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF FOR THE STUDENT'S T DISTRIBUTION C WITH DEGREES OF FREEDOM PARAMETER = NU. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--NU SHOULD BE A POSITIVE INTEGER VARIABLE. C OTHER DATAPAC SUBROUTINES NEEDED--NORCDF. C FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DATAN. C MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--NATIONAL BUREAU OF STANDARDS APPLIED MATHMATICS C SERIES 55, 1964, PAGE 948, FORMULAE 26.7.3 AND 26.7.4. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 94-129. C --FEDERIGHI, EXTENDED TABLES OF THE C PERCENTAGE POINTS OF STUDENT'S C T-DISTRIBUTION, JOURNAL OF THE C AMERICAN STATISTICAL ASSOCIATION, C 1959, PAGES 683-688. C --OWEN, HANDBOOK OF STATISTICAL TABLES, C 1962, PAGES 27-30. C --PEARSON AND HARTLEY, BIOMETRIKA TABLES C FOR STATISTICIANS, VOLUME 1, 1954, C PAGES 132-134. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --MAY 1974. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --OCTOBER 1976. C C--------------------------------------------------------------------- C DOUBLE PRECISION DX,DNU,PI,C,CSQ,S,SUM,TERM,AI DOUBLE PRECISION DSQRT,DATAN DOUBLE PRECISION DCONST DOUBLE PRECISION TERM1,TERM2,TERM3 DOUBLE PRECISION DCDFN DOUBLE PRECISION DCDF DOUBLE PRECISION B11 DOUBLE PRECISION B21,B22,B23,B24,B25 DOUBLE PRECISION B31,B32,B33,B34,B35,B36,B37 DOUBLE PRECISION D1,D3,D5,D7,D9,D11 DATA NUCUT/1000/ DATA PI/3.14159265358979D0/ DATA DCONST/0.3989422804D0/ DATA B11/0.25D0/ DATA B21/0.01041666666667D0/ DATA B22,B23,B24,B25/3.0D0,-7.0D0,-5.0D0,-3.0D0/ DATA B31/0.00260416666667D0/ DATA B32,B33,B34,B35,B36,B37/1.0D0,-11.0D0,14.0D0,6.0D0, 1 -3.0D0,-15.0D0/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(NU.LE.0)GOTO50 GOTO90 50 WRITE(IPR,15) WRITE(IPR,47)NU CDF=0.0 RETURN 90 CONTINUE 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 TCDF SUBROUTINE IS NON-POSITIVE *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C DX=X ANU=NU DNU=NU C C IF NU IS 3 THROUGH 9 AND X IS MORE THAN 3000 C STANDARD DEVIATIONS BELOW THE MEAN, C SET CDF = 0.0 AND RETURN. C IF NU IS 10 OR LARGER AND X IS MORE THAN 150 C STANDARD DEVIATIONS BELOW THE MEAN, C SET CDF = 0.0 AND RETURN. C IF NU IS 3 THROUGH 9 AND X IS MORE THAN 3000 C STANDARD DEVIATIONS ABOVE THE MEAN, C SET CDF = 1.0 AND RETURN. C IF NU IS 10 OR LARGER AND X IS MORE THAN 150 C STANDARD DEVIATIONS ABOVE THE MEAN, C SET CDF = 1.0 AND RETURN. C IF(NU.LE.2)GOTO109 SD=SQRT(ANU/(ANU-2.0)) Z=X/SD IF(NU.LT.10.AND.Z.LT.-3000.0)GOTO107 IF(NU.GE.10.AND.Z.LT.-150.0)GOTO107 IF(NU.LT.10.AND.Z.GT.3000.0)GOTO108 IF(NU.GE.10.AND.Z.GT.150.0)GOTO108 GOTO109 107 CDF=0.0 RETURN 108 CDF=1.0 RETURN 109 CONTINUE C C DISTINGUISH BETWEEN THE SMALL AND MODERATE C DEGREES OF FREEDOM CASE VERSUS THE C LARGE DEGREES OF FREEDOM CASE C IF(NU.LT.NUCUT)GOTO110 GOTO250 C C TREAT THE SMALL AND MODERATE DEGREES OF FREEDOM CASE C METHOD UTILIZED--EXACT FINITE SUM C (SEE AMS 55, PAGE 948, FORMULAE 26.7.3 AND 26.7.4). C 110 CONTINUE C=DSQRT(DNU/(DX*DX+DNU)) CSQ=DNU/(DX*DX+DNU) S=DX/DSQRT(DX*DX+DNU) IMAX=NU-2 IEVODD=NU-2*(NU/2) IF(IEVODD.EQ.0)GOTO120 C SUM=C IF(NU.EQ.1)SUM=0.0D0 TERM=C IMIN=3 GOTO130 C 120 SUM=1.0D0 TERM=1.0D0 IMIN=2 C 130 IF(IMIN.GT.IMAX)GOTO160 DO100I=IMIN,IMAX,2 AI=I TERM=TERM*((AI-1.0D0)/AI)*CSQ SUM=SUM+TERM 100 CONTINUE C 160 SUM=SUM*S IF(IEVODD.EQ.0)GOTO170 SUM=(2.0D0/PI)*(DATAN(DX/DSQRT(DNU))+SUM) 170 CDF=0.5D0+SUM/2.0D0 RETURN C C TREAT THE LARGE DEGREES OF FREEDOM CASE. C METHOD UTILIZED--TRUNCATED ASYMPTOTIC EXPANSION C (SEE JOHNSON AND KOTZ, VOLUME 2, PAGE 102, FORMULA 10; C SEE FEDERIGHI, PAGE 687). C 250 CONTINUE CALL NORCDF(X,CDFN) DCDFN=CDFN D1=DX D3=DX**3 D5=DX**5 D7=DX**7 D9=DX**9 D11=DX**11 TERM1=B11*(D3+D1)/DNU TERM2=B21*(B22*D7+B23*D5+B24*D3+B25*D1)/(DNU**2) TERM3=B31*(B32*D11+B33*D9+B34*D7+B35*D5+B36*D3+B37*D1)/(DNU**3) DCDF=TERM1+TERM2+TERM3 DCDF=DCDFN-(DCONST*(DEXP(-DX*DX/2.0D0)))*DCDF CDF=DCDF RETURN C END SUBROUTINE TIME(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT TIME C C PURPOSE--THIS SUBROUTINE PERFORMS A TIME SERIES ANALYSIS C ON THE DATA IN THE INPUT VECTOR X. C THE ANALYSIS CONSISTS OF THE FOLLOWING-- C 1) A PLOT OF AUTOCORRELATION VERSUS LAG NUMBER; C 2) A TEST FOR WHITE NOISE (ASSUMING NORMALITY); C 3) A 'PILOT' SPECTRUM; AND C 4) 4 OTHER ESTIMATED SPECTRA--EACH BASED C ON A DIFFERING BANDWIDTH. C C IN ORDER THAT THE RESULTS OF THE TIME SERIES ANALYSIS C BE VALID AND PROPERLY INTERPRETED, THE INPUT DATA C IN X SHOULD BE EQUI-SPACED IN TIME C (OR WHATEVER VARIABLE CORRESPONDS TO TIME). C C THE HORIZONTAL AXIS OF THE SPECTRA PRODUCED C BY THIS SUBROUTINE IS FREQUENCY. C THIS FREQUENCY IS MEASURED IN UNITS OF C CYCLES PER 'DATA POINT' OR, MORE PRECISELY, IN C CYCLES PER UNIT TIME WHERE C 'UNIT TIME' IS DEFINED AS THE C ELAPSED TIME BETWEEN ADJACENT OBSERVATIONS. C THE RANGE OF THE FREQUENCY AXIS IS 0.0 TO 0.5. C C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED) OBSERVATIONS. C N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--7 TO 11 PAGES (DEPENDING ON C THE INPUT SAMPLE SIZE) OF C AUTOMATIC PRINTOUT-- C 1) A PLOT OF AUTOCORRELATION VERSUS LAG NUMBER; C THIS PLOT MAY TAKE AS LITTLE AS 1 C OR AS MANY AS 5 PAGES C (THE EXACT NUMBER DEPENDING ON C THE INPUT SAMPLE SIZE N); C 2) A TEST FOR WHITE NOISE (ASSUMING NORMALITY); C 3) A 'PILOT' SPECTRUM; AND C 4) AN ESTIMATED SPECTRUM BASED ON A C BANDWIDTH DERIVED FROM THE DATA SET; C 5) AN ESTIMATED SPECTRUM BASED ON A C BANDWIDTH ONLY 1/2 AS WIDE AS IN 4; C 6) AN ESTIMATED SPECTRUM BASED ON A C BANDWIDTH ONLY 1/4 AS WIDE AS IN 4; C 7) AN ESTIMATED SPECTRUM BASED ON A C BANDWIDTH ONLY 1/8 AS WIDE AS IN 4; C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C --THE SAMPLE SIZE N MUST BE GREATER C THAN OR EQUAL TO 3. C OTHER DATAPAC SUBROUTINES NEEDED--PLOTC0, PLOTSP, AND CHSPPF. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--THE 'FAST FOURIER TRANSFORM' IS NOT USED C IN THIS VERSION OF TIME, BUT WILL BE C IMPLEMENTED IN A FUTURE VERSION. C --THE USUAL MAXIMUM NUMBER OF LAGS C FOR WHICH THE AUTOCORRELATION IS C COMPUTED IS N/4 WHERE N IS C THE SAMPLE SIZE (LENGTH OF THE C DATA RECORD IN THE VECTOR X). C THIS RULE IS OVERRIDDEN IN C LARGE DATA SETS AND IS REPLACED C BY THE RULE THAT THE MAXIMUM C NUMBER OF LAGS = 500 C (WHICH CORRESPONDS TO AN C AUTOCORRELATION PLOT COVERING C 5 COMPUTER PAGES). C IF MORE LAGS ARE DESIRED, C CHANGE THE VALUE OF THE C VARIABLE MAXLAG C WITHIN THIS SUBROUTINE C FROM 500 TO WHATEVER DESIRED, C AND ALSO CHANGE THE DIMENSION OF C THE VECTOR R FROM ITS PRESENT 500 TO HOWEVER C MANY LAGS ARE DESIRED. C --IF THE INPUT OBSERVATIONS IN X ARE CONSIDERED C TO HAVE BEEN COLLECTED 1 SECOND APART IN TIME, C THEN THE FREQUENCY AXIS OF THE RESULTING C SPECTRA WOULD BE IN UNITS OF HERTZ C (= CYCLES PER SECOND). C --THE FREQUENCY OF 0.0 CORRESPONDS TO A CYCLE C IN THE DATA OF INFINITE (= 1/(0.0)) C LENGTH OR PERIOD. C THE FREQUENCY OF 0.5 CORRESPONDS TO A CYCLE C IN THE DATA OF LENGTH = 1/(0.5) = 2 DATA POINTS. C --ANY EQUI-SPACED TIME SERIES ANALYSIS IS C INTRINSICALLY LIMITED TO DETECTING FREQUENCIES C NO LARGER THAN 0.5 CYCLES PER DATA POINT; C THIS CORRESPONDS TO THE FACT THAT THE C SMALLEST DETECTABLE CYCLE IN THE DATA C IS 2 DATA POINTS PER CYCLE. C REFERENCES--JENKINS AND WATTS, ESPECIALLY PAGE 290. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1977. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION R(500) DIMENSION S(125) DIMENSION PSSQ(6),PMSQ(6),PS(6),P(5),L(4) DATA PI/3.14159265358979/ C IPR=6 ILOWER=3 MAXLAG=500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.ILOWER)GOTO50 HOLD=X(1) DO65I=2,N IF(X(I).NE.HOLD)GOTO90 65 CONTINUE WRITE(IPR, 9)HOLD RETURN 50 WRITE(IPR,17)ILOWER WRITE(IPR,47)N RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE TIME SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 96H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 TIME SUBROUTINE IS OUTSIDE THE ALLOWABLE (,I6,11H,INFINITY) , 1 14HINTERVAL *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C COMPUTE THE SAMPLE MEAN C SUM=0.0 DO100I=1,N SUM=SUM+X(I) 100 CONTINUE XBAR=SUM/AN C C COMPUTE THE SAMPLE VARIANCE AND THE SUM OF SQUARED DEVIATIONS C SUM=0.0 DO200I=1,N SUM=SUM+(X(I)-XBAR)*(X(I)-XBAR) 200 CONTINUE SSQ=SUM VARB=SSQ/AN VAR=SSQ/(AN-1.0) SD=SQRT(VAR) C C COMPUTE THE SAMPLE AUTOCORRELATIONS C REFERENCE--JENKINS AND WATTS, PAGES 290 AND 259 (7.1.6) C KMAX=N/4 IF(N.LE.32)KMAX=N/2 IF(N.LE.16)KMAX=N IF(KMAX.GT.MAXLAG)KMAX=MAXLAG DO300K=1,KMAX SUM=0.0 NMK=N-K DO400I=1,NMK J=I+K SUM=SUM+(X(I)-XBAR)*(X(J)-XBAR) 400 CONTINUE R(K)=SUM/SSQ 300 CONTINUE C C PLOT THE SAMPLE AUTOCORRELATIONS C CALL PLOTCO(R,KMAX) WRITE(IPR,1705) WRITE(IPR,1710)N,KMAX C C DO A WHITE NOISE ANALYSIS C SDR=1.0/SQRT(AN) R975=1.96*SDR IF(R975.GT.1.0)R975=1.0 R025=-R975 NUMOUT=0 DO410K=1,KMAX ABSR=R(K) IF(ABSR.LT.0.0)ABSR=-ABSR IF(ABSR.GT.R975)NUMOUT=NUMOUT+1 410 CONTINUE PEROUT=FLOAT(NUMOUT)/FLOAT(KMAX) PEROUT=100.0*PEROUT WRITE(IPR,999) WRITE(IPR,420)R025,R975 WRITE(IPR,430) WRITE(IPR,440)NUMOUT,KMAX,PEROUT DO415I=1,5 WRITE(IPR,999) 415 CONTINUE WRITE(IPR,1715)N WRITE(IPR,1720)XBAR WRITE(IPR,1725)VAR WRITE(IPR,1730)SD WRITE(IPR,1735)VARB C C COMPUTE THE PILOT SPECTRUM FOR THE REDUCED (2**J) SAMPLE C REFERENCE--JENKINS AND WATTS, PAGE 288 C DO450I=1,20 NDIV=N/(2**I) IF(NDIV.EQ.0)I2=I-1 IF(NDIV.EQ.0)GOTO460 450 CONTINUE 460 IF(7.LT.I2)I2=7 N2=2**I2 AN2=N2 DO500K=1,I2 SUM=0.0 IMIN=2**K JMAX=IMIN/2 DO600I=IMIN,N2,IMIN SUM1=0.0 SUM2=0.0 DO700J=1,JMAX IARG1=I+J-JMAX IARG2=IARG1-JMAX SUM1=SUM1+X(IARG1) SUM2=SUM2+X(IARG2) 700 CONTINUE SUM=SUM+(SUM1-SUM2)*(SUM1-SUM2) 600 CONTINUE PSSQ(K)=SUM/FLOAT(IMIN) PMSQ(K)=PSSQ(K)/AN2 PS(K)=FLOAT(2*IMIN)*PMSQ(K) PS(K)=PS(K)/VARB 500 CONTINUE C C FORM THE PILOT SPECTRUM PLOT C DO900I=1,I2 IREV=I2-I+1 JMIN=(120/(2**I))+1 IF(I.EQ.I2)JMIN=1 JMAX=120/(2**(I-1)) DO1000J=JMIN,JMAX S(J)=PS(I) 1000 CONTINUE 900 CONTINUE CALL PLOTSP(S,120,0) WRITE(IPR,999) WRITE(IPR,1750) C C DEFINE 4 LAG WINDOW TRUNCATION POINTS C REFERENCE--JENKINS AND WATTS, PAGES 290 AND 260 C P(1)=.2 P(2)=.1 P(3)=.05 P(4)=.025 P(5)=.01 LMAX=0 DO1100I=1,5 DO1200K=1,KMAX KREV=KMAX-K+1 RK=R(KREV) IF(RK.LT.0.0)RK=-RK IF(RK.GE.P(I))LMAX=KREV IF(RK.GE.P(I))GOTO1350 1200 CONTINUE 1100 CONTINUE IF(LMAX.NE.0)GOTO1350 RMAX=ABS(R(1)) DO1300K=1,KMAX RK=R(K) IF(RK.LT.0.0)RK=-RK IF(RK.GE.RMAX)LMAX=K IF(RK.GE.RMAX)RMAX=RK 1300 CONTINUE 1350 ALMAX=LMAX L(1)=(3.0/2.0)*ALMAX IF(L(1).LE.32)LMAX=32 IF(L(1).LE.32)ALMAX=32.0 IF(L(1).LE.32)L(1)=32 IF(L(1).GE.KMAX)LMAX=KMAX IF(L(1).GE.KMAX)ALMAX=KMAX IF(L(1).GE.KMAX)L(1)=KMAX L(2)=(ALMAX/2.0)+0.1 L(3)=(ALMAX/4.0)+0.1 L(4)=(ALMAX/8.0)+0.1 IF(L(4).GE.3)NUMSP=4 IF(L(4).GE.3)GOTO1380 IF(L(3).GE.3)NUMSP=3 IF(L(3).GE.3)GOTO1380 IF(L(2).GE.3)NUMSP=2 IF(L(2).GE.3)GOTO1380 IF(L(1).GE.3)NUMSP=1 IF(L(1).GE.3)GOTO1380 WRITE(IPR,1390)N RETURN 1380 CONTINUE C C COMPUTE THE 4 SPECTRUM ESTIMATES C REFERENCE--JENKINS AND WATTS, PAGES 260 AND 244 C C COMPUTE BANDWIDTHS C REFERENCE--JENKINS AND WATTS, PAGES 257 AND 252 C C COMPUTE DEGREES OF FREEDOM FOR THE SPECTAL DENSITY ESTIMATE AT INDIVIDUAL C FREQUENCIES C REFERENCE--JENKINS AND WATTS, PAGES 254 AND 252 C C COMPUTE 95 PERCENT CONFIDENCE INTERVAL LENGTHS FOR THE LOG SPECTRAL C DENSITY ESTIMATES C REFERENCE--JENKINS AND WATTS, PAGES 255 AND 252 C C WRITE OUT THE 4 SPECTRUM PLOTS C DO1400I=1,NUMSP AL=L(I) LM1=L(I)-1 DO1500LLP1=1,121 LL=LLP1-1 ALL=LL SUM=0.0 DO1600K=1,LM1 AK=K ARG1=PI*AK/AL ARG2=PI*AK*ALL/120.0 WK=0.0 IF(K.LE.L(I))WK=0.5*(1.0+COS(ARG1)) SUM=SUM+R(K)*WK*COS(ARG2) 1600 CONTINUE SUM=2.0+4.0*SUM S(LLP1)=SUM 1500 CONTINUE BW=(4.0/3.0)/FLOAT(L(I)) DF=(8.0/3.0)*AN/FLOAT(L(I)) IDF=DF+0.5 CALL PLOTSP(S,121,IDF) DFROUN=IDF WRITE(IPR,999) WRITE(IPR,1760)L(I),BW,DFROUN 1400 CONTINUE C 420 FORMAT(1H ,103HUNDER THE NULL HYPOTHESIS OF WHITE NOISE (AND NORMA 1LITY), A 2-SIDED 95 PERCENT ACCEPTANCE INTERVAL IS (,F6.4,1H,,F6.4 1,1H)) 430 FORMAT(1H ,125HUNDER THE NULL HYPOTHESIS, ONLY 5 PERCENT (ON THE A 1VERAGE) OF THE OBSERVED AUTOCORRELATIONS SHOULD FALL OUTSIDE THIS 1INTERVAL) 440 FORMAT(1H ,20HIT IS OBSERVED THAT ,I5,12H OUT OF THE ,I5,11H (THAT 1 IS, ,F5.1,72H PERCENT) OF THE COMPUTED AUTOCORRELATIONS FALL OUTS 1IDE OF THIS INTERVAL) 1390 FORMAT(1H ,45HDUE TO THE SMALL NUMBER OF OBSERVATIONS (N = ,I6,59H 1), THERE ARE NOT ENOUGH LAGS TO PRODUCE A RELIABLE SPECTRUM) 1705 FORMAT(1H ,30X, 63HAUTOCORRELATION PLOT--PLOT OF SAMPLE AUTOCORREL 1ATION VERSUS LAG) 1710 FORMAT(1H ,10X,29HTHE NUMBER OF OBSERVATIONS = ,I6,10X,56HTHE NUMB 1ER OF COMPUTED (AND PLOTTED) AUTOCORRELATIONS = ,I6) 1715 FORMAT(1H ,18HTHE SAMPLE SIZE = ,I6) 1720 FORMAT(1H ,18HTHE SAMPLE MEAN = ,E15.8) 1725 FORMAT(1H ,22HTHE SAMPLE VARIANCE = ,E15.8) 1730 FORMAT(1H ,32HTHE SAMPLE STANDARD DEVIATION = ,E15.8) 1735 FORMAT(1H ,29HTHE BIASED SAMPLE VARIANCE = ,E15.8) 1750 FORMAT(1H ,50X,14HPILOT SPECTRUM) 1760 FORMAT(1H ,17HNUMBER OF LAGS = ,I5,10X,11HBANDWIDTH =,F10.3,10X,21 1HDEGREES OF FREEDOM = ,F10.3) 999 FORMAT(1H ) C RETURN END SUBROUTINE TOL(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT TOL C C PURPOSE--THIS SUBROUTINE COMPUTES NORMAL AND C DISTRIBUTION-FREE TOLERANCE LIMITS C FOR THE DATA IN THE INPUT VECTOR X. C 15 NORMAL TOLERANCE LIMITS ARE COMPUTED; AND C 30 DISTRIBUTION-FREE TOLERANCE LIMITS ARE COMPUTED. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--2 PAGES OF AUTOMATIC PRINTOUT-- C 1 PAGE GIVING NORMAL TOLERANCE LIMITS; AND C 1 PAGE GIVING DISTRIBUTION-FREE TOLERANCE LIMITS. C PRINTING--YES. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--GARDINER AND HULL, TECHNOMETRICS, 1966, PAGES 115-122 C --WILKS, ANNALS OF MATHEMATICAL STATISTICS, 1941, PAGE 92 C --MOOD AND GRABLE, PAGES 416-417 C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION PA(6),PC(6),Z1(3),A(6),B(6),C(6),RSMALL(5,6),USMALL(6,6) DIMENSION TMIN(3,6),TMAX(3,6) DIMENSION P(10),C1(10),C2(10),C3(10) C DATA PA(1),PA(2),PA(3),PA(4),PA(5),PA(6)/50.,75.,90.,95.,99.,99.9/ DATA PC(1),PC(2),PC(3)/90.,95.,99./ DATA Z1(1),Z1(2),Z1(3)/-1.28155157,-1.64485363,-2.32634787/ DATA A(1),A(2),A(3),A(4),A(5),A(6)/.6745,1.1504,1.6449,1.9600,2.57 158,3.2905/ DATA B(1),B(2),B(3),B(4),B(5),B(6)/.33734,.57335,.82140,.97910,1.2 1889,1.64038/ DATA C(1),C(2),C(3),C(4),C(5),C(6)/-0.15460,-0.02991,.22044,.40675 1,.85514,1.42601/ DATA RSMALL(1,1),RSMALL(1,2),RSMALL(1,3),RSMALL(1,4),RSMALL(1,5), 1RSMALL(1,6) /1.0505,1.6859,2.2844,2.6463,3.3266,4.0903/ DATA RSMALL(2,1),RSMALL(2,2),RSMALL(2,3),RSMALL(2,4),RSMALL(2,5), 1RSMALL(2,6) /0.8557,1.4333,2.0078,2.3624,3.0368,3.7983/ DATA RSMALL(3,1),RSMALL(3,2),RSMALL(3,3),RSMALL(3,4),RSMALL(3,5), 1RSMALL(3,6) /0.7929,1.3412,1.8979,2.2457,2.9128,3.6708/ DATA RSMALL(4,1),RSMALL(4,2),RSMALL(4,3),RSMALL(4,4),RSMALL(4,5), 1RSMALL(4,6) /0.7622,1.2940,1.8388,2.1815,2.8422,3.5965/ DATA RSMALL(5,1),RSMALL(5,2),RSMALL(5,3),RSMALL(5,4),RSMALL(5,5), 1RSMALL(5,6) /0.7442,1.2654,1.8019,2.1408,2.7963,3.5472/ DATA USMALL(1,1),USMALL(1,2),USMALL(1,3)/0.,0.,0./ DATA USMALL(2,1),USMALL(2,2),USMALL(2,3)/7.9579,15.9472,79.7863/ DATA USMALL(3,1),USMALL(3,2),USMALL(3,3)/3.0808,4.4154,9.9749/ DATA USMALL(4,1),USMALL(4,2),USMALL(4,3)/2.2658,2.9200,5.1113/ DATA USMALL(5,1),USMALL(5,2),USMALL(5,3)/1.9393,2.3724,3.6692/ DATA USMALL(6,1),USMALL(6,2),USMALL(6,3)/1.7621,2.0893,3.0034/ DATA P(1),P(2),P(3),P(4),P(5),P(6),P(7),P(8),P(9),P(10) 1/50.,75.,90.,95.,97.5,99.,99.5,99.9,99.95,99.99/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD RETURN 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE TOL SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 TOL SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE TOL SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C COMPUTE NORMAL TOLERANCE LIMITS C C COMPUTE THE SAMPLE MEAN C XBAR=0.0 DO100I=1,N XBAR=XBAR+X(I) 100 CONTINUE XBAR=XBAR/AN C C COMPUTE THE SAMPLE STANDARD DEVIATION C VAR=0.0 DO200I=1,N VAR=VAR+(X(I)-XBAR)**2 200 CONTINUE VAR=VAR/(AN-1.0) SD=SQRT(VAR) C C COMPUTE THE NORMAL TOLERANCE LIMITS C DO 300 I=1,3 Z=Z1(I) F=N-1 IF(N.LE.6)U=USMALL(N,I) IF(N.LE.6)GOTO390 D1=1.0+Z*SQRT(2.0)/SQRT(F) D2=2.0*(Z**2-1.0)/(3.0*F) D3=(Z**3-7.0*Z)/(9.0*SQRT(2.0)*F**1.5) D4=(6.0*Z**4+14.0*Z**2-32.0)/(405.0*F**2.0) D5=(9.0*Z**5+256.0*Z**3-433.0*Z)/(4860.0*SQRT(2.0)*F**2.5) D6=(12.0*Z**6-243.0*Z**4-923.0*Z**2+1472.0)/(25515.0*F**3.0) D7=(3753.0*Z**7+4353.0*Z**5-289517.0*Z**3-289717.0*Z)/(9185400.0*S 1QRT(2.0)*F**3.5) UNIV=D1+D2+D3-D4+D5+D6-D7 U=1.0/UNIV U=SQRT(U) 390 DO 400 J=1,6 R=A(J)+(B(J)/(C(J)+AN)) IF(N.LE.5)R=RSMALL(N,J) AK=R*U TMIN(I,J)=XBAR-AK*SD TMAX(I,J)=XBAR+AK*SD 400 CONTINUE 300 CONTINUE C C WRITE OUT THE NORMAL TOLERANCE LIMITS C WRITE(IPR,998) WRITE(IPR,605)N WRITE(IPR,999) WRITE(IPR,609) WRITE(IPR,610) WRITE(IPR,999) WRITE(IPR,615)XBAR,SD WRITE(IPR,999) WRITE(IPR,999) DO 600 I=1,3 DO 700 J=1,6 WRITE(IPR,620)PC(I),PA(J),TMIN(I,J),TMAX(I,J) 700 CONTINUE WRITE(IPR,999) 600 CONTINUE C C C C C COMPUTE DISTRIBUTION-FREE TOLERANCE LIMITS C K=N/2 NUMSEC=3 IF(K.LT.NUMSEC)NUMSEC=K C C DETERMINE THE SMALLEST 3 AND LARGEST 3 OBSERVATIONS C LOCMIN=1 XMIN=X(1) DO800I=1,N IF(X(I).LE.XMIN)LOCMIN=I IF(X(I).LE.XMIN)XMIN=X(I) 800 CONTINUE LOCMAX=1 XMAX=X(1) DO850I=1,N IF(X(I).GE.XMAX)LOCMAX=I IF(X(I).GE.XMAX)XMAX=X(I) 850 CONTINUE DO900I=1,N IF(I.NE.LOCMIN)GOTO910 900 CONTINUE 910 LOCMN2=I XMIN2=X(I) DO950I=1,N IF(I.EQ.LOCMIN)GOTO950 IF(X(I).LE.XMIN2)LOCMN2=I IF(X(I).LE.XMIN2)XMIN2=X(I) 950 CONTINUE DO1000I=1,N IF(I.NE.LOCMAX)GOTO1010 1000 CONTINUE 1010 LOCMX2=I XMAX2=X(I) DO1050I=1,N IF(I.EQ.LOCMAX)GOTO1050 IF(X(I).GE.XMAX2)LOCMX2=I IF(X(I).GE.XMAX2)XMAX2=X(I) 1050 CONTINUE DO1100I=1,N IF(I.NE.LOCMIN.AND.I.NE.LOCMN2)GOTO1110 1100 CONTINUE 1110 LOCMN3=I XMIN3=X(I) DO1150I=1,N IF(I.EQ.LOCMIN.OR.I.EQ.LOCMN2)GOTO1150 IF(X(I).LE.XMIN3)LOCMN3=I IF(X(I).LE.XMIN3)XMIN3=X(I) 1150 CONTINUE DO1200I=1,N IF(I.NE.LOCMAX.AND.I.NE.LOCMX2)GOTO1210 1200 CONTINUE 1210 LOCMX3=I XMAX3=X(I) DO1250I=1,N IF(I.EQ.LOCMAX.OR.I.EQ.LOCMX2)GOTO1250 IF(X(I).GE.XMAX3)LOCMX3=I IF(X(I).GE.XMAX3)XMAX3=X(I) 1250 CONTINUE AN1=AN-1.0 AN2=AN-2.0 AN3=AN-3.0 AN4=AN-4.0 AN5=AN-5.0 AN6=AN-6.0 DO1600I=1,10 D=P(I)/100.0 C1(I)=(D**AN1)*(-AN +AN1*D) C1(I)=1.0-C1(I) Q=1.0-D T=Q*AN C1(I)=1.0+AN1*Q C1(I)=1.0-(D**AN1)*C1(I) C1(I)=C1(I)*100.0 IF(NUMSEC.EQ.1)GOTO1600 A0=6.0*D*D*D A1=2.0-7.0*D+11.0*D*D A2=-3.0+6.0*D A3=1.0 C2(I)=A0+A1*T+A2*T*T+A3*T*T*T C2(I)=1.0-(D**AN3)*C2(I)/6.0 C2(I)=C2(I)*100.0 IF(NUMSEC.EQ.2)GOTO1600 A0=120.0*D*D*D*D*D A1=24.0-126.0*D+274.0*D*D-326.0*D*D*D+274.0*D*D*D*D A2=-50.0+205.0*D-320.0*D*D+225.0*D*D*D A3=35.0-100.0*D+85.0*D*D A4=-10.0+15.0*D A5=1.0D0 C3(I)=A0+A1*T+A2*T*T+A3*T*T*T+A4*T*T*T*T+A5*T*T*T*T*T C3(I)=1.0-(D**AN5)*C3(I)/120.0 C3(I)=C3(I)*100.0 1600 CONTINUE C C WRITE OUT THE DISTRIBUTION-FREE TOLERANCE LIMITS C WRITE(IPR,998) WRITE(IPR,205)N WRITE(IPR,999) WRITE(IPR,209) WRITE(IPR,210) WRITE(IPR,999) WRITE(IPR,999) IF(NUMSEC.EQ.1)GOTO1850 IF(NUMSEC.EQ.2)GOTO1750 DO1700I=1,10 WRITE(IPR,217)C3(I),P(I),XMIN3,XMAX3 1700 CONTINUE WRITE(IPR,999) 1750 DO1800I=1,10 WRITE(IPR,216)C2(I),P(I),XMIN2,XMAX2 1800 CONTINUE WRITE(IPR,999) 1850 DO1900I=1,10 WRITE(IPR,215)C1(I),P(I),XMIN,XMAX 1900 CONTINUE C 605 FORMAT(1H ,45H NORMAL TOLERANCE LIMITS FOR THE ,I6,13H 1 OBSERVATIONS) 609 FORMAT(1H ,49H REFERENCE--CRC HANDBOOK, PAGES 32-35) 610 FORMAT(1H ,77H REFERENCE--GARDINER AND HULL, TECHNOMET 1RICS, 1966, PAGES 115-122) 615 FORMAT(1H ,27H SAMPLE MEAN = ,E15.8 ,37H SAMPL 1E STANDARD DEVIATION = ,E15.8 ) 620 FORMAT(1H ,7HWE ARE ,F6.2,24H PERCENT CONFIDENT THAT ,F5.2,49H PER 1CENT OF THE POPULATION IS BETWEEN XBAR-K*S = ,E12.5,16H AND XBAR+K 1*S = ,E12.5) 205 FORMAT(1H ,55H DISTRIBUTION-FREE TOLERANCE LIMITS FOR T 1HE ,I6,13H OBSERVATIONS) 209 FORMAT(1H ,51H REFERENCE--WILKS, ANNALS, 1941, PAGE 92) 210 FORMAT(1H ,53H REFERENCE--MOOD AND GRABLE, PAGES 416-41 17) 215 FORMAT(1H ,7HWE ARE ,F6.2,24H PERCENT CONFIDENT THAT ,F5.2,45H PER 1CENT OF THE POPULATION IS BETWEEN XMIN = ,F8.3,14H AND XMAX = ,F 18.3) 216 FORMAT(1H ,7HWE ARE ,F6.2,24H PERCENT CONFIDENT THAT ,F5.2,45H PER 1CENT OF THE POPULATION IS BETWEEN X2 = ,F8.3,14H AND X(N-1) = ,F 18.3) 217 FORMAT(1H ,7HWE ARE ,F6.2,24H PERCENT CONFIDENT THAT ,F5.2,45H PER 1CENT OF THE POPULATION IS BETWEEN X3 = ,F8.3,14H AND X(N-2) = ,F 18.3) 998 FORMAT(1H1) 999 FORMAT(1H ) C RETURN END SUBROUTINE TPLT(X,N,NU) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT TPLT C C PURPOSE--THIS SUBROUTINE GENERATES A STUDENT'S T C PROBABILITY PLOT (WITH INTEGER C DEGREES OF FREEDOM PARAMETER VALUE = NU). C THE PROTOTYPE STUDENT'S T DISTRIBUTION USED C HEREIN IS DEFINED FOR ALL X, C AND ITS PROBABILITY DENSITY FUNCTION IS GIVEN C IN THE REFERENCES BELOW. C AS USED HEREIN, A PROBABILITY PLOT FOR A DISTRIBUTION C IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS C THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION. C THE STUDENT'S T PROBABILITY PLOT IS USEFUL IN C GRAPHICALLY TESTING THE COMPOSITE (THAT IS, C LOCATION AND SCALE PARAMETERS NEED NOT BE SPECIFIED) C HYPOTHESIS THAT THE UNDERLYING DISTRIBUTION C FROM WHICH THE DATA HAVE BEEN RANDOMLY DRAWN C IS THE STUDENT'S T DISTRIBUTION C WITH DEGREES OF FREEDOM PARAMETER VALUE = NU. C IF THE HYPOTHESIS IS TRUE, THE PROBABILITY PLOT C SHOULD BE NEAR-LINEAR. C A MEASURE OF SUCH LINEARITY IS GIVEN BY THE C CALCULATED PROBABILITY PLOT CORRELATION COEFFICIENT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --NU = THE INTEGER NUMBER OF DEGREES C OF FREEDOM. C NU SHOULD BE POSITIVE. C OUTPUT--A ONE-PAGE STUDENT'S T PROBABILITY PLOT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C --NU SHOULD BE POSITIVE. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, TPPF, NORPPF, C PLOT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, 'TECHNIQUES FOR TAIL LENGTH ANALYSIS', C PROCEEDINGS OF THE EIGHTEENTH CONFERENCE C ON THE DESIGN OF EXPERIMENTS IN ARMY RESEARCH C DEVELOPMENT AND TESTING (ABERDEEN, MARYLAND, C OCTOBER, 1972), PAGES 425-450. C --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING, C 1967, PAGES 260-308. C --NATIONAL BUREAU OF STANDARDS APPLIED MATHMATICS C SERIES 55, 1964, PAGE 949, FORMULA 26.7.5. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGE 102, C FORMULA 11. C --FEDERIGHI, 'EXTENDED TABLES OF THE C PERCENTAGE POINTS OF STUDENT'S T C DISTRIBUTION, JOURNAL OF THE C AMERICAN STATISTICAL ASSOCIATION, C 1969, PAGES 683-688. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGES 120-123. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C UPDATED --FEBRUARY 1977. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(7500),W(7500) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501)) C IPR=6 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 IF(NU.LE.0)GOTO60 HOLD=X(1) DO65I=2,N IF(X(I).NE.HOLD)GOTO90 65 CONTINUE WRITE(IPR, 9)HOLD RETURN 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 60 WRITE(IPR,25) WRITE(IPR,47)NU RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE TPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 TPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE TPLT SUBROUTINE HAS THE VALUE 1 *****) 25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 TPLT SUBROUTINE IS NON-POSITIVE *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C SORT THE DATA C CALL SORT(X,N,Y) C C GENERATE UNIFORM ORDER STATISTIC MEDIANS C CALL UNIMED(N,W) C C COMPUTE STUDENT'S T DISTRIBUTION ORDER STATISTIC MEDIANS C DO100I=1,N CALL TPPF(W(I),NU,W(I)) 100 CONTINUE C C PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS. C COMPUTE THE TAIL LENGTH MEASURE OF THE DISTRIBUTION. C WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION C AND THE SAMPLE SIZE. C CALL PLOT(Y,W,N) Q=.9975 CALL TPPF(Q,NU,PP9975) Q=.0025 CALL TPPF(Q,NU,PP0025) Q=.975 CALL TPPF(Q,NU,PP975) Q=.025 CALL TPPF(Q,NU,PP025) TAU=(PP9975-PP0025)/(PP975-PP025) WRITE(IPR,105)NU,TAU,N C C COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. C COMPUTE LOCATION AND SCALE ESTIMATES C FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. C THEN WRITE THEM OUT. C SUM1=0.0 SUM2=0.0 DO200I=1,N SUM1=SUM1+Y(I) SUM2=SUM2+W(I) 200 CONTINUE YBAR=SUM1/AN WBAR=SUM2/AN SUM1=0.0 SUM2=0.0 SUM3=0.0 DO300I=1,N SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 300 CONTINUE CC=SUM2/SQRT(SUM3*SUM1) YSLOPE=SUM2/SUM3 YINT=YBAR-YSLOPE*WBAR WRITE(IPR,305)CC,YINT,YSLOPE C 105 FORMAT(1H ,55HSTUDENT'S T PROBABILITY PLOT WITH DEGREES OF FREEDOM 1 = ,I8,1X,7H(TAU = ,E15.8,1H),11X,20HTHE SAMPLE SIZE N = ,I7) 305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X, 122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) C RETURN END SUBROUTINE TPPF(P,NU,PPF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT TPPF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE FOR THE STUDENT'S T DISTRIBUTION C WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU. C THE STUDENT'S T DISTRIBUTION USED C HEREIN IS DEFINED FOR ALL X, C AND ITS PROBABILITY DENSITY FUNCTION IS GIVEN C IN THE REFERENCES BELOW. C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 (EXCLUSIVELY) C AND 1.0 (EXCLUSIVELY)) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C --NU = THE INTEGER NUMBER OF DEGREES C OF FREEDOM. C NU SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT FUNCTION . C VALUE PPF FOR THE STUDENT'S T DISTRIBUTION C WITH DEGREES OF FREEDOM PARAMETER = NU. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--NU SHOULD BE A POSITIVE INTEGER VARIABLE. C --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C OTHER DATAPAC SUBROUTINES NEEDED--NORPPF. C FORTRAN LIBRARY SUBROUTINES NEEDED--DSIN, DCOS, DSQRT, DATAN. C MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--FOR NU = 1 AND NU = 2, THE PERCENT POINT FUNCTION C FOR THE T DISTRIBUTION EXISTS IN SIMPLE CLOSED FORM C AND SO THE COMPUTED PERCENT POINTS ARE EXACT. C --FOR OTHER SMALL VALUES OF NU (NU BETWEEN 3 AND 6, C INCLUSIVELY), THE APPROXIMATION C OF THE T PERCENT POINT BY THE FORMULA C GIVEN IN THE REFERENCE BELOW IS AUGMENTED C BY 3 ITERATIONS OF NEWTON'S METHOD FOR C ROOT DETERMINATION. C THIS IMPROVES THE ACCURACY--ESPECIALLY FOR C VALUES OF P NEAR 0 OR 1. C REFERENCES--NATIONAL BUREAU OF STANDARDS APPLIED MATHMATICS C SERIES 55, 1964, PAGE 949, FORMULA 26.7.5. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGE 102, C FORMULA 11. C --FEDERIGHI, 'EXTENDED TABLES OF THE C PERCENTAGE POINTS OF STUDENT'S T C DISTRIBUTION, JOURNAL OF THE C AMERICAN STATISTICAL ASSOCIATION, C 1969, PAGES 683-688. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGES 120-123. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--OCTOBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DOUBLE PRECISION PI DOUBLE PRECISION SQRT2 DOUBLE PRECISION DP DOUBLE PRECISION DNU DOUBLE PRECISION TERM1,TERM2,TERM3,TERM4,TERM5 DOUBLE PRECISION DPPFN DOUBLE PRECISION DPPF,DCON,DARG,Z,S,C DOUBLE PRECISION B21 DOUBLE PRECISION B31,B32,B33,B34 DOUBLE PRECISION B41,B42,B43,B44,B45 DOUBLE PRECISION B51,B52,B53,B54,B55,B56 DOUBLE PRECISION D1,D3,D5,D7,D9 DATA PI/3.14159265358979D0/ DATA SQRT2/1.414213562D0/ DATA B21/0.25D0/ DATA B31,B32,B33,B34/0.01041666666667D0,5.0D0,16.0D0,3.0D0/ DATA B41,B42,B43,B44,B45/0.00260416666667D0,3.0D0,19.0D0,17.0D0, 1 -15.0D0/ DATA B51,B52,B53,B54,B55,B56/0.00001085069444D0,79.0D0,776.0D0, 1 1482.0D0,-1920.0D0,-945.0D0/ C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LE.0.0.OR.P.GE.1.0)GOTO50 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 TPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C DNU=NU DP=P MAXIT=5 C IF(NU.GE.3)GOTO250 IF(NU.EQ.1)GOTO100 IF(NU.EQ.2)GOTO200 WRITE(IPR,105) 105 FORMAT(1H ,33HINTERNAL ERROR IN TPPF SUBROUTINE) PPF=0.0 RETURN C C TREAT THE NU = 1 (CAUCHY) CASE C 100 DARG=PI*DP PPF=-DCOS(DARG)/DSIN(DARG) RETURN C C TREAT THE NU = 2 CASE C 200 TERM1=SQRT2/2.0D0 TERM2=2.0D0*DP-1.0D0 TERM3=DSQRT(DP*(1.0D0-DP)) PPF=TERM1*TERM2/TERM3 RETURN C C TREAT THE NU GREATER THAN OR EQUAL TO 3 CASE C 250 CALL NORPPF(P,PPFN) DPPFN=PPFN D1=DPPFN D3=DPPFN**3 D5=DPPFN**5 D7=DPPFN**7 D9=DPPFN**9 TERM1=D1 TERM2=B21*(D3+D1)/DNU TERM3=B31*(B32*D5+B33*D3+B34*D1)/(DNU**2) TERM4=B41*(B42*D7+B43*D5+B44*D3+B45*D1)/(DNU**3) TERM5=B51*(B52*D9+B53*D7+B54*D5+B55*D3+B56*D1)/(DNU**4) DPPF=TERM1+TERM2+TERM3+TERM4+TERM5 PPF=DPPF IF(NU.GE.7)RETURN IF(NU.EQ.3)GOTO300 IF(NU.EQ.4)GOTO400 IF(NU.EQ.5)GOTO500 IF(NU.EQ.6)GOTO600 RETURN C C AUGMENT THE RESULTS FOR THE NU = 3 CASE C 300 DCON=PI*(DP-0.5D0) DARG=DPPF/DSQRT(DNU) Z=DATAN(DARG) DO350IPASS=1,MAXIT S=DSIN(Z) C=DCOS(Z) Z=Z-(Z+S*C-DCON)/(2.0D0*C*C) 350 CONTINUE PPF=DSQRT(DNU)*S/C RETURN C C AUGMENT THE RESULTS FOR THE NU = 4 CASE C 400 DCON=2.0D0*(DP-0.5D0) DARG=DPPF/DSQRT(DNU) Z=DATAN(DARG) DO450IPASS=1,MAXIT S=DSIN(Z) C=DCOS(Z) Z=Z-((1.0D0+0.5D0*C*C)*S-DCON)/(1.5D0*C*C*C) 450 CONTINUE PPF=DSQRT(DNU)*S/C RETURN C C AUGMENT THE RESULTS FOR THE NU = 5 CASE C 500 DCON=PI*(DP-0.5D0) DARG=DPPF/DSQRT(DNU) Z=DATAN(DARG) DO550IPASS=1,MAXIT S=DSIN(Z) C=DCOS(Z) Z=Z-(Z+(C+(2.0D0/3.0D0)*C*C*C)*S-DCON)/((8.0D0/3.0D0)*C**4) 550 CONTINUE PPF=DSQRT(DNU)*S/C RETURN C C AUGMENT THE RESULTS FOR THE NU = 6 CASE C 600 DCON=2.0D0*(DP-0.5D0) DARG=DPPF/DSQRT(DNU) Z=DATAN(DARG) DO650IPASS=1,MAXIT S=DSIN(Z) C=DCOS(Z) Z=Z-((1.0D0+0.5D0*C*C+0.375D0*C**4)*S-DCON)/((15.0D0/8.0D0)*C**5) 650 CONTINUE PPF=DSQRT(DNU)*S/C RETURN C END SUBROUTINE TRAN(N,NU,ISEED,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT TRAN C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE STUDENT'S T DISTRIBUTION C WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU. C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C --NU = THE INTEGER DEGREES OF FREEDOM C (PARAMETER) FOR THE T C DISTRIBUTION. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE STUDENT'S T DISTRIBUTION C WITH DEGREES OF FREEDOM PARAMETER = NU. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C --NU SHOULD BE A POSITIVE INTEGER VARIABLE. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG, SQRT, SIN, COS. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--MOOD AND GRABLE, INTRODUCTION TO THE C THEORY OF STATISTICS, 1963, PAGE 233. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGE 94. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGE 121. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82.6 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) DIMENSION Y(2),Z(2) C C--------------------------------------------------------------------- C CCCCC CHARACTER*4 IFEEDB CCCCC CHARACTER*4 IPRINT C CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW CCCCC COMMON /PRINT/IFEEDB,IPRINT C C-----DATA STATEMENTS------------------------------------------------- C DATA PI/3.14159265359/ C IPR=6 C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(NU.LE.0)GOTO60 GOTO90 50 WRITE(IPR,5) WRITE(IPR,47)N RETURN 60 WRITE(IPR,15) WRITE(IPR,47)NU RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 TRAN SUBROUTINE IS NON-POSITIVE *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 TRAN SUBROUTINE IS NON-POSITIVE *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C GENERATE N STUDENT'S T RANDOM NUMBERS C USING THE DEFINITION THAT C A STUDENT'S T VARIATE WITH NU DEGREES OF FREEDOM C EQUALS A NORMAL VARIATE DIVIDED BY C A STANDARDIZED CHI VARIATE C (WHERE THE LATTER EQUALS SQRT(CHI-SQUARED/NU). C FIRST GENERATE A NORMAL RANDOM NUMBER, C THEN GENERATE A STANDARDIZED CHI RANDOM NUMBER, C THEN FORM THE RATIO OF THE FIRST DIVIDED BY C THE SECOND. C ANU=NU DO100I=1,N C CALL UNIRAN(2,ISEED,Y) ARG1=-2.0*ALOG(Y(1)) ARG2=2.0*PI*Y(2) ZNORM=(SQRT(ARG1))*(COS(ARG2)) C SUM=0.0 DO200J=1,NU,2 CALL UNIRAN(2,ISEED,Y) ARG1=-2.0*ALOG(Y(1)) ARG2=2.0*PI*Y(2) Z(1)=(SQRT(ARG1))*(COS(ARG2)) Z(2)=(SQRT(ARG1))*(SIN(ARG2)) SUM=SUM+Z(1)*Z(1) IF(J.EQ.NU)GOTO200 SUM=SUM+Z(2)*Z(2) 200 CONTINUE C X(I)=ZNORM/SQRT(SUM/ANU) C 100 CONTINUE C RETURN END SUBROUTINE TRIM(X,N,P1,P2,IWRITE,XTRIM) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT TRIM C C PURPOSE--THIS SUBROUTINE COMPUTES THE C SAMPLE TRIMMED MEAN C OF THE DATA IN THE INPUT VECTOR X. C THE TRIMMING IS SUCH THAT C THE LOWER 100*P1 % OF THE DATA IS TRIMMED OFF C AND THE UPPER 100*P2 % OF THE DATA IS TRIMMED OFF. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --P1 = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 AND 1.0) C WHICH DEFINES WHAT FRACTION C OF THE LOWER ORDER STATISTICS C IS TO BE TRIMMED OFF C BEFORE COMPUTING THE TRIMMED MEAN. C --P2 = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 AND 1.0) C WHICH DEFINES WHAT FRACTION C OF THE UPPER ORDER STATISTICS C IS TO BE TRIMMED OFF C BEFORE COMPUTING THE TRIMMED MEAN. C --IWRITE = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL SUPPRESS C THE PRINTING OF THE C SAMPLE TRIMMED MEAN C AS IT IS COMPUTED; C OR (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0), C LIKE, SAY, 1) WILL CAUSE C THE PRINTING OF THE C SAMPLE TRIMMED MEAN C AT THE TIME IT IS COMPUTED. C OUTPUT ARGUMENTS--XTRIM = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE TRIMMED MEAN C WHERE 100*P1 % OF THE SMALLEST C AND 100*P2 % OF THE LARGEST C ORDERED OBSERVATIONS HAVE BEEN C TRIMMED AWAY BEFORE COMPUTING THE C MEAN OF THE REMAINING OBSERVATIONS C IN THE MIDDLE. C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SAMPLE TRIMMED MEAN C WHERE 100*P1 % OF THE SMALLEST C AND 100*P2 % OF THE LARGEST C ORDERED OBSERVATIONS HAVE BEEN TRIMMED AWAY. C PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO C INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR C CONDITION EXISTS. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 15000. C --P1 SHOULD BE NON-NEGATIVE. C --P1 SHOULD BE SMALLER THAN 1.0 C --P2 SHOULD BE NON-NEGATIVE. C --P2 SHOULD BE SMALLER THAN 1.0 C --THE SUM OF P1 AND P2 SHOULD BE C SMALLER THAN 1.0. C OTHER DATAPAC SUBROUTINES NEEDED--SORT. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--DAVID, ORDER STATISTICS, 1970, PAGES 126-130, 136. C --CROW AND SIDDIQUI, 'ROBUST ESTIMATION OF LOCATION', C JOURNAL OF THE AMERICAN STATISTICAL ASSOCIATION, C 1967, PAGES 357, 387. C --FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY, 1969). C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(15000) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)) C IPR=6 IUPPER=15000 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C AN=N IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO65 60 CONTINUE WRITE(IPR, 9)HOLD XTRIM=X(1) GOTO201 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XTRIM=X(1) GOTO201 65 IF(P1.LT.0.0.OR.P1.GE.1.0)GOTO66 GOTO70 66 WRITE(IPR,27) WRITE(IPR,48)P1 XTRIM=0.0 RETURN 70 IF(P2.LT.0.0.OR.P2.GE.1.0)GOTO71 GOTO75 71 WRITE(IPR,37) WRITE(IPR,48)P2 XTRIM=0.0 RETURN 75 PSUM=P1+P2 IF(PSUM.LT.0.0.OR.PSUM.GE.1.0)GOTO76 GOTO90 76 WRITE(IPR,42) WRITE(IPR,43)P1 WRITE(IPR,44)P2 WRITE(IPR,45)PSUM XTRIM=0.0 RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE TRIM SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 TRIM SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE TRIM SUBROUTINE HAS THE VALUE 1 *****) 27 FORMAT(1H ,121H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 TRIM SUBROUTINE IS OUTSIDE THE ALLOWABLE (0.0,1.0) INTERVAL * 1****) 37 FORMAT(1H ,121H***** FATAL ERROR--THE FOURTH INPUT ARGUMENT TO THE 1 TRIM SUBROUTINE IS OUTSIDE THE ALLOWABLE (0.0,1.0) INTERVAL * 1****) 42 FORMAT(1H , 46H***** FATAL ERROR--THE SUM OF INPUT ARGUMENTS , 1 58H3 AND 4 TO THE TRIM SUBROUTINE IS OUTSIDE THE ALLOWABLE , 1 24H(0.0,1.0) INTERVAL *****) 43 FORMAT(1H ,37H INPUT ARGUMENT 3 , 1 19H = ,E15.8) 44 FORMAT(1H ,37H INPUT ARGUMENT 4 , 1 19H = ,E15.8) 45 FORMAT(1H ,37H INPUT ARGUMENT 3 + , 1 19HINPUT ARGUMENT 4 = ,E15.8) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) 48 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C CALL SORT(X,N,Y) C AN=N NP1=P1*AN+0.0001 ISTART=NP1+1 NP2=P2*AN+0.0001 ISTOP=N-NP2 SUM=0.0 K=0 IF(ISTART.GT.ISTOP)GOTO150 DO100I=ISTART,ISTOP K=K+1 SUM=SUM+X(I) 100 CONTINUE AK=K XTRIM=SUM/AK GOTO170 150 WRITE(IPR,155) 155 FORMAT(1H ,37HINTERNAL ERROR IN TRIM SUBROUTINE--, 1 45HTHE START INDEX IS HIGHER THAN THE STOP INDEX) XTRIM=0.0 RETURN 170 CONTINUE C 201 IF(IWRITE.EQ.0)RETURN PERP1=100.0*P1 PERP2=100.0*P2 PERP3=100.0-PERP1-PERP2 WRITE(IPR,999) WRITE(IPR,105)N,XTRIM WRITE(IPR,110)PERP1,NP1 WRITE(IPR,115)PERP2,NP2 WRITE(IPR,120)PERP3,K 105 FORMAT(1H ,31HTHE SAMPLE TRIMMED MEAN OF THE ,I6,13H OBSERVATIONS, 1 4H IS ,E15.8) 110 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) , 1 39HOF THE DATA WERE TRIMMED FROM BELOW) 115 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) , 1 39HOF THE DATA WERE TRIMMED FROM ABOVE) 120 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) , 1 52H OF THE DATA REMAIN IN THE MIDDLE AFTER THE TRIMMING) 999 FORMAT(1H ) C RETURN END SUBROUTINE UNICDF(X,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT UNICDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR THE UNIFORM (RECTANGULAR) C DISTRIBUTION ON THE UNIT INTERVAL (0,1). C THIS DISTRIBUTION HAS MEAN = 0.5 C AND STANDARD DEVIATION = SQRT(1/12) = 0.28867513. C THIS DISTRIBUTION HAS THE PROBABILITY C DENSITY FUNCTION F(X) = 1. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--X SHOULD BE BETWEEN 0 AND 1, INCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 57-74. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(X.LT.0.0.OR.X.GT.1.0)GOTO50 GOTO90 50 WRITE(IPR,2) WRITE(IPR,46)X IF(X.LT.0.0)CDF=0.0 IF(X.GT.1.0)CDF=1.0 RETURN 90 CONTINUE 2 FORMAT(1H ,120H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE UNICDF SUBROUTINE IS OUTSIDE THE USUAL (0,1) INTERVAL ** 1***) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C CDF=X C RETURN END SUBROUTINE UNIMED(N,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT UNIMED C C PURPOSE--THIS SUBROUTINE GENERATES THE N ORDER STATISTIC MEDIANS C FROM THE UNIFORM (RECTANGULAR) C DISTRIBUTION ON THE UNIT INTERVAL (0,1). C THIS DISTRIBUTION HAS MEAN = 0.5 C AND STANDARD DEVIATION = SQRT(1/12) = 0.28867513. C THIS DISTRIBUTION HAS THE PROBABILITY C DENSITY FUNCTION F(X) = 1. C THIS SUBROUTINE IS A SUPPORT SUBROUTINE FOR C ALL OF THE PROBABILITY PLOT SUBROUTINES C IN DATAPAC; IT IS RARELY USED BY THE C DATA ANALYST DIRECTLY. C A PROBABILITY PLOT FOR A GENERAL DISTRIBUTION C IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS C THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION. C THE I-TH ORDER STATISTIC MEDIAN FOR A GENERAL C DISTRIBUTION IS OBTAINED BY TRANSFORMING C THE I-TH UNIFORM ORDER STATISTIC MEDIAN C BY THE PERCENT POINT FUNCTION OF THE DESIRED C DISTRIBUTION--HENCE THE IMPORTANCE OF BEING ABLE TO C GENERATE UNIFORM ORDER STATISTIC MEDIANS. C IT IS OF THEROETICAL INTEREST TO NOTE THAT C THE I-TH UNIFORM ORDER STATISTIC MEDIAN C IN A SAMPLE OF SIZE N IS IDENTICALLY THE C MEDIAN OF THE BETA DISTRIBUTION C WITH PARAMETERS I AND N-I+1. C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF UNIFORM ORDER STATISTIC MEDIANS C TO BE GENERATED. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C UNIFORM ORDER STATISTIC MEDIANS C WILL BE PLACED. C OUTPUT--THE N ORDER STATISTIC MEDIANS C FROM THE RECTANGULAR DISTRIBUTION ON (0,1). C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, 'THE PROBABILITY PLOT CORRELATION COEFFICIENT C TEST FOR NORMALITY', TECHNOMETRICS, 1975, PAGES 111-117. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 GOTO90 50 WRITE(IPR, 5) WRITE(IPR,47)N RETURN 55 WRITE(IPR, 8) 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 UNIMED SUBROUTINE IS NON-POSITIVE *****) 8 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE UNIMED SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C COMPUTE THE MEDIANS FOR THE FIRST AND LAST ORDER STATISTICS C X(N)=0.5**(1.0/AN) X(1)=1.0-X(N) C C DETERMINE IF AN ODD OR EVEN SAMPLE SIZE C NHALF=(N/2)+1 NEVODD=2*(N/2) IF(N.NE.NEVODD)X(NHALF)=0.5 IF(N.LE.3)RETURN C C COMPUTE THE MEDIANS FOR THE OTHER ORDER STATISTICS C GAM=0.3175 IMAX=N/2 DO100I=2,IMAX AI=I IREV=N-I+1 X(I)=(AI-GAM)/(AN-2.0*GAM+1.0) X(IREV)=1.0-X(I) 100 CONTINUE C RETURN END SUBROUTINE UNIPDF(X,PDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT UNIPDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY C FUNCTION VALUE FOR THE UNIFORM (RECTANGULAR) C DISTRIBUTION ON THE UNIT INTERVAL (0,1). C THIS DISTRIBUTION HAS MEAN = 0.5 C AND STANDARD DEVIATION = SQRT(1/12) = 0.28867513. C THIS DISTRIBUTION HAS THE PROBABILITY C DENSITY FUNCTION F(X) = 1. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT C WHICH THE PROBABILITY DENSITY C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--PDF = THE SINGLE PRECISION PROBABILITY C DENSITY FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY C FUNCTION VALUE PDF. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--X SHOULD BE BETWEEN 0 AND 1, INCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 57-74. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(X.LT.0.0.OR.X.GT.1.0)GOTO50 GOTO90 50 WRITE(IPR,2) WRITE(IPR,46)X PDF=0.0 RETURN 90 CONTINUE 2 FORMAT(1H ,120H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE UNIPDF SUBROUTINE IS OUTSIDE THE USUAL (0,1) INTERVAL ** 1***) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C PDF=1.0 C RETURN END SUBROUTINE UNIPLT(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT UNIPLT C C PURPOSE--THIS SUBROUTINE GENERATES A UNIFORM C PROBABILITY PLOT. C THE PROTOTYPE UNIFORM DISTRIBUTION USED HEREIN C IS DEFINED ON THE UNIT INTERVAL (0,1). C THIS DISTRIBUTION HAS MEAN = 0.5 C AND STANDARD DEVIATION = SQRT(1/12) = 0.28867513. C THIS DISTRIBUTION HAS C THE PROBABILITY DENSITY FUNCTION C F(X) = 1. C AS USED HEREIN, A PROBABILITY PLOT FOR A DISTRIBUTION C IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS C THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION. C THE UNIFORM PROBABILITY PLOT IS USEFUL IN C GRAPHICALLY TESTING THE COMPOSITE (THAT IS, C LOCATION AND SCALE PARAMETERS NEED NOT BE SPECIFIED) C HYPOTHESIS THAT THE UNDERLYING DISTRIBUTION C FROM WHICH THE DATA HAVE BEEN RANDOMLY DRAWN C IS THE UNIFORM DISTRIBUTION. C IF THE HYPOTHESIS IS TRUE, THE PROBABILITY PLOT C SHOULD BE NEAR-LINEAR. C A MEASURE OF SUCH LINEARITY IS GIVEN BY THE C CALCULATED PROBABILITY PLOT CORRELATION COEFFICIENT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--A ONE-PAGE UNIFORM PROBABILITY PLOT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, PLOT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, 'TECHNIQUES FOR TAIL LENGTH ANALYSIS', C PROCEEDINGS OF THE EIGHTEENTH CONFERENCE C ON THE DESIGN OF EXPERIMENTS IN ARMY RESEARCH C DEVELOPMENT AND TESTING (ABERDEEN, MARYLAND, C OCTOBER, 1972), PAGES 425-450. C --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING, C 1967, PAGES 260-308. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 57-74. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(7500),W(7500) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501)) C DATA TAU/1.04736842/ C IPR=6 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD GOTO90 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE UNIPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 UNIPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE UNIPLT SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C SORT THE DATA C CALL SORT(X,N,Y) C C GENERATE UNIFORM ORDER STATISTIC MEDIANS C CALL UNIMED(N,W) C C PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS. C WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION C AND THE SAMPLE SIZE. C CALL PLOT(Y,W,N) WRITE(IPR,105)TAU,N C C COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. C COMPUTE LOCATION AND SCALE ESTIMATES C FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. C THEN WRITE THEM OUT. C SUM1=0.0 DO200I=1,N SUM1=SUM1+Y(I) 200 CONTINUE YBAR=SUM1/AN WBAR=0.5 SUM1=0.0 SUM2=0.0 SUM3=0.0 DO300I=1,N SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM2=SUM2+(W(I)-0.5)*(Y(I)-YBAR) SUM3=SUM3+(W(I)-0.5)*(W(I)-0.5) 300 CONTINUE CC=SUM2/SQRT(SUM3*SUM1) YSLOPE=SUM2/SUM3 YINT=YBAR-YSLOPE*WBAR WRITE(IPR,305)CC,YINT,YSLOPE C 105 FORMAT(1H ,32HUNIFORM PROBABILITY PLOT (TAU = ,E15.8,1H),55X,20HTH 1E SAMPLE SIZE N = ,I7) 305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X, 122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) C RETURN END SUBROUTINE UNIPPF(P,PPF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT UNIPPF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE FOR THE UNIFORM (RECTANGULAR) C DISTRIBUTION ON THE UNIT INTERVAL (0,1). C THIS DISTRIBUTION HAS MEAN = 0.5 C AND STANDARD DEVIATION = SQRT(1/12) = 0.28867513. C THIS DISTRIBUTION HAS THE PROBABILITY C DENSITY FUNCTION F(X) = 1. C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 AND 1.0) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT C FUNCTION VALUE PPF. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--P SHOULD BE BETWEEN 0.0 AND 1.0, INCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGES 21-44, 229-231. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 57-74. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LT.0.0.OR.P.GT.1.0)GOTO50 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 UNIPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C PPF=P C RETURN END SUBROUTINE UNIRAN(N,ISEED,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT UNIRAN C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE UNIFORM (RECTANGULAR) C DISTRIBUTION ON THE UNIT INTERVAL (0,1). C THIS DISTRIBUTION HAS MEAN = 0.5 C AND STANDARD DEVIATION = SQRT(1/12) = 0.28867513. C THIS DISTRIBUTION HAS THE PROBABILITY C DENSITY FUNCTION F(X) = 1. C C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C --ISEED = AN INTEGER ISEED VALUE C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE RECTANGULAR DISTRIBUTION ON (0,1). C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C C ALGORITHM--FIBONACCI GENERATOR C AS DEFINED BY GEORGE MARSAGLIA. C C NOTE--THIS GENERATOR IS TRANSPORTABLE. C IT IS NOT MACHINE-INDEPENDENT C IN THE SENSE THAT FOR A GIVEN VALUE C OF THE INPUT SEED ISEED AND FOR A GIVEN VALUE C OF MDIG (TO BE DEFINED BELOW), C THE SAME SEQUENCE OF UNIRFORM RANDOM C NUMBERS WILL RESULT ON DIFFERENT COMPUTERS C (VAX, PRIME, PERKIN-ELMER, IBM, UNIVAC, HONEYWELL, ETC.) C C NOTE--IF MDIG = 32 AND IF ISEED = 305, C THEN THE OUTPUT FROM THIS GENERATOR SHOULD BE AS FOLLOWS-- C THE FIRST NUMBER TO RESULT IS .4771580... C THE SECOND NUMBER TO RESULT IS .4219293... C THE THIRD NUMBER TO RESULT IS .6646181... C ... C THE THOUSANDTH NUMBER TO RESULT IS .2036834... C C NOTE--IF MDIG = 16 AND IF ISEED = 305, C THEN THE OUTPUT FROM THIS GENERATOR SHOULD BE AS FOLLOWS-- C THE FIRST NUMBER TO RESULT IS .027832881... C THE SECOND NUMBER TO RESULT IS .56102176... C THE THIRD NUMBER TO RESULT IS .41456343... C ... C THE THOUSANDTH NUMBER TO RESULT IS .19797357... C C NOTE--IT IS RECOMMENDED THAT UPON C IMPLEMENTATION OF DATAPLOT, THE OUTPUT C FROM UNIRAN BE CHECKED FOR AGREEMENT C WITH THE ABOVE SAMPLE OUTPUT. C ALSO, THERE ARE MANY ANALYSIS AND DIAGNOSTIC C TOOLS IN DATAPLOT THAT WILL ALLOW THE C TESTING OF THE RANDOMNESS AND UNIFORMITY C OF THIS GENERATOR. C SUCH CHECKING IS ESPECIALLY IMPORTANT C IN LIGHT OF THE FACT THAT OTHER DATAPLOT RANDOM C NUMBER GENERATOR SUBROUTINES (NORRAN--NORMAL, C LOGRAN--LOGISTIC, ETC.) ALL MAKE USE OF INTERMEDIATE C OUTPUT FROM UNIRAN. C C NOTE--THE OUTPUT FROM THIS SUBROUTINE DEPENDS C ON THE INPUT SEED (ISEED) AND ON THE C VALUE OF MDIG. C MDIG MAY NOT BE SMALLER THAN 16. C MDIG MAY NOT BE LARGER THAN MAX INTEGER ON YOUR COMPUTER. C C NOTE--BECAUSE OF THE PREPONDERANCE OF MAINFRAMES C WHICH HAVE WORDS OF 32 BITS AND LARGER C (E.G, VAX (= 32 BITS), UNIVAC (= 36 BITS), CDC (= 60 BITS), ETC.) C MDIG HAS BEEN SET TO 32. C THUS THE SAME SEQUENCE OF RANDOM NUMBERS SHOULD RESULT C ON ALL OF THESE COMPUTERS. C C NOTE--FOR SMALLER WORD SIZE COMPUTERS (E.G., 24-BIT AND 16-BIT), C THE VALUE OF MDIG SHOULD BE CHANGED TO 24 OR 16. C IN SUCH CASE, THE OUTPUT WILL NOT BE IDENTICAL TO C THE OUTPUT WHEN MDIG = 32. C C NOTE--THE CYCLE OF THE RANDOM NUMBERS DEPENDS ON MDIG. C THE CYCLE FROM MDIG = 32 IS LONG ENOUGH FOR MOST C PRACTICAL APPLICATIONS. C IF A LONGER CYCLE IS DESIRED, THEN INCREASE MDIG. C C NOTE--THE SEED MAY BE ANY POSITIVE INTEGER. C NO APPRECIABLE DIFFERENCE IN THE QUALITY C OF THE RANDOM NUMBERS HAS BEEN NOTED C BY THE CHOICE OF THE SEED. THERE IS NO C NEED TO USE PRIMES, NOR TO USE EXCEPTIONALLY C LARGE NUMBERS, ETC. C C REFERENCES--MARSAGLIA G., "COMMENTS ON THE PERFECT UNIFORM RANDOM C NUMBER GENERATOR", UNPUBLISHED NOTES, WASH S. U. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 57-74. C WRITTEN BY--JAMES BLUE C SCIENTIFIC COMPUTING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C --DAVID KAHANER C SCIENTIFIC COMPUTING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C --GEORGE MARSAGLIA C COMPUTER SCIENCE DEPARTMENT C WASHINGTON STATE UNIVERSITY C --JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C C LANGUAGE--ANSI FORTRAN (1977) C ORIGINAL VERSION--JUNE 1972. C UPDATED --AUGUST 1974. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --NOVEMBER 1981. C UPDATED --MAY 1982. C UPDATED --MARCH 1984. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) C DIMENSION M(17) C C--------------------------------------------------------------------- C CCCCC CHARACTER*4 IFEEDB CCCCC CHARACTER*4 IPRINT C CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW CCCCC COMMON /PRINT/IFEEDB,IPRINT C C-----SAVE STATEMENTS------------------------------------------------- C SAVE I,J,M,M1,M2 C C-----DATA STATEMENTS------------------------------------------------- C DATA M(1),M(2),M(3),M(4),M(5),M(6),M(7),M(8),M(9),M(10),M(11), 1 M(12),M(13),M(14),M(15),M(16),M(17) 1/ 30788,23052,2053,19346,10646,19427,23975, 1 19049,10949,19693,29746,26748,2796,23890, 1 29168,31924,16499/ DATA M1,M2,I,J / 32767,256,5,17 / C IPR=6 C C-----START POINT----------------------------------------------------- C C ******************************************** C ** STEP 1-- ** C ** CHECK THE INPUT ARGUMENTS FOR ERRORS ** C ******************************************** C IF(N.GE.1)GOTO90 WRITE(IPR,999) 999 FORMAT(1H ) WRITE(IPR,51) 51 FORMAT(1H ,'***** ERROR IN UNIRAN--') WRITE(IPR,52) 52 FORMAT(1H ,' THE INPUT NUMBER OF OBSERVATIONS IS ', 1'NON-POSITIVE.') WRITE(IPR,53)N 53 FORMAT(1H ,' N = ',I8) GOTO9000 90 CONTINUE C C ******************************************************* C ** STEP 2-- ** C ** IF A POSITIVE INPUT SEED HAS BEEN GIVEN, ** C ** THEN THIS INDICATES THAT THE GENERATOR ** C ** SHOULD HAVE ITS INTERNAL M(.) ARRAY REDEFINED-- ** C ** DO SO IN THIS SECTION. ** C ** IF A NON-POSITIVE INPUT SEED HAS BEEN GIVEN, ** C ** THEN THIS INDICATES THAT THE GENERATOR ** C ** SHOULD CONTINUE ON FROM WHERE IT LEFT OFF, ** C ** AND THEREFORE THIS SECTION IS SKIPPED. ** C ******************************************************* C IF(ISEED.LE.0)GOTO290 C CCCCC MDIG=16 MDIG=32 C M1=2**(MDIG-2)+(2**(MDIG-2)-1) M2=2**(MDIG/2) CCCCC ISEED3=MIN0(IABS(ISEED),M1) ISEED3=IABS(ISEED) IF(M1.LT.IABS(ISEED))ISEED3=M1 IF(MOD(ISEED3,2).EQ.0)ISEED3=ISEED3-1 K0=MOD(9069,M2) K1=9069/M2 J0=MOD(ISEED3,M2) J1=ISEED3/M2 C DO200I=1,17 ISEED3=J0*K0 J1=MOD(ISEED3/M2+J0*K1+J1*K0,M2/2) J0=MOD(ISEED3,M2) M(I)=J0+M2*J1 200 CONTINUE C I=5 J=17 C 290 CONTINUE C C ************************************* C ** STEP 3-- ** C ** GENERATE THE N RANDOM NUMBERS ** C ************************************* C DO300L=1,N K=M(I)-M(J) IF(K.LT.0)K=K+M1 M(J)=K I=I-1 IF(I.EQ.0)I=17 J=J-1 IF(J.EQ.0)J=17 AK=K AM1=M1 X(L)=AK/AM1 300 CONTINUE C C ***************************************************** C ** STEP 4-- ** C ** REGARDLESS OF THE VALUE OF THE INPUT SEED, ** C ** REDEFINE THE VALUE OF ISEED UPON EXIT HERE ** C ** TO -1 WITH THE NET EFFECT THAT ** C ** IF THE USER DOES NOT REDEFINE THE SEED ** C ** VALUE BEFORE THE NEXT CALL TO THIS GENERATOR, ** C ** THEN THIS GENERATOR WILL PICK UP ** C ** WHERE IT LEFT OFF. ** C ***************************************************** C ISEED=(-1) C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE RETURN CCCCC DEBUG TRACE,INIT CCCCC AT 90 CCCCC TRACE ON END SUBROUTINE UNISF(P,SF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT UNISF C C PURPOSE--THIS SUBROUTINE COMPUTES THE SPARSITY C FUNCTION VALUE FOR THE UNIFORM (RECTANGULAR) C DISTRIBUTION ON THE UNIT INTERVAL (0,1). C THIS DISTRIBUTION HAS MEAN = 0.5 C AND STANDARD DEVIATION = SQRT(1/12) = 0.28867513. C THIS DISTRIBUTION HAS THE PROBABILITY C DENSITY FUNCTION F(X) = 1. C NOTE THAT THE SPARSITY FUNCTION OF A DISTRIBUTION C IS THE DERIVATIVE OF THE PERCENT POINT FUNCTION, C AND ALSO IS THE RECIPROCAL OF THE PROBABILITY C DENSITY FUNCTION (BUT IN UNITS OF P RATHER THAN X). C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 AND 1.0) C AT WHICH THE SPARSITY C FUNCTION IS TO BE EVALUATED. C OUTPUT ARGUMENTS--SF = THE SINGLE PRECISION SPARSITY C FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION C SPARSITY FUNCTION VALUE SF. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--P SHOULD BE BETWEEN 0.0 AND 1.0, INCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY), 1969, PAGES 21-44, 229-231. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--2, 1970, PAGES 57-74. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LT.0.0.OR.P.GT.1.0)GOTO50 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 UNISF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C SF=1.0 C RETURN END SUBROUTINE VAR(X,N,IWRITE,XVAR) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT VAR C C PURPOSE--THIS SUBROUTINE COMPUTES THE C SAMPLE VARIANCE (WITH DENOMINATOR N-1) C OF THE DATA IN THE INPUT VECTOR X. C THE SAMPLE VARIANCE = (THE SUM OF THE C SQUARED DEVIATIONS ABOUT THE SAMPLE MEAN)/(N-1). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --IWRITE = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL SUPPRESS C THE PRINTING OF THE C SAMPLE VARIANCE C AS IT IS COMPUTED; C OR (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0), C LIKE, SAY, 1) WILL CAUSE C THE PRINTING OF THE C SAMPLE VARIANCE C AT THE TIME IT IS COMPUTED. C OUTPUT ARGUMENTS--XVAR = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE VARIANCE. C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SAMPLE VARIANCE (WITH DENOMINATOR N-1). C PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO C INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR C CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--SNEDECOR AND COCHRAN, STATISTICAL METHODS, C EDITION 6, 1967, PAGE 44. C --DIXON AND MASSEY, INTRODUCTION TO STATISTICAL C ANALYSIS, EDITION 2, 1957, PAGE 38. C --MOOD AND GRABLE, 'INTRODUCTION TO THE THEORY C OF STATISTICS, EDITION 2, 1963, PAGE 171. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C AN=N IF(N.LT.1)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD XVAR=0.0 GOTO201 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XVAR=0.0 GOTO201 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE VAR SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 VAR SUBROUTINE IS NON-POSITIVE *****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE VAR SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C SUM=0.0 DO100I=1,N SUM=SUM+X(I) 100 CONTINUE XMEAN=SUM/AN SUM=0.0 DO200I=1,N SUM=SUM+(X(I)-XMEAN)**2 200 CONTINUE XVAR=SUM/(AN-1.0) C 201 IF(IWRITE.EQ.0)RETURN WRITE(IPR,999) WRITE(IPR,205)N,XVAR 205 FORMAT(1H ,27HTHE SAMPLE VARIANCE OF THE ,I6,17H OBSERVATIONS IS , 1E15.8) 999 FORMAT(1H ) RETURN END SUBROUTINE WEIB(X,N) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT WEIB C C PURPOSE--THIS SUBROUTINE PERFOMS A WEIBULL DISTRIBUTION ANALYSIS C ON THE DATA IN THE INPUT VECTOR X. C THIS ANALYSIS CONSISTS OF DETERMINING THAT PARTICULAR C WEIBULL DISTRIBUTION C WHICH BEST FITS THE DATA SET. C THE GOODNESS OF FIT CRITERION IS THE MAXIMUM PROBABILITY C PLOT CORRELATION COEFFICIENT CRITERION. C AFTER THE BEST-FIT DISTRIBUTION IS DETERMINED, C ESTIMATES ARE COMPUTED AND PRINTED OUT FOR THE C LOCATION AND SCALE PARAMETERS. C TWO PROBABILITY PLOTS ARE ALSO PRINTED OUT-- C THE BEST-FIT WEIBULL PROBABILITY PLOT C AND AN EXTREME VALUE TYPE 1 PROBABILITY PLOT C (THIS IS DUE TO THE FACT THAT AS THE WEIBULL PARAMETER C GAMMA APPROACHES INFINITY, THE WEIBULL DISTRIBUTION C APPROACHES THE EXTREME VALUE TYPE 1 DISTRIBUTION). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C OUTPUT--4 PAGES OF AUTOMATIC PRINTOUT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, WEIPLT, C EV1PLT, PLOT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT AND ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCE--FILLIBEN (1972), 'TECHNIQUES FOR TAIL LENGTH C ANALYSIS', PROCEEDINGS OF THE EIGHTEENTH C CONFERENCE ON THE DESIGN OF EXPERIMENTS IN C ARMY RESEARCH AND TESTING, PAGES 425-450. C --FILLIBEN, 'THE PERCENT POINT FUNCTION', C UNPUBLISHED MANUSCRIPT. C --JOHNSON AND KOTZ (1970), CONTINUOUS UNIVARIATE C DISTRIBUTIONS-1, PAGES 250-271. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --AUGUST 1975. C UPDATED --NOVEMBER 1975. C UPDATED --MAY 1976. C C--------------------------------------------------------------------- C CHARACTER*4 IFLAG1 CHARACTER*4 IFLAG2 CHARACTER*4 IFLAG3 C CHARACTER*4 BLANK CHARACTER*4 ALPHAM CHARACTER*4 ALPHAA CHARACTER*4 ALPHAX CHARACTER*4 ALPHAI CHARACTER*4 ALPHAN CHARACTER*4 ALPHAF CHARACTER*4 ALPHAT CHARACTER*4 ALPHAY CHARACTER*4 ALPHAG CHARACTER*4 EQUAL C DIMENSION W(3000) DIMENSION X(1) DIMENSION Y(7500),Z(7500) DIMENSION GAMTAB(50),CORR(50) DIMENSION YI(50),YS(50),T(50) DIMENSION IFLAG1(50),IFLAG2(50),IFLAG3(50) DIMENSION AINDEX(50) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(Z(1),WS(7501)) DATA BLANK,ALPHAM,ALPHAA,ALPHAX/' ','M','A','X'/ DATA ALPHAI,ALPHAN,ALPHAF,ALPHAT,ALPHAY/'I','N','F','T','Y'/ DATA ALPHAG,EQUAL/'G','='/ DATA GAMTAB(1),GAMTAB(2),GAMTAB(3),GAMTAB(4),GAMTAB(5), 1GAMTAB(6),GAMTAB(7),GAMTAB(8),GAMTAB(9),GAMTAB(10), 1GAMTAB(11),GAMTAB(12),GAMTAB(13),GAMTAB(14),GAMTAB(15), 1GAMTAB(16),GAMTAB(17),GAMTAB(18),GAMTAB(19),GAMTAB(20), 1GAMTAB(21),GAMTAB(22),GAMTAB(23),GAMTAB(24),GAMTAB(25) 1/1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12., 113.,14.,15.,16.,17.,18.,19.,20.,21.,22.,23.,24.,25./ DATA GAMTAB(26),GAMTAB(27),GAMTAB(28),GAMTAB(29),GAMTAB(30), 1GAMTAB(31),GAMTAB(32),GAMTAB(33),GAMTAB(34),GAMTAB(35), 1GAMTAB(36),GAMTAB(37),GAMTAB(38),GAMTAB(39),GAMTAB(40), 1GAMTAB(41),GAMTAB(42) 1/30.,35.,40.,45.,50.,60.,70.,80.,90.,100.,150.,200.,250., 1350.,500.,750.,1000./ DATA T(1),T(2),T(3),T(4),T(5),T(6),T(7),T(8),T(9),T(10), 1T(11),T(12),T(13),T(14),T(15),T(16),T(17),T(18),T(19),T(20) 1/1.63474,1.36116,1.34278,1.35854,1.37836,1.39657,1.41225,1.42557, 1 1.43690,1.44660, 1 1.45496,1.46223,1.46860,1.47422,1.47921,1.48368,1.48769,1.49132, 1 1.49461,1.49761/ DATA T(21),T(22),T(23),T(24),T(25),T(26),T(27),T(28),T(29),T(30), 1T(31),T(32),T(33),T(34),T(35),T(36),T(37),T(38),T(39),T(40), 1T(41),T(42),T(43) 1/1.50036,1.50288,1.50521,1.50736,1.50935,1.51748,1.52344,1.52798, 1 1.53157,1.53447, 1 1.53888,1.54206,1.54447,1.54636,1.54788,1.55248,1.55480,1.55620, 1 1.55781,1.55902, 1 1.55997,1.56044,1.62391/ DATA AINDEX(1),AINDEX(2),AINDEX(3),AINDEX(4),AINDEX(5), 1AINDEX(6),AINDEX(7),AINDEX(8),AINDEX(9),AINDEX(10), 1AINDEX(11),AINDEX(12),AINDEX(13),AINDEX(14),AINDEX(15), 1AINDEX(16),AINDEX(17),AINDEX(18),AINDEX(19),AINDEX(20), 1AINDEX(21),AINDEX(22),AINDEX(23),AINDEX(24),AINDEX(25) 1/1.,2.,3.,4.,5.,6.,7.,8.,9.,10.,11.,12., 113.,14.,15.,16.,17.,18.,19.,20.,21.,22.,23.,24.,25./ DATA AINDEX(26),AINDEX(27),AINDEX(28),AINDEX(29),AINDEX(30), 1AINDEX(31),AINDEX(32),AINDEX(33),AINDEX(34),AINDEX(35), 1AINDEX(36),AINDEX(37),AINDEX(38),AINDEX(39),AINDEX(40), 1AINDEX(41),AINDEX(42),AINDEX(43),AINDEX(44),AINDEX(45), 1AINDEX(46),AINDEX(47),AINDEX(48),AINDEX(49),AINDEX(50) 1/26.,27.,28.,29.,30.,31.,32.,33.,34.,35.,36.,37.,38., 139.,40.,41.,42.,43.,44.,45.,46.,47.,48.,49.,50./ C IPR=6 IUPPER=7500 NUMDIS=43 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO90 60 CONTINUE WRITE(IPR, 9)HOLD RETURN 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE WEIB SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 WEIB SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE WEIB SUBROUTINE HAS THE VALUE 1 *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C COMPUTE THE SAMPLE MINIMUM AND SAMPLE MAXIMUM C XMIN=X(1) XMAX=X(1) DO140I=2,N IF(X(I).LT.XMIN)XMIN=X(I) IF(X(I).GT.XMAX)XMAX=X(I) 140 CONTINUE C C COMPUTE THE PROB PLOT CORRELATION COEFFICIENTS FOR THE VARIOUS VALUES C OF GAMMA C CALL SORT(X,N,Y) CALL UNIMED(N,Z) C DO100IDIS=1,NUMDIS IF(IDIS.EQ.NUMDIS)GOTO150 A=GAMTAB(IDIS) DO110I=1,N W(I)=(-ALOG(1.0-Z(I)))**(1.0/A) 110 CONTINUE GOTO170 150 DO160I=1,N W(I)=-ALOG(ALOG(1.0/Z(I))) 160 CONTINUE C 170 SUM1=0.0 SUM2=0.0 DO200I=1,N SUM1=SUM1+Y(I) SUM2=SUM2+W(I) 200 CONTINUE YBAR=SUM1/AN WBAR=SUM2/AN SUM1=0.0 SUM2=0.0 SUM3=0.0 DO300I=1,N SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 300 CONTINUE SY=SQRT(SUM1/(AN-1.0)) CC=SUM2/SQRT(SUM3*SUM1) YSLOPE=SUM2/SUM3 YINT=YBAR-YSLOPE*WBAR CORR(IDIS)=CC YI(IDIS)=YINT YS(IDIS)=YSLOPE 100 CONTINUE C C DETERMINE THAT DISTRIBUTION WITH THE MAX PROB PLOT CORR COEFFICIENT C IDISMX=1 CORRMX=CORR(1) DO400IDIS=1,NUMDIS IF(CORR(IDIS).GT.CORRMX)IDISMX=IDIS IF(CORR(IDIS).GT.CORRMX)CORRMX=CORR(IDIS) 400 CONTINUE DO500IDIS=1,NUMDIS IFLAG1(IDIS)=BLANK IFLAG2(IDIS)=BLANK IFLAG3(IDIS)=BLANK IF(IDIS.EQ.IDISMX)GOTO550 GOTO500 550 IFLAG1(IDIS)=ALPHAM IFLAG2(IDIS)=ALPHAA IFLAG3(IDIS)=ALPHAX 500 CONTINUE C C WRITE OUT THE TABLE OF PROB PLOT CORR COEFFICIENTS FOR VARIOUS GAMMA C WRITE(IPR,998) WRITE(IPR,305) WRITE(IPR,999) WRITE(IPR,310)N WRITE(IPR,311)YBAR WRITE(IPR,312)SY WRITE(IPR,313)XMIN WRITE(IPR,314)XMAX WRITE(IPR,999) WRITE(IPR,323) WRITE(IPR,324) WRITE(IPR,325) WRITE(IPR,999) C NUMDM1=NUMDIS-1 IF(NUMDM1.LT.1)GOTO850 DO800I=1,NUMDM1 WRITE(IPR,805)GAMTAB(I),CORR(I),IFLAG1(I),IFLAG2(I),IFLAG3(I), 1YI(I),YS(I),T(I) 800 CONTINUE 850 I=NUMDIS WRITE(IPR,806)ALPHAI,ALPHAN,ALPHAF,ALPHAI,ALPHAN,ALPHAI, 1ALPHAT,ALPHAY,CORR(I),IFLAG1(I),IFLAG2(I),IFLAG3(I), 1YI(I),YS(I),T(I) C C PLOT THE PROB PLOT CORR COEFFICIENT VERSUS GAMMA VALUE INDEX C CALL PLOT(CORR,AINDEX,NUMDIS) WRITE(IPR,810)ALPHAG,ALPHAA,ALPHAM,ALPHAM,ALPHAA,EQUAL, 1GAMTAB(1),GAMTAB(12),GAMTAB(23),GAMTAB(34), 1ALPHAI,ALPHAN,ALPHAF,ALPHAI,ALPHAN,ALPHAI,ALPHAT,ALPHAY WRITE(IPR,999) WRITE(IPR,812) WRITE(IPR,813) C C IF THE OPTIMAL GAMMA IS FINITE, PLOT OUT THE WEIBULL C PROBABILITY PLOT FOR THE OPTIMAL VALUE C OF GAMMA. C IF(IDISMX.LT.NUMDIS)CALL WEIPLT(X,N,GAMTAB(IDISMX)) C C PLOT OUT AN EXTREM VALUE TYPE 1 PROBABILITY PLOT C (WHICH IS IDENTICALLY A WEIBULL PROBABILITY C WITH GAMMA = INFINITY) C CALL EV1PLT(X,N) C 998 FORMAT(1H1) 999 FORMAT(1H ) 305 FORMAT(1H ,40X,16HWEIBULL ANALYSIS) 310 FORMAT(1H ,37X,20HTHE SAMPLE SIZE N = ,I7) 311 FORMAT(1H ,34X,18HTHE SAMPLE MEAN = ,F14.7) 312 FORMAT(1H ,28X,32HTHE SAMPLE STANDARD DEVIATION = ,F14.7) 313 FORMAT(1H ,32X,21HTHE SAMPLE MINIMUM = ,F14.7) 314 FORMAT(1H ,32X,21HTHE SAMPLE MAXIMUM = ,F14.7) 323 FORMAT(1H ,85H WEIBULL PROBABILITY PLOT LOCATIO 1N SCALE TAIL LENGTH) 324 FORMAT(1H ,83H TAIL LENGTH CORRELATION ESTIMAT 1E ESTIMATE MEASURE) 325 FORMAT(1H ,37H PARAMETER (GAMMA) COEFFICIENT) 805 FORMAT(1H ,3X,F10.2,13X,F8.5,1X,3A1,2X,F14.7,2X,F14.7,3X,F10.5) 806 FORMAT(1H ,5X,8A1,13X,F8.5,1X,3A1,2X,F14.7,2X,F14.7,3X,F10.5) 810 FORMAT(1H ,12X,5A1,1X,A1,F14.7,11X,F14.7,11X,F14.7,11X,F14.7, 115X,8A1) 812 FORMAT(1H ,96HTHE ABOVE IS A PLOT OF THE 46 PROBABILITY PLOT CORRE 1LATION COEFFICIENTS (FROM THE PREVIOUS PAGE)) 813 FORMAT(1H ,16X,35HVERSUS THE 46 WEIBULL DISTRIBUTIONS) C RETURN END SUBROUTINE WEICDF(X,GAMMA,CDF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT WEICDF C C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION C FUNCTION VALUE FOR THE WEIBULL C DISTRIBUTION WITH SINGLE PRECISION C TAIL LENGTH PARAMETER = GAMMA. C THE WEIBULL DISTRIBUTION USED C HEREIN IS DEFINED FOR ALL POSITIVE X, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = GAMMA * (X**(GAMMA-1)) * EXP(-(X**GAMMA)). C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE C AT WHICH THE CUMULATIVE DISTRIBUTION C FUNCTION IS TO BE EVALUATED. C X SHOULD BE POSITIVE. C --GAMMA = THE SINGLE PRECISION VALUE C OF THE TAIL LENGTH PARAMETER. C GAMMA SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE C DISTRIBUTION FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION C FUNCTION VALUE CDF FOR THE WEIBULL DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = GAMMA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--GAMMA SHOULD BE POSITIVE. C --X SHOULD BE POSITIVE. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--EXP. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 250-271. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGE 124. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(X.LE.0.0)GOTO50 IF(GAMMA.LE.0.0)GOTO55 GOTO90 50 WRITE(IPR,4) WRITE(IPR,46)X CDF=0.0 RETURN 55 WRITE(IPR,15) WRITE(IPR,46)GAMMA CDF=0.0 RETURN 90 CONTINUE 4 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT TO THE WEICDF SUBROUTINE IS NON-POSITIVE *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 WEICDF SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C CDF=1.0-(EXP(-(X**GAMMA))) C RETURN END SUBROUTINE WEIPLT(X,N,GAMMA) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT WEIPLT C C PURPOSE--THIS SUBROUTINE GENERATES A WEIBULL C PROBABILITY PLOT C (WITH TAIL LENGTH PARAMETER VALUE = GAMMA). C THE PROTOTYPE WEIBULL DISTRIBUTION USED C HEREIN IS DEFINED FOR ALL POSITIVE X, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = GAMMA * (X**(GAMMA-1)) * EXP(-(X**GAMMA)). C AS USED HEREIN, A PROBABILITY PLOT FOR A DISTRIBUTION C IS A PLOT OF THE ORDERED OBSERVATIONS VERSUS C THE ORDER STATISTIC MEDIANS FOR THAT DISTRIBUTION. C THE WEIBULL PROBABILITY PLOT IS USEFUL IN C GRAPHICALLY TESTING THE COMPOSITE (THAT IS, C LOCATION AND SCALE PARAMETERS NEED NOT BE SPECIFIED) C HYPOTHESIS THAT THE UNDERLYING DISTRIBUTION C FROM WHICH THE DATA HAVE BEEN RANDOMLY DRAWN C IS THE WEIBULL DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = GAMMA. C IF THE HYPOTHESIS IS TRUE, THE PROBABILITY PLOT C SHOULD BE NEAR-LINEAR. C A MEASURE OF SUCH LINEARITY IS GIVEN BY THE C CALCULATED PROBABILITY PLOT CORRELATION COEFFICIENT. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --GAMMA = THE SINGLE PRECISION VALUE OF THE C TAIL LENGTH PARAMETER. C GAMMA SHOULD BE POSITIVE. C OUTPUT--A ONE-PAGE WEIBULL PROBABILITY PLOT. C PRINTING--YES. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 7500. C --GAMMA SHOULD BE POSITIVE. C OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, PLOT. C FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT, ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--FILLIBEN, 'TECHNIQUES FOR TAIL LENGTH ANALYSIS', C PROCEEDINGS OF THE EIGHTEENTH CONFERENCE C ON THE DESIGN OF EXPERIMENTS IN ARMY RESEARCH C DEVELOPMENT AND TESTING (ABERDEEN, MARYLAND, C OCTOBER, 1972), PAGES 425-450. C --HAHN AND SHAPIRO, STATISTICAL METHODS IN ENGINEERING, C 1967, PAGES 260-308. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 250-271. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--DECEMBER 1972. C UPDATED --MARCH 1975. C UPDATED --SEPTEMBER 1975. C UPDATED --NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(7500),W(7500) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)),(W(1),WS(7501)) C IPR=6 IUPPER=7500 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 IF(GAMMA.LE.0.0)GOTO60 HOLD=X(1) DO65I=2,N IF(X(I).NE.HOLD)GOTO90 65 CONTINUE WRITE(IPR, 9)HOLD RETURN 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) RETURN 60 WRITE(IPR,25) WRITE(IPR,46)GAMMA RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE WEIPLT SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 WEIPLT SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE WEIPLT SUBROUTINE HAS THE VALUE 1 *****) 25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 WEIPLT SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C-----START POINT----------------------------------------------------- C AN=N C C SORT THE DATA C CALL SORT(X,N,Y) C C GENERATE UNIFORM ORDER STATISTIC MEDIANS C CALL UNIMED(N,W) C C COMPUTE WEIBULL DISTRIBUTION ORDER STATISTIC MEDIANS C DO100I=1,N W(I)=(-ALOG(1.0-W(I)))**(1.0/GAMMA) 100 CONTINUE C C PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS. C COMPUTE THE TAIL LENGTH MEASURE OF THE DISTRIBUTION. C WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION C AND THE SAMPLE SIZE. C CALL PLOT(Y,W,N) Q=.9975 PP9975=(-ALOG(1.0-Q))**(1.0/GAMMA) Q=.0025 PP0025=(-ALOG(1.0-Q))**(1.0/GAMMA) Q=.975 PP975 =(-ALOG(1.0-Q))**(1.0/GAMMA) Q=.025 PP025 =(-ALOG(1.0-Q))**(1.0/GAMMA) TAU=(PP9975-PP0025)/(PP975-PP025) WRITE(IPR,105)GAMMA,TAU,N C C COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. C COMPUTE LOCATION AND SCALE ESTIMATES C FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. C THEN WRITE THEM OUT. C SUM1=0.0 SUM2=0.0 DO200I=1,N SUM1=SUM1+Y(I) SUM2=SUM2+W(I) 200 CONTINUE YBAR=SUM1/AN WBAR=SUM2/AN SUM1=0.0 SUM2=0.0 SUM3=0.0 DO300I=1,N SUM1=SUM1+(Y(I)-YBAR)*(Y(I)-YBAR) SUM2=SUM2+(Y(I)-YBAR)*(W(I)-WBAR) SUM3=SUM3+(W(I)-WBAR)*(W(I)-WBAR) 300 CONTINUE CC=SUM2/SQRT(SUM3*SUM1) YSLOPE=SUM2/SUM3 YINT=YBAR-YSLOPE*WBAR WRITE(IPR,305)CC,YINT,YSLOPE C 105 FORMAT(1H ,51HWEIBULL PROBABILITY PLOT WITH EXPONENT PARAMETER = , 1E17.10,1X,7H(TAU = ,E15.8,1H),11X,20HTHE SAMPLE SIZE N = ,I7) 305 FORMAT(1H ,43HPROBABILITY PLOT CORRELATION COEFFICIENT = ,F8.5,5X, 122HESTIMATED INTERCEPT = ,E15.8,3X,18HESTIMATED SLOPE = ,E15.8) C RETURN END SUBROUTINE WEIPPF(P,GAMMA,PPF) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT WEIPPF C C PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT C FUNCTION VALUE FOR THE WEIBULL C DISTRIBUTION WITH SINGLE PRECISION C TAIL LENGTH PARAMETER = GAMMA. C THE WEIBULL DISTRIBUTION USED C HEREIN IS DEFINED FOR ALL POSITIVE X, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = GAMMA * (X**(GAMMA-1)) * EXP(-(X**GAMMA)). C NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION C IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE C DISTRIBUTION FUNCTION OF THE DISTRIBUTION. C INPUT ARGUMENTS--P = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 (INCLUSIVELY) C AND 1.0 (EXCLUSIVELY)) C AT WHICH THE PERCENT POINT C FUNCTION IS TO BE EVALUATED. C --GAMMA = THE SINGLE PRECISION VALUE C OF THE TAIL LENGTH PARAMETER. C GAMMA SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--PPF = THE SINGLE PRECISION PERCENT C POINT FUNCTION VALUE. C OUTPUT--THE SINGLE PRECISION PERCENT POINT FUNCTION . C VALUE PPF FOR THE WEIBULL DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = GAMMA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--GAMMA SHOULD BE POSITIVE. C --P SHOULD BE BETWEEN 0.0 (INCLUSIVELY) C AND 1.0 (EXCLUSIVELY). C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 250-271. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGE 124. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C C--------------------------------------------------------------------- C IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(P.LT.0.0.OR.P.GE.1.0)GOTO50 IF(GAMMA.LE.0.0)GOTO55 GOTO90 50 WRITE(IPR,1) WRITE(IPR,46)P PPF=0.0 RETURN 55 WRITE(IPR,15) WRITE(IPR,46)GAMMA PPF=0.0 RETURN 90 CONTINUE 1 FORMAT(1H ,115H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 WEIPPF SUBROUTINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 WEIPPF SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C PPF=(-ALOG(1.0-P))**(1.0/GAMMA) C RETURN END SUBROUTINE WEIRAN(N,GAMMA,ISEED,X) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT WEIRAN C C PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N C FROM THE WEIBULL DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = GAMMA. C THE PROTOTYPE WEIBULL DISTRIBUTION USED C HEREIN IS DEFINED FOR ALL POSITIVE X, C AND HAS THE PROBABILITY DENSITY FUNCTION C F(X) = GAMMA * (X**(GAMMA-1)) * EXP(-(X**GAMMA)). C INPUT ARGUMENTS--N = THE DESIRED INTEGER NUMBER C OF RANDOM NUMBERS TO BE C GENERATED. C --GAMMA = THE SINGLE PRECISION VALUE OF THE C TAIL LENGTH PARAMETER. C GAMMA SHOULD BE POSITIVE. C OUTPUT ARGUMENTS--X = A SINGLE PRECISION VECTOR C (OF DIMENSION AT LEAST N) C INTO WHICH THE GENERATED C RANDOM SAMPLE WILL BE PLACED. C OUTPUT--A RANDOM SAMPLE OF SIZE N C FROM THE WEIBULL DISTRIBUTION C WITH TAIL LENGTH PARAMETER VALUE = GAMMA. C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. C RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE C OF N FOR THIS SUBROUTINE. C --GAMMA SHOULD BE POSITIVE. C OTHER DATAPAC SUBROUTINES NEEDED--UNIRAN. C FORTRAN LIBRARY SUBROUTINES NEEDED--ALOG. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN (1977) C REFERENCES--TOCHER, THE ART OF SIMULATION, C 1963, PAGES 14-15. C --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS, C 1964, PAGE 36. C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE C DISTRIBUTIONS--1, 1970, PAGES 250-271. C --HASTINGS AND PEACOCK, STATISTICAL C DISTRIBUTIONS--A HANDBOOK FOR C STUDENTS AND PRACTITIONERS, 1975, C PAGE 128. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1966) C EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS C DENOTED BY QUOTES RATHER THAN NH. C VERSION NUMBER--82.6 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --DECEMBER 1981. C UPDATED --MAY 1982. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C C--------------------------------------------------------------------- C DIMENSION X(*) C C--------------------------------------------------------------------- C CCCCC CHARACTER*4 IFEEDB CCCCC CHARACTER*4 IPRINT C CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW CCCCC COMMON /PRINT/IFEEDB,IPRINT C IPR=6 C C-----START POINT----------------------------------------------------- C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(GAMMA.LE.0.0)GOTO60 GOTO90 50 WRITE(IPR, 5) WRITE(IPR,47)N RETURN 60 WRITE(IPR,15) WRITE(IPR,46)GAMMA RETURN 90 CONTINUE 5 FORMAT(1H , 91H***** FATAL ERROR--THE FIRST INPUT ARGUMENT TO THE 1 WEIRAN SUBROUTINE IS NON-POSITIVE *****) 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 WEIRAN SUBROUTINE IS NON-POSITIVE *****) 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) C C GENERATE N UNIFORM (0,1) RANDOM NUMBERS; C CALL UNIRAN(N,ISEED,X) C C GENERATE N WEIBULL DISTRIBUTION RANDOM NUMBERS C USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD. C DO100I=1,N X(I)=(-ALOG(1.0-X(I)))**(1.0/GAMMA) 100 CONTINUE C RETURN END SUBROUTINE WIND(X,N,P1,P2,IWRITE,XWIND) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT WIND C C PURPOSE--THIS SUBROUTINE COMPUTES THE C SAMPLE WINDSORIZED MEAN C OF THE DATA IN THE INPUT VECTOR X. C THE WINDSORIZING IS SUCH THAT C THE LOWER 100*P1 % OF THE DATA IS C REPLACED BY THE SMALLEST NON-WINDSORIZED VALUE, C AND THE UPPER 100*P2 % OF THE DATA IS WINDSORIZED. C REPLACED BY THE LARGEST NON-WINDSORIZED VALUE. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C (UNSORTED OR SORTED) OBSERVATIONS. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --P1 = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 AND 1.0) C WHICH DEFINES WHAT FRACTION C OF THE LOWER ORDER STATISTICS C IS TO BE WINDSORIZED C BEFORE COMPUTING THE WINDSORIZED MEAN. C --P2 = THE SINGLE PRECISION VALUE C (BETWEEN 0.0 AND 1.0) C WHICH DEFINES WHAT FRACTION C OF THE UPPER ORDER STATISTICS C IS TO BE WINDSORIZED C BEFORE COMPUTING THE WINDSORIZED MEAN. C --IWRITE = AN INTEGER FLAG CODE WHICH C (IF SET TO 0) WILL SUPPRESS C THE PRINTING OF THE C SAMPLE WINDSORIZED MEAN C AS IT IS COMPUTED; C OR (IF SET TO SOME INTEGER C VALUE NOT EQUAL TO 0), C LIKE, SAY, 1) WILL CAUSE C THE PRINTING OF THE C SAMPLE WINDSORIZED MEAN C AT THE TIME IT IS COMPUTED. C OUTPUT ARGUMENTS--XWIND = THE SINGLE PRECISION VALUE OF THE C COMPUTED SAMPLE WINDSORIZED MEAN C WHERE 100*P1 % OF THE SMALLEST C AND 100*P2 % OF THE LARGEST C ORDERED OBSERVATIONS HAVE BEEN C WINSORIZED BEFORE COMPUTING THE C MEAN. C OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE C SAMPLE WINDSORIZED MEAN C WHERE 100*P1 % OF THE SMALLEST C AND 100*P2 % OF THE LARGEST C ORDERED OBSERVATIONS HAVE BEEN WINDSORIZED. C PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO C INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR C CONDITION EXISTS. C RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N C FOR THIS SUBROUTINE IS 15000. C --P1 SHOULD BE NON-NEGATIVE. C --P1 SHOULD BE SMALLER THAN 1.0 C --P2 SHOULD BE NON-NEGATIVE. C --P2 SHOULD BE SMALLER THAN 1.0 C --THE SUM OF P1 AND P2 SHOULD BE C SMALLER THAN 1.0. C OTHER DATAPAC SUBROUTINES NEEDED--SORT. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C REFERENCES--DAVID, ORDER STATISTICS, 1970, PAGES 126-130, 136. C --CROW AND SIDDIQUI, 'ROBUST ESTIMATION OF LOCATION', C JOURNAL OF THE AMERICAN STATISTICAL ASSOCIATION, C 1967, PAGES 357, 387. C --FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION C OF THE LOCATION PARAMETER OF A SYMMETRIC C DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION, C PRINCETON UNIVERSITY, 1969). C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE: 301-921-2315 C ORIGINAL VERSION--NOVEMBER 1975. C UPDATED --FEBRUARY 1976. C C--------------------------------------------------------------------- C DIMENSION X(1) DIMENSION Y(15000) COMMON /BLOCK2/ WS(15000) EQUIVALENCE (Y(1),WS(1)) C IPR=6 IUPPER=15000 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C AN=N IF(N.LT.1.OR.N.GT.IUPPER)GOTO50 IF(N.EQ.1)GOTO55 HOLD=X(1) DO60I=2,N IF(X(I).NE.HOLD)GOTO65 60 CONTINUE WRITE(IPR, 9)HOLD XWIND=X(1) GOTO201 50 WRITE(IPR,17)IUPPER WRITE(IPR,47)N RETURN 55 WRITE(IPR,18) XWIND=X(1) GOTO201 65 IF(P1.LT.0.0.OR.P1.GE.1.0)GOTO66 GOTO70 66 WRITE(IPR,27) WRITE(IPR,48)P1 XWIND=0.0 RETURN 70 IF(P2.LT.0.0.OR.P2.GE.1.0)GOTO71 GOTO75 71 WRITE(IPR,37) WRITE(IPR,48)P2 XWIND=0.0 RETURN 75 PSUM=P1+P2 IF(PSUM.LT.0.0.OR.PSUM.GE.1.0)GOTO76 GOTO90 76 WRITE(IPR,42) WRITE(IPR,43)P1 WRITE(IPR,44)P2 WRITE(IPR,45)PSUM XWIND=0.0 RETURN 90 CONTINUE 9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME 1NT (A VECTOR) TO THE WIND SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6 1H *****) 17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 WIND SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL * 1****) 18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME 1NT TO THE WIND SUBROUTINE HAS THE VALUE 1 *****) 27 FORMAT(1H ,121H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 WIND SUBROUTINE IS OUTSIDE THE ALLOWABLE (0.0,1.0) INTERVAL * 1****) 37 FORMAT(1H ,121H***** FATAL ERROR--THE FOURTH INPUT ARGUMENT TO THE 1 WIND SUBROUTINE IS OUTSIDE THE ALLOWABLE (0.0,1.0) INTERVAL * 1****) 42 FORMAT(1H , 46H***** FATAL ERROR--THE SUM OF INPUT ARGUMENTS , 1 58H3 AND 4 TO THE WIND SUBROUTINE IS OUTSIDE THE ALLOWABLE , 1 24H(0.0,1.0) INTERVAL *****) 43 FORMAT(1H ,37H INPUT ARGUMENT 3 , 1 19H = ,E15.8) 44 FORMAT(1H ,37H INPUT ARGUMENT 4 , 1 19H = ,E15.8) 45 FORMAT(1H ,37H INPUT ARGUMENT 3 + , 1 19HINPUT ARGUMENT 4 = ,E15.8) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) 48 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****) C C-----START POINT----------------------------------------------------- C CALL SORT(X,N,Y) C AN=N NP1=P1*AN+0.0001 ISTART=NP1+1 NP2=P2*AN+0.0001 ISTOP=N-NP2 SUM=0.0 K=0 IF(ISTART.GT.ISTOP)GOTO150 DO100I=ISTART,ISTOP K=K+1 SUM=SUM+X(I) 100 CONTINUE AK=K ANP1=NP1 ANP2=NP2 SUM=SUM+ANP1*X(ISTART) SUM=SUM+ANP2*X(ISTOP) XWIND=SUM/AN GOTO170 150 WRITE(IPR,155) 155 FORMAT(1H ,37HINTERNAL ERROR IN WIND SUBROUTINE--, 1 45HTHE START INDEX IS HIGHER THAN THE STOP INDEX) XWIND=0.0 RETURN 170 CONTINUE C 201 IF(IWRITE.EQ.0)RETURN PERP1=100.0*P1 PERP2=100.0*P2 PERP3=100.0-PERP1-PERP2 WRITE(IPR,999) WRITE(IPR,105)N,XWIND WRITE(IPR,110)PERP1,NP1 WRITE(IPR,115)PERP2,NP2 WRITE(IPR,120)PERP3,K 105 FORMAT(1H ,35HTHE SAMPLE WINDSORIZED MEAN OF THE ,I6, 1 17H OBSERVATIONS IS ,E15.8) 110 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) , 1 34HOF THE DATA WERE WINDSORIZED BELOW) 115 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) , 1 34HOF THE DATA WERE WINDSORIZED ABOVE) 120 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) , 1 45H OF THE DATA WERE UNWINDSORIZED IN THE MIDDLE) 999 FORMAT(1H ) C RETURN END SUBROUTINE WRITE(X,N,NNLINE,IWIDTH,IDEC) CCCCC FOLLOWING LINE ADDED TO MAKE THIS A DLL. DLL_EXPORT WRITE C C PURPOSE--THIS SUBROUTINE WRITES OUT THE CONTENTS C OF THE SINGLE PRECISION VECTOR X IN AN ORDERLY C AND NEAT FASHION. C THIS SUBROUTINE GIVES THE DATA ANALYST THE ABILITY C TO GET DATA OUT OF THE MACHINE WITHOUT HAVING C TO WORRY ABOUT AND SPECIFY FORMATS. C INPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR OF C OBSERVATIONS TO BE PRINTED OUT. C --N = THE INTEGER NUMBER OF OBSERVATIONS C IN THE VECTOR X. C --NNLINE = THE INTEGER VALUE C OF THE DESIRED NUMBER OF C OBSERVATIONS IN X TO APPEAR PER LINE. C --IWIDTH = THE INTEGER VALUE C OF THE LARGEST NUMBER OF C CHARACTERS THAT A VALUE IN X MAY TAKE UP C = THE DESIRED NUMBER OF INTEGER DIGITS C + THE DESIRED NUMBER OF DECIMAL DIGITS C + 1 DIGIT FOR THE SIGN C + 1 DIGIT FOR THE DECIMAL POINT. C (NO PROVISION NEED BE MADE FOR LEADING C OR TRAILING SEPARATION BLANKS--THIS IS C DONE AUTOMATICALLY BY THE SUBROUTINE.) C --IDEC = THE INTEGER VALUE C OF THE DESIRED NUMBER OF C DECIMAL DIGITS TO BE PRINTED OUT. C OUTPUT--A LISTING OF THE N VALUES OF THE DATA VECTOR X C WITH NNLINE VALUES PRINTED PER LINE, AND WITH C BLANKS AUTOMATICALLY INSERTED BETWEEN ADJACENT VALUES. C A BLANK LINE WILL APPEAR AFTER EVERY TENTH LINE. C 50 LINES OF DATA WILL APPEAR PER PRINTER PAGE. C PRINTING--YES. C RESTRICTIONS--NNLINE MUST BE 1 OR LARGER; C --IWIDTH MUST BE 2 OR LARGER; C --IWIDTH MUST BE 12 OR SMALLER; C --IDEC MUST BE 0 OR LARGER; C --IDEC MUST BE (IWIDTH-2) OR SMALLER; C --THE PRODUCT OF NNLINE AND (IWIDTH+1) MUST C BE 131 OR SMALLER. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--THE LISTED VALUES ARE TO BE READ ROW BY ROW-- C THAT IS, THE FIRST VALUE IN X APPEARS C ON ROW 1, COLUMN 1 OF THE OUTPUT, C THE SECOND VALUE IN X APPEARS ON ROW 1, COLUMN 2, C ETC. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--JUNE 1972. C UPDATED --NOVEMBER 1975. C C--------------------------------------------------------------------- C DIMENSION X(1) C IPR=6 MAXWID=12 MAXCHA=131 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C IF(N.LT.1)GOTO50 IF(NNLINE.LT.1)GOTO55 IF(IWIDTH.LT.2.OR.MAXWID.LT.IWIDTH)GOTO60 IWIDM2=IWIDTH-2 IF(IDEC.LT.0.OR.IWIDM2.LT.IDEC)GOTO65 IWIDP1=IWIDTH+1 NUMCHA=NNLINE*IWIDP1 IF(NUMCHA.GT.MAXCHA)GOTO70 GOTO90 50 WRITE(IPR,15) WRITE(IPR,47)N RETURN 55 WRITE(IPR,25) WRITE(IPR,47)NNLINE RETURN 60 WRITE(IPR,38)MAXWID WRITE(IPR,47)IWIDTH RETURN 65 WRITE(IPR,48)IWIDTH,IWIDM2 WRITE(IPR,47)IDEC RETURN 70 WRITE(IPR,71)MAXCHA WRITE(IPR,72)NNLINE,IWIDTH,NNLINE,IWIDP1,NUMCHA RETURN 90 CONTINUE 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE 1 WRITE SUBROUTINE IS NON-POSITIVE *****) 25 FORMAT(1H , 91H***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE 1 WRITE SUBROUTINE IS NON-POSITIVE *****) 38 FORMAT(1H , 98H***** FATAL ERROR--THE FOURTH INPUT ARGUMENT TO THE 1 WRITE SUBROUTINE IS OUTSIDE THE ALLOWABLE (2,,I4,16H) INTERVAL * 1****) 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****) 48 FORMAT(1H ,105H***** FATAL ERROR--THE FIFTH INPUT ARGUMENT TO THE 1 WRITE SUBROUTINE IS NEGATIVE OR EXCEEDS IWIDTH-2 (= ,I6,5H-2 = , 1I6,7H) *****) 71 FORMAT(1H ,122H***** FATAL ERROR--THE PRODUCT OF THE 3RD INPUT ARG 1UMENT TO THE WRITE SUBROUTINE AND THE (4TH INPUT ARGUMENT + 1) EXC 1EEDS ,I3,5H ****) 72 FORMAT(1H , 33H***** THE VALUE OF THE PRODUCT = ,I8,4H X (,I8,8H + 1 1) = ,I8,3H X ,I8,3H = ,I8,6H *****) C C-----START POINT----------------------------------------------------- C NLINES=((N-1)/NNLINE)+1 WRITE(IPR,998) WRITE(IPR,905)N WRITE(IPR,910)NLINES,NNLINE WRITE(IPR,999) DO300I=1,NLINES JMAX=NNLINE*I JMIN=JMAX-NNLINE+1 IF(JMAX.GT.N)JMAX=N IDECP1=IDEC+1 GOTO(101,102,103,104,105,106,107,108,109,110,111,112),IWIDTH 101 RETURN 102 GOTO120 103 GOTO(130,131),IDECP1 104 GOTO(140,141,142),IDECP1 105 GOTO(150,151,152,153),IDECP1 106 GOTO(160,161,162,163,164),IDECP1 107 GOTO(170,171,172,173,174,175),IDECP1 108 GOTO(180,181,182,183,184,185,186),IDECP1 109 GOTO(190,191,192,193,194,195,196,197),IDECP1 110 GOTO(200,201,202,203,204,205,206,207,208),IDECP1 111 GOTO(210,211,212,213,214,215,216,217,218,219),IDECP1 112 GOTO(220,221,222,223,224,225,226,227,228,229,230),IDECP1 C 120 WRITE(IPR,620)(X(J),J=JMIN,JMAX) GOTO100 130 WRITE(IPR,630)(X(J),J=JMIN,JMAX) GOTO100 131 WRITE(IPR,631)(X(J),J=JMIN,JMAX) GOTO100 140 WRITE(IPR,640)(X(J),J=JMIN,JMAX) GOTO100 141 WRITE(IPR,641)(X(J),J=JMIN,JMAX) GOTO100 142 WRITE(IPR,642)(X(J),J=JMIN,JMAX) GOTO100 150 WRITE(IPR,650)(X(J),J=JMIN,JMAX) GOTO100 151 WRITE(IPR,651)(X(J),J=JMIN,JMAX) GOTO100 152 WRITE(IPR,652)(X(J),J=JMIN,JMAX) GOTO100 153 WRITE(IPR,653)(X(J),J=JMIN,JMAX) GOTO100 160 WRITE(IPR,660)(X(J),J=JMIN,JMAX) GOTO100 161 WRITE(IPR,661)(X(J),J=JMIN,JMAX) GOTO100 162 WRITE(IPR,662)(X(J),J=JMIN,JMAX) GOTO100 163 WRITE(IPR,663)(X(J),J=JMIN,JMAX) GOTO100 164 WRITE(IPR,664)(X(J),J=JMIN,JMAX) GOTO100 170 WRITE(IPR,670)(X(J),J=JMIN,JMAX) GOTO100 171 WRITE(IPR,671)(X(J),J=JMIN,JMAX) GOTO100 172 WRITE(IPR,672)(X(J),J=JMIN,JMAX) GOTO100 173 WRITE(IPR,673)(X(J),J=JMIN,JMAX) GOTO100 174 WRITE(IPR,674)(X(J),J=JMIN,JMAX) GOTO100 175 WRITE(IPR,675)(X(J),J=JMIN,JMAX) GOTO100 180 WRITE(IPR,680)(X(J),J=JMIN,JMAX) GOTO100 181 WRITE(IPR,681)(X(J),J=JMIN,JMAX) GOTO100 182 WRITE(IPR,682)(X(J),J=JMIN,JMAX) GOTO100 183 WRITE(IPR,683)(X(J),J=JMIN,JMAX) GOTO100 184 WRITE(IPR,684)(X(J),J=JMIN,JMAX) GOTO100 185 WRITE(IPR,685)(X(J),J=JMIN,JMAX) GOTO100 186 WRITE(IPR,686)(X(J),J=JMIN,JMAX) GOTO100 190 WRITE(IPR,690)(X(J),J=JMIN,JMAX) GOTO100 191 WRITE(IPR,691)(X(J),J=JMIN,JMAX) GOTO100 192 WRITE(IPR,692)(X(J),J=JMIN,JMAX) GOTO100 193 WRITE(IPR,693)(X(J),J=JMIN,JMAX) GOTO100 194 WRITE(IPR,694)(X(J),J=JMIN,JMAX) GOTO100 195 WRITE(IPR,695)(X(J),J=JMIN,JMAX) GOTO100 196 WRITE(IPR,696)(X(J),J=JMIN,JMAX) GOTO100 197 WRITE(IPR,697)(X(J),J=JMIN,JMAX) GOTO100 200 WRITE(IPR,700)(X(J),J=JMIN,JMAX) GOTO100 201 WRITE(IPR,701)(X(J),J=JMIN,JMAX) GOTO100 202 WRITE(IPR,702)(X(J),J=JMIN,JMAX) GOTO100 203 WRITE(IPR,703)(X(J),J=JMIN,JMAX) GOTO100 204 WRITE(IPR,704)(X(J),J=JMIN,JMAX) GOTO100 205 WRITE(IPR,705)(X(J),J=JMIN,JMAX) GOTO100 206 WRITE(IPR,706)(X(J),J=JMIN,JMAX) GOTO100 207 WRITE(IPR,707)(X(J),J=JMIN,JMAX) GOTO100 208 WRITE(IPR,708)(X(J),J=JMIN,JMAX) GOTO100 210 WRITE(IPR,710)(X(J),J=JMIN,JMAX) GOTO100 211 WRITE(IPR,711)(X(J),J=JMIN,JMAX) GOTO100 212 WRITE(IPR,712)(X(J),J=JMIN,JMAX) GOTO100 213 WRITE(IPR,713)(X(J),J=JMIN,JMAX) GOTO100 214 WRITE(IPR,714)(X(J),J=JMIN,JMAX) GOTO100 215 WRITE(IPR,715)(X(J),J=JMIN,JMAX) GOTO100 216 WRITE(IPR,716)(X(J),J=JMIN,JMAX) GOTO100 217 WRITE(IPR,717)(X(J),J=JMIN,JMAX) GOTO100 218 WRITE(IPR,718)(X(J),J=JMIN,JMAX) GOTO100 219 WRITE(IPR,719)(X(J),J=JMIN,JMAX) GOTO100 220 WRITE(IPR,720)(X(J),J=JMIN,JMAX) GOTO100 221 WRITE(IPR,721)(X(J),J=JMIN,JMAX) GOTO100 222 WRITE(IPR,722)(X(J),J=JMIN,JMAX) GOTO100 223 WRITE(IPR,723)(X(J),J=JMIN,JMAX) GOTO100 224 WRITE(IPR,724)(X(J),J=JMIN,JMAX) GOTO100 225 WRITE(IPR,725)(X(J),J=JMIN,JMAX) GOTO100 226 WRITE(IPR,726)(X(J),J=JMIN,JMAX) GOTO100 227 WRITE(IPR,727)(X(J),J=JMIN,JMAX) GOTO100 228 WRITE(IPR,728)(X(J),J=JMIN,JMAX) GOTO100 229 WRITE(IPR,729)(X(J),J=JMIN,JMAX) GOTO100 230 WRITE(IPR,730)(X(J),J=JMIN,JMAX) C 100 I50=I-50*(I/50) IF(I50.EQ.0)WRITE(IPR,998) IF(I50.EQ.0)GOTO300 I10=I-10*(I/10) IF(I10.EQ.0)WRITE(IPR,999) 300 CONTINUE C C 620 FORMAT(1H ,43(F2.0,1X)) 630 FORMAT(1H ,32(F3.0,1X)) 631 FORMAT(1H ,32(F3.1,1X)) 640 FORMAT(1H ,26(F4.0,1X)) 641 FORMAT(1H ,26(F4.1,1X)) 642 FORMAT(1H ,26(F4.2,1X)) 650 FORMAT(1H ,21(F5.0,1X)) 651 FORMAT(1H ,21(F5.1,1X)) 652 FORMAT(1H ,21(F5.2,1X)) 653 FORMAT(1H ,21(F5.3,1X)) 660 FORMAT(1H ,18(F6.0,1X)) 661 FORMAT(1H ,18(F6.1,1X)) 662 FORMAT(1H ,18(F6.2,1X)) 663 FORMAT(1H ,18(F6.3,1X)) 664 FORMAT(1H ,18(F6.4,1X)) 670 FORMAT(1H ,16(F7.0,1X)) 671 FORMAT(1H ,16(F7.1,1X)) 672 FORMAT(1H ,16(F7.2,1X)) 673 FORMAT(1H ,16(F7.3,1X)) 674 FORMAT(1H ,16(F7.4,1X)) 675 FORMAT(1H ,16(F7.5,1X)) 680 FORMAT(1H ,14(F8.0,1X)) 681 FORMAT(1H ,14(F8.1,1X)) 682 FORMAT(1H ,14(F8.2,1X)) 683 FORMAT(1H ,14(F8.3,1X)) 684 FORMAT(1H ,14(F8.4,1X)) 685 FORMAT(1H ,14(F8.5,1X)) 686 FORMAT(1H ,14(F8.6,1X)) 690 FORMAT(1H ,13(F9.0,1X)) 691 FORMAT(1H ,13(F9.1,1X)) 692 FORMAT(1H ,13(F9.2,1X)) 693 FORMAT(1H ,13(F9.3,1X)) 694 FORMAT(1H ,13(F9.4,1X)) 695 FORMAT(1H ,13(F9.5,1X)) 696 FORMAT(1H ,13(F9.6,1X)) 697 FORMAT(1H ,13(F9.7,1X)) 700 FORMAT(1H ,11(F10.0,1X)) 701 FORMAT(1H ,11(F10.1,1X)) 702 FORMAT(1H ,11(F10.2,1X)) 703 FORMAT(1H ,11(F10.3,1X)) 704 FORMAT(1H ,11(F10.4,1X)) 705 FORMAT(1H ,11(F10.5,1X)) 706 FORMAT(1H ,11(F10.6,1X)) 707 FORMAT(1H ,11(F10.7,1X)) 708 FORMAT(1H ,11(F10.8,1X)) 710 FORMAT(1H ,10(F11.0,1X)) 711 FORMAT(1H ,10(F11.1,1X)) 712 FORMAT(1H ,10(F11.2,1X)) 713 FORMAT(1H ,10(F11.3,1X)) 714 FORMAT(1H ,10(F11.4,1X)) 715 FORMAT(1H ,10(F11.5,1X)) 716 FORMAT(1H ,10(F11.6,1X)) 717 FORMAT(1H ,10(F11.7,1X)) 718 FORMAT(1H ,10(F11.8,1X)) 719 FORMAT(1H ,10(F11.9,1X)) 720 FORMAT(1H ,10(F12.0,1X)) 721 FORMAT(1H ,10(F12.1,1X)) 722 FORMAT(1H ,10(F12.2,1X)) 723 FORMAT(1H ,10(F12.3,1X)) 724 FORMAT(1H ,10(F12.4,1X)) 725 FORMAT(1H ,10(F12.5,1X)) 726 FORMAT(1H ,10(F12.6,1X)) 727 FORMAT(1H ,10(F12.7,1X)) 728 FORMAT(1H ,10(F12.8,1X)) 729 FORMAT(1H ,10(F12.9,1X)) 730 FORMAT(1H ,10(F12.10,1X)) 905 FORMAT(1H ,50HTHE TOTAL NUMBER OF OBSERVATIONS PRINTED BELOW IS ,I 17) 910 FORMAT(1H ,10HTHERE ARE ,I7,10H ROWS AND ,I7,8H COLUMNS) 998 FORMAT(1H1) 999 FORMAT(1H ) RETURN END