FTN,L,B C C HP92403A STATISTICS PACKAGE C C SOURCE TAPE 92403-80001 REV. A C RELOC. TAPE 92403-60001 REV. A C C AUTHOR - T.A. SAPONAS C C VERSION OF DECEMBER 1973 C C SUBROUTINE HISTI(IDATA,NPTS,ISTRT,IDLTA,NHIST,I,IERR) C THIS SUBROUTINE PRODUCES A HISTOGRAM IN ARRAY "NHIST" FROM THE C DATA IN ARRAY "IDATA" DIMENSION IDATA(1),NHIST(1) NBARS = IABS(I) C C INITIALIZE ALL BARS OF THE HISTOGRAM TO ZERO DO 1 J = 1,NBARS 1 NHIST(J) = 0 IERR = 0 C C LOOP THROUGH ALL OF THE DATA DO 10 J = 1,NPTS C C COMPUTE BAR NUMBER (M = BAR NUMBER - 1) M = (IDATA(J)-ISTRT)/IDLTA C C CHECK TO SEE DATA IS IN BOUNDS OF HISTOGRAM IF(M)400,301 301 IF(M-NBARS)302,450 C C DATA GREATER THAN UPPER BOUND OF HISTOGRAM, INCREMENT IERR 450 IERR = IERR-1 C IF I>0 INCLUDE POINT IN LAST BAR COUNT, ELSE IGNORE IT M = NBARS-1 IF(I)10,402 C C DATA LESS THAN LOWER BOUND OF HISTOGRAM, INCREMENT IERR 400 IERR = IERR-1 C IF I>0 INCLUDE POINT IN FIRST BAR COUNT, ELSE IGNORE IT IF(I)10,401 401 M = 0 402 IERR = IERR+2 C C INCREMENT PROPER BAR OF HISTOGRAM 302 NHIST(M+1) = NHIST(M+1)+1 10 CONTINUE RETURN END SUBROUTINE HISTF(DATA,NPTS,START,DELTA,NHIST,I,IERR) C THIS SUBROUTINE PRODUCES A HISTOGRAM IN ARRAY "NHIST" FROM THE C DATA IN ARRAY "DATA" DIMENSION DATA(1),NHIST(1) NBARS = IABS(I) C C INITIALIZE ALL BARS OF THE HISTOGRAM TO ZERO DO 1 J = 1,NBARS 1 NHIST(J) = 0 IERR = 0 C C LOOP THROUGH ALL OF THE DATA DO 10 J = 1,NPTS C C COMPUTE BAR NUMBER (M = BAR NUMBER - 1) M = (DATA(J)-START)/DELTA C C CHECK TO SEE DATA IS IN BOUNDS OF HISTOGRAM IF(M)400,301 301 IF(M-NBARS)302,450 C C DATA GREATER THAN UPPER BOUND OF HISTOGRAM, INCREMENT IERR 450 IERR = IERR-1 C IF I>0 INCLUDE POINT IN LAST BAR COUNT, ELSE IGNORE IT M = NBARS-1 IF(I)10,402 C C DATA LESS THAN LOWER BOUND OF HISTOGRAM, INCREMENT IERR 400 IERR = IERR-1 C IF I>0 INCLUDE POINT IN FIRST BAR COUNT, ELSE IGNORE IT IF(I)10,401 401 M = 0 402 IERR = IERR +2 C C INCREMENT PROPER BAR OF HISTOGRAM 302 NHIST(M+1) = NHIST(M+1)+1 10 CONTINUE RETURN END SUBROUTINE HISTB(DATA,NPTS,START,DELTA,RHIST,I,IERR) C THIS SUBROUTINE PRODUCES A HISTOGRAM IN ARRAY "RHIST" FROM THE C DATA IN ARRAY "DATA". RHIST IS A FLOATING POINT ARRAY SO THAT C HISTB IS "BASIC CALLABLE". DIMENSION DATA(1),RHIST(1) NBARS = IABS(I) C C INITIALIZE ALL BARS OF THE HISTOGRAM TO ZERO DO 1 J = 1,NBARS 1 RHIST(J) = 0. IERR = 0 C C LOOP THROUGH ALL OF THE DATA DO 10 J = 1,NPTS C C COMPUTE BAR NUMBER (M = BAR NUMBER - 1) M = (DATA(J)-START)/DELTA C C CHECK TO SEE DATA IS IN BOUNDS OF HISTOGRAM IF(M)400,301 301 IF(M-NBARS)302,450 C C DATA GREATER THAN UPPER BOUND OF HISTOGRAM, INCREMENT IERR 450 IERR = IERR-1 C IF I>0 INCLUDE POINT IN LAST BAR COUNT, ELSE IGNORE IT M = NBARS-1 IF(I)10,402 C C DATA LESS THAN LOWER BOUND OF HISTOGRAM, INCREMENT IERR 400 IERR = IERR-1 C IF I>0 INCLUDE POINT IN FIRST BAR COUNT, ELSE IGNORE IT IF(I)10,401 401 M = 0 402 IERR = IERR +2 C C INCREMENT PROPER BAR OF HISTOGRAM 302 RHIST(M+1) = RHIST(M+1)+1. 10 CONTINUE RETURN END SUBROUTINE STATI(IDATA,NPTS,RMEAN,STDEV) C "STATI" COMPUTES THE MEAN AND STANDARD DEVIATION FROM THE MEAN C OF THE DATA IN ARRAY "IDATA". DIMENSION IDATA(1) C C CLEAR THE ACCUMULATORS FOR THE SUM AND SUM OF SQUARES SUM = 0. SUMSQ = 0. C C COMPUTE SUM AND SUM OF SQUARES OF THE DATA DO 10 J = 1,NPTS DATA = IDATA(J) SUM = SUM+DATA 10 SUMSQ = SUMSQ+DATA*DATA C C COMPUTE MEAN AND STANDARD DEVIATION RNPTS = NPTS RMEAN = SUM/RNPTS STDEV = SQRT((SUMSQ-SUM*RMEAN)/(RNPTS-1.)) END SUBROUTINE STATF(DATA,NPTS,RMEAN,STDEV) C "STATF" COMPUTES THE MEAN AND STANDARD DEVIATION FROM THE MEAN C OF THE DATA IN ARRAY "DATA". DIMENSION DATA(1) C C CLEAR THE ACCUMULATORS FOR THE SUM AND SUM OF SQUARES SUM = 0. SUMSQ = 0. C C COMPUTE SUM AND SUM OF SQUARES OF THE DATA DO 10 J = 1,NPTS SUM = SUM+DATA(J) 10 SUMSQ = SUMSQ+DATA(J)*DATA(J) C C COMPUTE MEAN AND STANDARD DEVIATION RNPTS = NPTS RMEAN = SUM/RNPTS STDEV = SQRT((SUMSQ-SUM*RMEAN)/(RNPTS-1.)) END END$ FTN,L,B SUBROUTINE INTLI(ITYPE,A,ISTRT,IDLTA,NHIST,I) C "INTLI" INITIALIZES THE HISTOGRAM AND OTHER STATISTICAL C ACCUMULATORS FOR RUNNING STATISTICS ON INTEGER DATA. C ARRAY "A" MUST BE PROVIDED FOR EACH VARIABLE FOR WHICH STATISTICS C ARE MAINTAINED. "A" MUST BE A REAL ARRAY DIMENSIONED BY 5. C THE CONTENTS OF "A" ARE AS FOLLOWS: C A(1) - RUNNING SUM OF DATA C A(2) - RUNNING SUM OF SQUARES OF DATA C A(3) - WORD 1 - NUMBER OF POINTS C WORD 2 - MODE OF STATISTICS C A(4) - WORD 1 - LOWER BOUND OF HISTOGRAM C WORD 2 - WIDTH OF EACH BAR IN HISTOGRAM C A(5) - WORD 1 - NUMBER OF BARS IN HISTOGRAM C WORD 2 - MODE OF HISTOGRAM DIMENSION A(5),N(2),NHIST(1) C C THE FOLLOWING EQUIVALENCE STATEMENT GIVES ACCESS TO THE TWO C WORDS OF THE FLOATING POINT VARIABLE "RN", WHERE IWRD1 IS THE C FIRST WORD AND IWRD2 IS THE SECOND WORD. EQUIVALENCE (RN,N,IWRD1),(N(2),IWRD2) C C INITIALIZE SUM AND SUM OF SQUARES TO 0.0 A = 0. A(2) = 0. C C INITIALIZE NUMBER OF POINTS TO 0 AND MODE OF STATISTICS TO ITYPE IWRD1 = 0 IWRD2 = ITYPE A(3) = RN C C IF ITYPE < OR = 0 THEN INITIALIZE HISTOGRAM OTHERWISE RETURN IF(ITYPE)10,10,150 10 IWRD1 = IABS(I) DO 20 J = 1,IWRD1 20 NHIST(J) = 0 C C A(5) IS SET TO NUMBER OF BARS IN HISTOGRAM AND MODE OF HISTOGRAM IWRD2 = I A(5) = RN C C A(4) IS SET TO LOWER BOUND AND WIDTH OF HISTOGRAM IWRD1 = ISTRT IWRD2 = IDLTA A(4) = RN 150 RETURN END SUBROUTINE INTLF(ITYPE,A,START,DELTA,NHIST,I) C "INTLF" INITIALIZES THE HISTOGRAM AND OTHER STATISTICAL C ACCUMULATORS FOR RUNNING STATISTICS ON FLOATING POINT DATA. C ARRAY "A" MUST BE PROVIDED FOR EACH VARIABLE FOR WHICH STATISTICS C ARE MAINTAINED. "A" MUST BE A REAL ARRAY DIMENSIONED BY 6. C THE CONTENTS OF "A" ARE AS FOLLOWS: C A(1) - RUNNING SUM OF DATA C A(2) - RUNNING SUM OF SQUARES OF DATA C A(3) - WORD 1 - NUMBER OF POINTS C WORD 2 - MODE OF STATISTICS C A(4) - LOWER BOUND OF HISTOGRAM C A(5) - WIDTH OF EACH BAR IN HISTOGRAM C A(6) - WORD 1 - NUMBER OF BARS IN HISTOGRAM C WORD 2 - MODE OF HISTOGRAM DIMENSION A(6),N(2),NHIST(1) C C THE FOLLOWING EQUIVALENCE STATEMENT GIVES ACCESS TO THE TWO C WORDS OF THE FLOATING POINT VARIABLE "RN", WHERE IWRD1 IS THE C FIRST WORD AND IWRD2 IS THE SECOND WORD. EQUIVALENCE (RN,N,IWRD1),(N(2),IWRD2) C C INITIALIZE SUM AND SUM OF SQUARES TO 0.0 A = 0. A(2) = 0. C C INITIALIZE NUMBER OF POINTS TO 0 AND MODE OF STATISTICS TO ITYPE IWRD1 = 0 IWRD2 = ITYPE A(3) = RN C C IF ITYPE < OR = 0 THEN INITIALIZE HISTOGRAM OTHERWISE RETURN IF(ITYPE)10,10,150 10 IWRD1 = IABS(I) DO 20 J = 1,IWRD1 20 NHIST(J) = 0 C C A(6) IS SET TO NUMBER OF BARS IN HISTOGRAM AND MODE OF HISTOGRAM IWRD2 = I A(6) = RN C C A(4) AND A(5) ARE SET TO LOWER BOUND AND WIDTH OF HISTOGRAM A(4) = START A(5) = DELTA 150 RETURN END SUBROUTINE RCRDI(IDATA,A,IERR,NHIST) C "RCRDI" UPDATES THE RUNNING STATISTICS BEING MAINTAINED IN C IN ARRAYS "NHIST" AND "A" WITH THE VALUE OF "IDATA". THE C FORMAT OF "A" IS DESCRIBED IN SUBROUTINE INTLI C DIMENSION A(5),N(2),NHIST(1) EQUIVALENCE (RN,N,ISTRT),(N(2),MODE,IDLTA) C C ASSUME NO ERRORS IERR = 0 C C IF THE MODE OF THE STATISTICS > = 0 THEN UPDATE THE SUM C AND SUM OF THE SQUARES OF "IDATA". RN = A(3) IF(MODE)100,200 C C UPDATE NUMBER OF POINTS, SUM AND SUM OF SQUARES 200 N = N+1 A(3) = RN DATA = IDATA A = A+DATA A(2) = A(2)+DATA*DATA C C IF THE MODE < = 0 UPDATE HISTOGRAM, OTHERWISE RETURN IF(MODE)100,100,600 C C C UPDATE HISTOGRAM C C COMPUTE BAR NUMBER (M = BAR NUMBER - 1 ) 100 RN = A(4) M = (IDATA-ISTRT)/IDLTA RN = A(5) C C CHECK TO SEE IDATA IS IN BOUNDS OF HISTOGRAM IF(M)400,301 301 IF(M-N)302,450 C C IDATA GREATER THAN UPPER BOUND OF HISTOGRAM C IF HISTOGRAM MODE > 0 INCLUDE POINT IN LAST BAR COUNT 450 M = N-1 IF(MODE)601,402 C C IDATA LESS THAN LOWER BOUND OF HISTOGRAM C IF HISTOGRAM MODE > 0 INCLUDE POINT IN FIRST BAR COUNT 400 IF(MODE)601,401 401 M = 0 402 IERR = 1 C C INCREMENT PROPER BAR OF HISTOGRAM 302 NHIST(M+1) = NHIST(M+1)+1 600 RETURN 601 IERR = -1 RETURN END SUBROUTINE RCRDF(DATA,A,IERR,NHIST) C "RCRDF" UPDATES THE RUNNING STATISTICS BEING MAINTAINED IN C IN ARRAYS "NHIST" AND "A" WITH THE VALUE OF "DATA". THE C FORMAT OF "A" IS DESCRIBED IN SUBROUTINE INTLB C DIMENSION A(6),N(2),NHIST(1) EQUIVALENCE (RN,N),(N(2),MODE) C C ASSUME NO ERRORS IERR = 0 C C IF THE MODE OF THE STATISTICS > = 0 THEN UPDATE THE SUM C AND SUM OF THE SQUARES OF "DATA". RN = A(3) IF(MODE)100,200 C C UPDATE NUMBER OF POINTS, SUM AND SUM OF SQUARES 200 N = N+1 A(3) = RN A = A+DATA A(2) = A(2)+DATA*DATA C C IF THE MODE < = 0 UPDATE HISTOGRAM, OTHERWISE RETURN IF(MODE)100,100,600 C C C UPDATE HISTOGRAM C C COMPUTE BAR NUMBER (M = BAR NUMBER - 1 ) 100 M = (DATA-A(4))/A(5) RN = A(6) C C CHECK TO SEE DATA IS IN BOUNDS OF HISTOGRAM IF(M)400,301 301 IF(M-N)302,450 C C DATA GREATER THAN UPPER BOUND OF HISTOGRAM C IF HISTOGRAM MODE > 0 INCLUDE POINT IN LAST BAR COUNT 450 M = N-1 IF(MODE)601,402 C C DATA LESS THAN LOWER BOUND OF HISTOGRAM C IF HISTOGRAM MODE > 0 INCLUDE POINT IN FIRST BAR COUNT 400 IF(MODE)601,401 401 M = 0 402 IERR = 1 C C INCREMENT PROPER BAR OF HISTOGRAM 302 NHIST(M+1) = NHIST(M+1)+1 600 RETURN 601 IERR = -1 RETURN END SUBROUTINE REPRT(A,RMEAN,STDEV,NUM) C C "REPRT" COMPUTES MEAN AND STANDARD DEVIATION FROM THE C SUM, SUM OF SQUARES AND NUMBER OF POINTS CONTAINED C IN ARRAY "A". DIMENSION A(3) C C THIS EQUIVALENCE ALLOWS ACCESS TO THE FIRST WORD OF A FLOATING C POINT NUMBER. EQUIVALENCE (RN,N) C C THE FIRST WORD OF A(3) IS THE NUMBER OF POINTS RN = A(3) NUM = N RN = N RMEAN = A/RN STDEV = SQRT((A(2)-A*RMEAN)/(RN-1.)) RETURN END END$ FTN,L,B SUBROUTINE INTLB(ITYPE,A,START,DELTA,RHIST,I) C "INTLB" INITIALIZES THE HISTOGRAM AND OTHER STATISTICAL C ACCUMULATORS FOR RUNNING STATISTICS ON FLOATING POINT DATA. C ARRAY "A" MUST BE PROVIDED FOR EACH VARIABLE FOR WHICH STATISTICS C ARE MAINTAINED. "A" MUST BE A REAL ARRAY DIMENSIONED BY 6. C THE CONTENTS OF "A" ARE AS FOLLOWS: C A(1) - RUNNING SUM OF DATA C A(2) - RUNNING SUM OF SQUARES OF DATA C A(3) - WORD 1 - NUMBER OF POINTS C WORD 2 - MODE OF STATISTICS C A(4) - LOWER BOUND OF HISTOGRAM C A(5) - WIDTH OF EACH BAR IN HISTOGRAM C A(6) - WORD 1 - NUMBER OF BARS IN HISTOGRAM C WORD 2 - MODE OF HISTOGRAM DIMENSION A(6),N(2),RHIST(1) C C THE FOLLOWING EQUIVALENCE STATEMENT GIVES ACCESS TO THE TWO C WORDS OF THE FLOATING POINT VARIABLE "RN", WHERE IWRD1 IS THE C FIRST WORD AND IWRD2 IS THE SECOND WORD. EQUIVALENCE (RN,N,IWRD1),(N(2),IWRD2) C C INITIALIZE SUM AND SUM OF SQUARES TO 0.0 A = 0. A(2) = 0. C C INITIALIZE NUMBER OF POINTS TO 0 AND MODE OF STATISTICS TO ITYPE IWRD1 = 0 IWRD2 = ITYPE A(3) = RN C C IF ITYPE < OR = 0 THEN INITIALIZE HISTOGRAM OTHERWISE RETURN IF(ITYPE)10,10,150 10 IWRD1 = IABS(I) DO 20 J = 1,IWRD1 20 RHIST(J) = 0 C C A(6) IS SET TO NUMBER OF BARS IN HISTOGRAM AND MODE OF HISTOGRAM IWRD2 = I A(6) = RN C C A(4) AND A(5) ARE SET TO LOWER BOUND AND WIDTH OF HISTOGRAM A(4) = START A(5) = DELTA 150 RETURN END SUBROUTINE RCRDB(DATA,A,IERR,RHIST) C "RCRDB" UPDATES THE RUNNING STATISTICS BEING MAINTAINED IN C IN ARRAYS "RHIST" AND "A" WITH THE VALUE OF "DATA". THE C FORMAT OF "A" IS DESCRIBED IN SUBROUTINE INTLF C DIMENSION A(6),N(2),RHIST(1) EQUIVALENCE (RN,N),(N(2),MODE) C C ASSUME NO ERRORS IERR = 0 C C IF THE MODE OF THE STATISTICS > = 0 THEN UPDATE THE SUM C AND SUM OF THE SQUARES OF "DATA". RN = A(3) IF(MODE)100,200 C C UPDATE NUMBER OF POINTS, SUM AND SUM OF SQUARES 200 N = N+1 A(3) = RN A = A+DATA A(2) = A(2)+DATA*DATA C C IF THE MODE < = 0 UPDATE HISTOGRAM, OTHERWISE RETURN IF(MODE)100,100,600 C C C UPDATE HISTOGRAM C C COMPUTE BAR NUMBER (M = BAR NUMBER - 1 ) 100 M = (DATA-A(4))/A(5) RN = A(6) C C CHECK TO SEE DATA IS IN BOUNDS OF HISTOGRAM IF(M)400,301 301 IF(M-N)302,450 C C DATA GREATER THAN UPPER BOUND OF HISTOGRAM C IF HISTOGRAM MODE > 0 INCLUDE POINT IN LAST BAR COUNT 450 M = N-1 IF(MODE)601,402 C C DATA LESS THAN LOWER BOUND OF HISTOGRAM C IF HISTOGRAM MODE > 0 INCLUDE POINT IN FIRST BAR COUNT 400 IF(MODE)601,401 401 M = 0 402 IERR = 1 C C INCREMENT PROPER BAR OF HISTOGRAM 302 RHIST(M+1) = RHIST(M+1)+1. 600 RETURN 601 IERR = -1 RETURN END END$