C....*...1.........2.........3.........4.........5.........6.........7.*.......8 C HIST 7/18/72 C C PURPOSE C PLOTS THE SMOOTHED HISTOGRAM OF A GIVEN SAMPLE ON THE PRINTER C C USAGE C CALL HIST(A,N) C C SUBROUTINES CALLED C POLISH C C ARGUMENTS C A - VECTOR CONTAINING THE N SAMPLE VALUES C REAL*8 C N - LENGTH OF N C INTEGER C SUBROUTINE HIST(A,N) implicit real*8 (a-h,o-z) save LOGICAL*1 LINE(104),STAR,BLANK,SLASH,DASH,PLUS INTEGER ABC(11),COUNT(50),DUMMY(80) REAL*8 A(1),HST(50),LCL,UCL,MAX,MIN,DEL REAL*8 PRINT(13) EQUIVALENCE (PRINT(1),LINE(1)),(DUMMY(16),COUNT(1)) DATA STAR,BLANK,SLASH,DASH,PLUS/'*',' ','|','-','+'/ MAX=A(1) MIN=A(1) DO 10 I=1,N IF(A(I).GT.MAX) MAX=A(I) 10 IF(A(I).LT.MIN) MIN=A(I) CALL POLISH(MAX,MIN,50.d0) DEL=(MAX-MIN)/50.d0 DO 20 I=1,80 20 DUMMY(I)=0 LCL=MIN DO 30 I=1,N 30 IF(A(I).EQ.LCL) COUNT(1)=COUNT(1)+1 DO 40 J=1,50 LCL=MIN+DEL*(J-1) UCL=LCL+DEL IF(J.EQ.50) UCL=MAX DO 40 I=1,N 40 IF((LCL.LT.A(I)).AND.(A(I).LE.UCL)) COUNT(J)=COUNT(J)+1 S=1.d2/N DO 45 I=1,50 45 HST(I)=COUNT(I)*S MAX=0.d0 DO 50 I=1,50 50 IF(HST(I).GT.MAX) MAX=HST(I) IF((0.d0.LE.MAX).AND.(MAX.LE.1.d1)) ISW=1 IF((1.d1.LT.MAX).AND.(MAX.LE.2.d1)) ISW=2 IF((2.d1.LT.MAX).AND.(MAX.LE.5.d1)) ISW=5 IF((5.d1.LT.MAX).AND.(MAX.LE.1.1d2)) ISW=10 K=0 IF(ISW.EQ.1) K=2 IF(ISW.EQ.2) K=1 IF(K.EQ.0) GO TO 65 LW=2*K+1 S=LW*N DO 60 I=1,50 SUM=0.d0 DO 55 JJ=1,LW J=JJ-K-1 55 SUM=SUM+COUNT(I-J) 60 HST(I)=(SUM/S)*1.d2 65 CONTINUE DO 80 I=1,11 80 ABC(I)=ISW*(I-1) WRITE(3,1) (ABC(I),I=1,11) DO 90 I=102,104 90 LINE(I)=BLANK DO 100 I=1,101 LINE(I)=DASH 100 IF(MOD((I-1),10).EQ.0) LINE(I)=PLUS WRITE(3,4) (PRINT(I),I=1,12),(LINE(I),I=97,101) LCL=MIN SCLE=10.d0/ISW DO 150 I=1,50 KK=HST(I)*SCLE+.5d0 LINE(1)=SLASH DO 120 J=2,104 120 LINE(J)=BLANK IF(KK.EQ.0) GO TO 140 KK=KK+1 DO 130 J=2,KK 130 LINE(J)=STAR 140 LCL=MIN+DEL*(I-1) UCL=LCL+DEL 150 WRITE(3,3) LCL,UCL,COUNT(I),(PRINT(J),J=1,12),(LINE(J),J=97,101) DO 160 I=1,101 LINE(I)=DASH 160 IF(MOD((I-1),10).EQ.0) LINE(I)=PLUS WRITE(3,4) (PRINT(I),I=1,12),(LINE(I),I=97,101) WRITE(3,2) (ABC(I),I=1,11) RETURN 1 FORMAT('1'//// ' LOWER UPPER ' * / ' CLASS CLASS PERCENT' * / ' LIMIT LIMIT COUNT',I2,10(7X,I3)) 2 FORMAT( ' ',I2,10(7X,I3)) 3 FORMAT(' ',E11.3,E12.3,I5,2X,12A8,5A1) 4 FORMAT(' ',30X,12A8,5A1) END