SUBROUTINE HIST(X,N) 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