hist(3f) - [M_datapac:STATISTICS] generates histograms based on two
different class widths
SUBROUTINE HIST(X,N)
REAL(kind=wp),intent(in) :: X(:)
INTEGER,intent(in) :: N
HIST(3f) produces 2 histograms (with differing class widths) of the
data in the input vector X.
The first histogram has class width = 0.1 sample standard deviations;
the second histogram has class width = 0.2 sample standard deviations.
Two histograms of the same data set are printed out so as to give
the data analyst some feel for how dependent the histogram shape is
as a function of the class width and number of classes.
X The vector of (unsorted or sorted) observations.
N The integer number of observations in the vector X.
One page of automatic printout consisting of 2 half-page histograms (with
class widths = 0.1 and 0.2 sAmple standard deviations, respectively)
of the data in the input vector X.
Sample program:
program demo_hist
use M_datapac, only : hist
implicit none
real,allocatable :: x(:)
integer :: i
integer :: n
x=[(real(i),i=1,100)]
n=size(x)
call hist(x,n)
end program demo_hist
Results:
The original DATAPAC library was written by James Filliben of the
Statistical Engineering Division, National Institute of Standards
and Technology.
John Urban, 2022.05.31
CC0-1.0
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| real(kind=wp), | intent(in) | :: | X(:) | |||
| integer, | intent(in) | :: | N |
| Type | Attributes | Name | Initial | |||
|---|---|---|---|---|---|---|
| integer | :: | IGRaph(55,130) |
SUBROUTINE HIST(X,N) REAL(kind=wp),intent(in) :: X(:) INTEGER,intent(in) :: N REAL(kind=wp) :: acount, ai, amaxfr, an, cwidsd, cwidth, height, hold, prop, s, sum, tinc, tlable, xbar, xmax, xmin, z INTEGER :: i, icoun2, icount, ievodd, ihist, inc, irev, itlabl, ixlabl, j, jmax, jp1, jsum, maxfre, mt, mx, numcla, numhis INTEGER :: numout CHARACTER(len=4) :: blank , hyphen , alphai , alphax CHARACTER(len=4) :: IGRaph DIMENSION ixlabl(21) COMMON /BLOCK1/ IGRaph(55,130) DIMENSION icount(121) , icoun2(121) DIMENSION tlable(13) , itlabl(13) DATA blank , hyphen , alphai , alphax/' ' , '-' , 'I' , 'X'/ ! ! CHECK THE INPUT ARGUMENTS FOR ERRORS ! IF ( N<1 ) THEN WRITE (G_IO,99001) 99001 FORMAT (' ***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO HIST(3f) IS NON-POSITIVE *****') WRITE (G_IO,99002) N 99002 FORMAT (' ','***** THE VALUE OF THE ARGUMENT IS ',I0,' *****') RETURN ELSE IF ( N==1 ) THEN WRITE (G_IO,99003) 99003 FORMAT (' ***** FATAL ERROR-- THE SECOND INPUT ARGUMENT TO HIST(3f) HAS THE VALUE 1 *****') RETURN ELSE hold = X(1) DO i = 2 , N IF ( X(i)/=hold ) GOTO 50 ENDDO WRITE (G_IO,99004) hold 99004 FORMAT (' ***** FATAL DIAGNOSTIC--THE FIRST INPUT ARGUMENT (A VECTOR) TO HIST(3f) HAS ALL ELEMENTS = ',& & E15.8,' *****') RETURN ENDIF ! !-----START POINT----------------------------------------------------- ! 50 continue numhis = 2 an = N ! ! FIND THE MINIMUM AND THE MAXIMUM xmin = X(1) xmax = X(1) DO i = 1 , N IF ( X(i)<xmin ) xmin = X(i) IF ( X(i)>xmax ) xmax = X(i) ENDDO ! ! COMPUTE THE SAMPLE MEAN AND SAMPLE STANDARD DEVIATION ! sum = 0.0_wp DO i = 1 , N sum = sum + X(i) ENDDO xbar = sum/an sum = 0.0_wp DO i = 1 , N sum = sum + (X(i)-xbar)**2 ENDDO s = SQRT(sum/(an-1.0_wp)) ! ! FORM THE BASIC FREQUENCY TABLE (ICOUNT) WHICH CORRESPONDS TO A HISTOGRAM ! WITH 121 CLASSES AND A CLASS WIDTH OF ONE TENTH A SAMPLE STANDARD ! DEVIATION. ! DO i = 1 , 121 icount(i) = 0 ENDDO ! numout = 0 DO i = 1 , N z = (X(i)-xbar)/s mt = 10.0_wp*(z+6.0_wp) + 2.5_wp IF ( mt<2 .OR. mt>122 ) numout = numout + 1 IF ( mt>=2 .AND. mt<=122 ) icount(mt) = icount(mt) + 1 ENDDO ! ! LOOP THROUGH NUMHIS (= 2) HISTOGRAMS ! NOTE THAT NUMHIS WAS PREVIOUSLY SET TO 6 (BEFORE JANUARY 1975) ! DO ihist = 1 , numhis ! ! ZERO OUT THE MINI-GRAPH ! DO i = 1 , 22 DO j = 1 , 123 IGRaph(i,j) = blank ENDDO ENDDO ! ! PRODUCE THE HORIZONTAL AXES ! DO j = 2 , 122 IGRaph(1,j) = hyphen IGRaph(22,j) = hyphen ENDDO DO j = 2 , 122 , 10 IGRaph(1,j) = alphai IGRaph(22,j) = alphai ENDDO ! ! PRODUCE THE VERTICAL AXES ! DO i = 2 , 21 IGRaph(i,1) = alphai IGRaph(i,123) = alphai ENDDO DO i = 2 , 21 , 5 IGRaph(i,1) = hyphen IGRaph(i,123) = hyphen ENDDO inc = ihist IF ( ihist==4 ) inc = 5 IF ( ihist==5 ) inc = 10 IF ( ihist==6 ) inc = 20 ! ! FORM THE FREQUENCY TABLE FOR THIS PARTICULAR HISTOGRAM ! icoun2(1) = icount(1) DO i = 2 , 121 , inc jmax = i + inc - 1 jsum = 0 DO j = i , jmax jsum = jsum + icount(j) ENDDO DO j = i , jmax icoun2(j) = jsum ENDDO ENDDO ! ! DETERMINE THE MAXIMUM FREQUENCY ! maxfre = icoun2(1) DO i = 1 , 121 IF ( icoun2(i)>maxfre ) maxfre = icoun2(i) ENDDO ! ! DETERMINE THE PLOT POSITIONS ! amaxfr = maxfre height = 20.0_wp DO j = 1 , 121 jp1 = j + 1 IF ( maxfre<=20 ) mx = icoun2(j) IF ( maxfre>20 ) THEN acount = icoun2(j) prop = acount/amaxfr mx = prop*height + 0.999_wp ENDIF IF ( mx/=0 ) THEN DO i = 1 , mx irev = 22 - i IGRaph(irev,jp1) = alphax ENDDO ENDIF IF ( icoun2(j)>=1 ) IGRaph(21,jp1) = alphax ENDDO ! ! DETERMINE THE X VALUES TO BE LISTED ON THE LEFT LEFT VERTICAL AXIS ! IF ( maxfre>=21 ) THEN DO i = 1 , 20 irev = 22 - i ai = i prop = ai/20.0_wp ixlabl(irev) = prop*amaxfr + 0.5_wp ENDDO ELSE DO i = 1 , 20 irev = 22 - i ixlabl(irev) = i ENDDO ENDIF ! ! WRITE EVERYTHING OUT ! ievodd = ihist - 2*(ihist/2) IF ( ievodd==0 ) THEN WRITE (G_IO,99005) 99005 FORMAT (' ') ELSE WRITE (G_IO,99006) 99006 FORMAT ('1') ENDIF WRITE (G_IO,99013) (IGRaph(1,j),j=1,123) 99013 FORMAT (' ',6X,123A1) DO i = 2 , 21 WRITE (G_IO,99007) ixlabl(i) , (IGRaph(i,j),j=1,123) 99007 FORMAT (' ',I5,1X,123A1) ENDDO WRITE (G_IO,99013) (IGRaph(22,j),j=1,123) numcla = (120/inc) + 1 tinc = inc cwidsd = tinc*0.1_wp cwidth = cwidsd*s tlable(7) = xbar itlabl(7) = 0 DO i = 1 , 6 irev = 13 - i + 1 ai = i tlable(i) = xbar - (7.0_wp-ai)*s tlable(irev) = xbar + (7.0_wp-ai)*s itlabl(i) = i - 7 itlabl(irev) = 7 - i ENDDO WRITE (G_IO,99008) (tlable(i),i=1,13) 99008 FORMAT (' ',1X,12F10.4,F9.4) WRITE (G_IO,99009) (itlabl(i),i=1,13) 99009 FORMAT (' ',13(1X,I7,2X)) WRITE (G_IO,99010) numout 99010 FORMAT (' ',I0, & & ' OBSERVATIONS WERE IN EXCESS OF 6 SAMPLE STANDARD DEVIATIONS ABOUT THE SAMPLE MEAN AND SO WERE NOT PLOTTED') WRITE (G_IO,99011) numcla , cwidth , cwidsd 99011 FORMAT (' HISTOGRAM THE NUMBER OF CLASSES IS ',I0,& & 8X,'THE CLASS WIDTH IS ',E15.8,' = ',F7.1,' STANDARD DEVIATIONS') WRITE (G_IO,99012) N 99012 FORMAT (' ','THE SAMPLE SIZE N = ',I0) ENDDO ENDIF END SUBROUTINE HIST