Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0137/bank/bnk9.ban
There are 3 other files named bnk9.ban in the archive. Click here to see a list.
SUBROUTINE STDES
DIMENSION SDATA(125,20),ISDATA(125,20),ISAMP(125),IXTRA(15)
DIMENSION ISORT(13500),IDATA(125),DATA(125),NNS(18,6)
DIMENSION SORT(13500),IL(16),IU(16),DA(2),IOUT(132)
DIMENSION NDC(3),BEGRAN(25),IBEGRN(25),ENDRAN(25),IORAN(2,25)
DIMENSION IFREQ(25),PERC(25),CUMPCT(25),AXISGR(5),IDESCR(8)
EQUIVALENCE (BEGRAN,IBEGRN),(SDATA,ISDATA,ISORT,SORT)
EQUIVALENCE (MISS,AMISS),(DATA,IDATA,NNS),(VALUE,IVALUE)
COMMON /DEV/ IDLG,ICC,IBNK,IUPGR,ITMPRY
COMMON /GEN/ IPROJA,IPROGA,NV,NO,BNKNM,DATCR,NPROJR,NPROGR
COMMON /VAR/ LICVR,NHV,IV(2,30)
COMMON /OBS/ LICOB,NHO,IO(2,30)
COMMON /SEL/NS,ISEL(5,20),IIDATA(20,20)
COMMON /LSTOUT/LSTDEV,IPAGE,ONEPP
DOUBLE PRECISION BNKNM,DATCR
DATA MISS /"400000000000/
LINES=77
NTOT=0
DO 31 I=1,NHO
31 NTOT=NTOT+IO(2,I)-IO(1,I)+1
NOBASE=(NO+124)/125
CALL DATE (DA)
IF(NS.LT.1) GO TO 25
C
C SET UP FILE CONTAINING THOSE VALUES TO BE CHECKED FOR
C
NTOT=0
OPEN(UNIT=ITMPRY,DEVICE='DSK',ACCESS='SEQOUT',MODE='BINARY',
1FILE='SELECT.DAT',RECORD SIZE=126)
DO 1 I=1,NO,125
LAST=125
IF((I+124).GT.NO) LAST=NO-I+1
ILS=0
DO 2 J=1,125
2 ISAMP(J)=0
DO 3 J=1,NHO
IF(IO(2,J).LT.I) GO TO 3
IF(IO(1,J).GT.(I+124)) GO TO 5
ILS=1
LBEG=1
LEND=LAST
IF(LBEG.LT.(IO(1,J)-I+1)) LBEG=IO(1,J)-I+1
IF(LEND.GT.(IO(2,J)-I+1)) LEND=IO(2,J)-I+1
DO 4 L=LBEG,LEND
4 ISAMP(L)=1
3 CONTINUE
5 IF(ILS.EQ.0) GO TO 19
DO 6 J=1,NS
IRD=(ISEL(2,J)-1)*NOBASE+(I+124)/125+1
6 READ(IBNK#IRD)(ISDATA(L,J),L=1,125)
DO 7 K=1,LAST
IF(ISAMP(K).EQ.0) GO TO 7
J=1
17 IF(ISEL(3,J).NE.1) GO TO 20
DO 21 M=1,ISEL(5,J)
IF(IIDATA(J,M).EQ.MISS) GO TO 10
21 CONTINUE
20 IF(ISDATA(K,J).EQ.MISS) GO TO 18
10 GO TO (11,12,13,14,15,16) ISEL(3,J)
11 DO 22 M=1,ISEL(5,J)
IF(ISDATA(K,J).EQ.IIDATA(J,M)) GO TO 8
22 CONTINUE
GO TO 18
12 IF(ISDATA(K,J).LT.IIDATA(J,1)) GO TO 8
GO TO 18
13 IF(ISDATA(K,J).LE.IIDATA(J,1)) GO TO 8
GO TO 18
14 IF(ISDATA(K,J).GT.IIDATA(J,1)) GO TO 8
GO TO 18
15 IF(ISDATA(K,J).GE.IIDATA(J,1)) GO TO 8
GO TO 18
16 IF(ISDATA(K,J).NE.IIDATA(J,1)) GO TO 8
GO TO 18
18 J=J+1
IF(J.GT.NS) GO TO 23
IF(ISEL(1,J).EQ.ISEL(1,J-1)) GO TO 17
23 ISAMP(K)=0
GO TO 7
8 J=J+1
IF(J.GT.NS) GO TO 9
IF(ISEL(1,J).EQ.ISEL(1,J-1)) GO TO 8
GO TO 17
9 NTOT=NTOT+1
7 CONTINUE
19 WRITE(ITMPRY) ISAMP
1 CONTINUE
CALL RELEAS(ITMPRY)
IF(NTOT.GE.1) GO TO 27
WRITE(IDLG,28)
28 FORMAT(' SAMPLE CONTAINED NO OBSERVATIONS FOR THE ',
1'RESTRICTIONS PLACED')
CALL RELEAS(ITMPRY)
RETURN
27 OPEN(UNIT=ITMPRY,DEVICE='DSK',ACCESS='RANDIN',MODE='BINARY',
1FILE='SELECT.DAT',RECORD SIZE=126)
C
C NOW RUN DATA
C
25 IF(NTOT.LT.13500) GO TO 30
WRITE(IDLG,26)
26 FORMAT(' SAMPLE TO LARGE FOR IN CORE SORT - DISK SORT',
1' WILL BE AVAILABLE SOON')
CALL RELEAS(ITMPRY)
RETURN
30 DO 40 KI=1,NHV
KV= IV(1,KI)
41 NBLK=NOBASE*NV+1+(KV+5)/6
READ(IBNK#NBLK) IDATA
IRD=KV-((KV-1)/6)*6
ITYPE=NNS(10,IRD)+1
NAME=NNS(1,IRD)
DO 43 I=2,9
43 IDESCR(I-1)=NNS(I,IRD)
NMISS=0
X=0
X2=0
NVECT=0
DO 50 KJ=1,NHO
KO=IO(1,KJ)
42 IBLK=(KO+124)/125
IF(IBLK.EQ.NBLK) GO TO 51
NBLK=IBLK
KLBK=(IBLK-1)*125
IRD=(KV-1)*NOBASE+IBLK+1
READ(IBNK#IRD) IDATA
IF(NS.LT.1) GO TO 51
READ(ITMPRY#NBLK) ISAMP
51 KL=KO-KLBK
IF(NS.LT.1) GO TO 55
IF(ISAMP(KL).EQ.0) GO TO 60
55 IF(IDATA(KL).NE.MISS) GO TO 52
NMISS=NMISS+1
GO TO 60
52 NVECT=NVECT+1
ISORT(NVECT)=IDATA(KL)
IF(ITYPE.EQ.2) GO TO 60
SAVE=SORT(NVECT)
IF(ITYPE.EQ.3) SAVE=ISORT(NVECT)
X=X+SAVE
X2=X2+SAVE**2
60 KO=KO+1
IF(KO.LE.IO(2,KJ)) GO TO 42
50 CONTINUE
M=1
II=1
J=NVECT
71 IF(II.GE.J) GO TO 78
72 K=II
IJ=(J+II)/2
IT=ISORT(IJ)
IF(ISORT(II).LE.IT) GO TO 73
ISORT(IJ)=ISORT(II)
ISORT(II)=IT
IT=ISORT(IJ)
73 LL=J
IF(ISORT(J).GE.IT) GO TO 75
ISORT(IJ)=ISORT(J)
ISORT(J)=IT
IT=ISORT(IJ)
IF(ISORT(II).LE.IT) GO TO 75
ISORT(IJ)=ISORT(II)
ISORT(II)=IT
IT=ISORT(IJ)
GO TO 75
74 ISORT(LL)=ISORT(K)
ISORT(K)=ITT
75 LL=LL-1
IF(ISORT(LL).GT.IT) GO TO 75
ITT=ISORT(LL)
76 K=K+1
IF(ISORT(K).LT.IT) GO TO 76
IF(K.LE.LL) GO TO 74
IF((LL-II).LE.(J-K)) GO T O 77
IL(M)=II
IU(M)=LL
II=K
M=M+1
GO TO 79
77 IL(M)=K
IU(M)=J
J=LL
M=M+1
GO TO 79
78 M=M-1
IF(M.EQ.0) GO TO 90
II=IL(M)
J=IU(M)
79 IF((J-II).GE.11) GO TO 72
IF(II.EQ.1) GO TO 71
II=II-1
80 II=II+1
IF(II.EQ.J) GO TO 78
IT=ISORT(II+1)
IF(ISORT(II).LE.IT) GO TO 80
K=II
81 ISORT(K+1)=ISORT(K)
K=K-1
IF(IT.LT.ISORT(K)) GO TO 81
ISORT(K+1)=IT
GO TO 80
C
C DONE WITH SORT DO THE REST
90 IF(NVECT.LT.1) GO TO 93
IF(ITYPE.EQ.2) GO TO 93
XMEAN=X/NVECT
XVAR=0
IF(NVECT.LT.2) GO TO 91
XVAR=(NVECT*X2-X**2)/(NVECT*(NVECT-1))
91 XSTD=SQRT(XVAR)
COV=0
IF(XMEAN.NE.0) COV=(100*XSTD)/XMEAN
SEM=XSTD/SQRT(FLOAT(NVECT))
X3=0
X4=0
DO 92 I=1,NVECT
SAVE=SORT(I)
IF(ITYPE.EQ.3) SAVE=ISORT(I)
X3=(SAVE-XMEAN)**3+X3
92 X4=(SAVE-XMEAN)**4+X4
X3=X3/NVECT
X4=X4/NVECT
SKEW=0
XKUR=0
XBOT=((NVECT-1.)/NVECT)*XVAR
IF(XBOT.LE.0) GO TO 93
SKEW=X3/XBOT**1.50
XKUR=X4/XBOT**2
93 IF(ONEPP.EQ.1) GO TO 86
NLINES=1
SAVE=SORT(1)
DO 99 I=2,NVECT
IF(SAVE.EQ.SORT(I)) GO TO 99
SAVE=SORT(I)
NLINES=NLINES+1
IF(NLINES.LE.25) GO TO 99
NLINES=35
GO TO 89
99 CONTINUE
89 NLINES=12+NLINES
IF(ITYPE.NE.2) NLINES=NLINES+4
IF(NS.LT.1) GO TO 390
NLINES=NLINES+3
C THE FOLLOWING ALGORITHM IS NOT EXACT, IT IS ONLY A VERY ROUGH APPROX.
NVALUS=0
DO 391 I=1,NS
391 NVALUS=NVALUS+ISEL(5,I)
NLINES=NLINES+NS/4
NVALUS=NVALUS-NS
NLINES=NLINES+NVALUS/10
390 LINES=LINES+NLINES
IF(LINES.GT.58) GO TO 88
LINES=LINES+2
WRITE(LSTDEV,87)
87 FORMAT('0')
GO TO 98
88 LINES=NLINES+3
86 IPAGE=IPAGE+1
WRITE(LSTDEV,94) DA,IPAGE
94 FORMAT('1',2A5,6X,'BANK',19X,'W E S T E R N M I C H I G A N',
1' U N I V E R S I T Y',23X,'PAGE',I5)
WRITE(LSTDEV,95) BNKNM,DATCR,IPROJA,IPROGA
95 FORMAT('0',15X,'TAKEN FROM BANK: ',A10,5X,'CREATED ON: ',A10,5X,
1'BY PROJECT-PROGRAMMER NUMBER ',O6,', ',O6)
98 LTYPE='FLOAT'
IF(ITYPE.EQ.2) LTYPE='ALPHA'
IF(ITYPE.EQ.3) LTYPE='FIXED'
WRITE(LSTDEV,96) NAME,KV,IDESCR,LTYPE
96 FORMAT(1X,132(1H-)/'0',1X,'VARIABLE: ',A5,4X,'NUMBER: ',I4,5X,
1'DESCRIPTION:',8A5,5X,'VARIABLE TYPE: ',A5)
C
C NOW CONSTRUCT THE QUALIFIERS FOR EXPLANATION OF WHAT HAS BEEN DONE
C
IF(NS.LT.1) GO TO 128
WRITE(LSTDEV,97)
97 FORMAT('0TO BE INCLUDED IN THE SAMPLE AN OBSERVATION',
1' MUST SATISFY THE FOLLOWING RESTRICTIONS:')
I=1
IOUT(1)=' '
IOUT(2)=' '
IOUT(3)=' '
IOUT(4)=' '
IOUT(5)=' '
IPOS=6
LPARN=0
IPARN=0
DO 100 J=1,NS
IF(ISEL(1,J).NE.ISEL(1,1)) IPARN=1
100 CONTINUE
101 IF(I.EQ.NS) GO TO 104
IF(ISEL(1,I).NE.ISEL(1,I+1)) GO TO 104
IF(IPARN.EQ.0) GO TO 104
IF(I.EQ.1) GO TO 304
IF(ISEL(1,I).EQ.ISEL(1,I-1)) GO TO 104
304 IF(IPOS.LE.104) GO TO 102
WRITE(LSTDEV,305)(IOUT(L),L=1,IPOS-1)
305 FORMAT(133A1)
IPOS=6
102 IOUT(IPOS)='('
IOUT(IPOS+1)=' '
IPOS=IPOS+2
LPARN=1
104 IF(IPOS.LE.104) GO TO 307
WRITE(LSTDEV,305)(IOUT(L),L=1,IPOS-1)
IPOS=6
307 LSEL=ISEL(2,I)
NBLK=((NO+124)/125)*NV+1+(LSEL+5)/6
READ(IBNK#NBLK) IDATA
IRD=LSEL-((LSEL-1)/6)*6
DECODE(5,105,NNS(1,IRD)) (IOUT(L),L=IPOS,IPOS+4)
IOUT(IPOS+5)=' '
105 FORMAT(50A1)
106 IF(IOUT(IPOS).EQ.' ') GO TO 107
IPOS=IPOS+1
GO TO 106
107 GO TO (110,111,112,113,114,115) ISEL(3,I)
110 IOUT(IPOS)='='
GO TO 117
111 IOUT(IPOS)='<'
GO TO 117
112 IOUT(IPOS+1)='='
IOUT(IPOS)='<'
GO TO 116
113 IOUT(IPOS)='>'
GO TO 117
114 IOUT(IPOS)='>'
IOUT(IPOS+1)='='
GO TO 116
115 IOUT(IPOS)='<'
IOUT(IPOS+1)='>'
GO TO 116
116 IPOS=IPOS+1
117 IPOS=IPOS+1
DO 118 J=1,ISEL(5,I)
IF(IIDATA(I,J).NE.MISS) GO TO 119
IF(IPOS.LE.123) GO TO 308
WRITE(LSTDEV,305)(IOUT(L),L=1,IPOS-1)
IPOS=6
308 IOUT(IPOS)='M'
IOUT(IPOS+1)='I'
IOUT(IPOS+2)='S'
IOUT(IPOS+3)='S'
IOUT(IPOS+4)='I'
IOUT(IPOS+5)='N'
IOUT(IPOS+6)='G'
IPOS=IPOS+7
GO TO 319
119 GO TO (120,123,124) NNS(10,IRD)+1
120 IF(IPOS.LE.117) GO TO 309
WRITE(LSTDEV,305)(IOUT(L),L=1,IPOS-1)
IPOS=6
309 IVALUE=IIDATA(I,J)
ENCODE(15,121,NDC) VALUE
121 FORMAT(G)
DECODE(15,105,NDC) IXTRA
DO 122 K=1,15
IF(IXTRA(K).EQ.' ') GO TO 122
IOUT(IPOS)=IXTRA(K)
IPOS=IPOS+1
122 CONTINUE
318 IF(IOUT(IPOS-1).NE.'0') GO TO 319
IPOS=IPOS-1
GO TO 318
GO TO 319
123 IF(IPOS.LE.123) GO TO 310
WRITE(LSTDEV,305)(IOUT(L),L=1,IPOS-1)
IPOS=6
310 IOUT(IPOS)=1H'
DECODE(5,105,IIDATA(I,J))(IOUT(L),L=IPOS+1,IPOS+5)
IPOS=IPOS+5
321 IF(IOUT(IPOS).NE.' ') GO TO 322
IPOS=IPOS-1
GO TO 321
322 IOUT(IPOS+1)=1H'
IPOS=IPOS+2
GO TO 319
124 IF(NNS(1,IRD).EQ.'SOCSC') GO TO 126
IF(IPOS.LE.117) GO TO 311
WRITE(LSTDEV,305)(IOUT(L),L=1,IPOS-1)
IPOS=6
311 ENCODE(15,317,NDC) IIDATA(I,J)
317 FORMAT(I15)
DECODE(15,105,NDC) IXTRA
DO 125 K=1,15
IF(IXTRA(K).EQ.' ') GO TO 125
IOUT(IPOS)=IXTRA(K)
IPOS=IPOS+1
125 CONTINUE
GO TO 319
126 IF(IPOS.LE.120) GO TO 312
WRITE(LSTDEV,305)(IOUT(L),L=1,IPOS-1)
IPOS=6
312 ENCODE(9,127,NDC) IIDATA(I,J)
127 FORMAT(I9)
DECODE(9,105,NDC) (IXTRA(K),K=1,9)
DO 300 K=1,9
IF((K.NE.4).AND.(K.NE.6)) GO TO 301
IOUT(IPOS)='-'
IPOS=IPOS+1
301 IF(IXTRA(K).EQ.' ') IXTRA(K)='0'
IOUT(IPOS)=IXTRA(K)
IPOS=IPOS+1
300 CONTINUE
319 IOUT(IPOS)=','
IPOS=IPOS+1
118 CONTINUE
IOUT(IPOS-1)=' '
IF(I.EQ.NS) GO TO 303
IF(ISEL(1,I).EQ.ISEL(1,I+1)) GO TO 315
IF(LPARN.EQ.0) GO TO 103
IF(IPOS.LE.125) GO TO 306
WRITE(LSTDEV,305)(IOUT(L),L=1,IPOS-1)
IPOS=6
306 IOUT(IPOS)=')'
IOUT(IPOS+1)=' '
IPOS=IPOS+2
LPARN=0
103 IF(IPOS.LE.125) GO TO 313
WRITE(LSTDEV,305)(IOUT(L),L=1,IPOS-1)
IPOS=6
313 IOUT(IPOS)=' '
IOUT(IPOS+1)=' '
IOUT(IPOS+2)=' '
IOUT(IPOS+3)=' '
IOUT(IPOS+4)='A'
IOUT(IPOS+5)='N'
IOUT(IPOS+6)='D'
IOUT(IPOS+7)=' '
IOUT(IPOS+8)=' '
IOUT(IPOS+9)=' '
IOUT(IPOS+10)=' '
IOUT(IPOS+11)=' '
IPOS=IPOS+12
GO TO 302
315 IF(IPOS.LE.127) GO TO 314
WRITE(LSTDEV,305)(IOUT(L),L=1,IPOS-1)
IPOS=6
314 IOUT(IPOS)=' '
IOUT(IPOS+1)=' '
IOUT(IPOS+2)=' '
IOUT(IPOS+3)='O'
IOUT(IPOS+4)='R'
IOUT(IPOS+5)=' '
IOUT(IPOS+6)=' '
IOUT(IPOS+7)=' '
IOUT(IPOS+8)=' '
IPOS=IPOS+9
GO TO 302
302 I=I+1
GO TO 101
303 IF(LPARN.EQ.0) GO TO 316
IOUT(IPOS)=')'
IPOS=IPOS+1
316 WRITE(LSTDEV,305)(IOUT(L),L=1,IPOS-1)
C
C
C
128 LVECT=NVECT+NMISS
WRITE(LSTDEV,131) LVECT,NMISS,NO
131 FORMAT('0THERE WERE ',I6,' OBSERVATIONS, WHICH INCLUDED ',
1I6,' CASES OF MISSING DATA SELECTED FROM A TOTAL OF ',I7,
2' OBSERVATIONS'/)
IF(NVECT.EQ.0) GO TO 284
GO TO (136,150,137) ITYPE
136 XMODE=SORT(1)
NMODE=0
XTST=SORT(1)
NTST=0
DO 132 I=1,NVECT
IF(XTST.EQ.SORT(I)) GO TO 134
IF(NTST.LE.NMODE) GO TO 133
XMODE=XTST
NMODE=NTST
133 XTST=SORT(I)
NTST=1
GO TO 132
134 NTST=NTST+1
132 CONTINUE
IF(NTEST.GT.NMODE) XMODE=XTST
L=NVECT/2
XMEDIN=SORT(L+1)
IF((NVECT.AND.1).EQ.1) GO TO 135
XMEDIN=(SORT(L)+SORT(L+1))/2.
135 RANGE=SORT(NVECT)-SORT(1)
WRITE(LSTDEV,144) X,X2,NVECT
144 FORMAT(' SUM OF OBSERVATIONS= ',G,14X,'SUM OF OBSERVATIONS',
1' SQUARED= ',G,6X,'NUMBER OF OBSERVATIONS= ',I7)
WRITE(LSTDEV,142) XMEAN,XMEDIN,XMODE
142 FORMAT(' MEAN= ',G,29X,'MEDIAN= ',G,27X,'MODE= ',G)
WRITE(LSTDEV,143) SORT(NVECT),SORT(1),RANGE
143 FORMAT(' MAXIMUM= ',G,26X,'MINIMUM= ',G,26X,'RANGE= ',G)
GO TO 160
137 MODE=0
NMODE=0
IXTST=ISORT(1)
NTST=0
DO 138 I=1,NVECT
IF(IXTST.EQ.ISORT(I)) GO TO 139
IF(NTST.LE.NMODE) GO TO 140
MODE=IXTST
NMODE=NTST
140 IXTST=ISORT(I)
NTST=1
GO TO 138
139 NTST=NTST+1
138 CONTINUE
IF(NTST.GT.NMODE) MODE=IXTST
L=NVECT/2
XMEDIN=ISORT(L+1)
IF((NVECT.AND.1).EQ.1) GO TO 141
XMEDIN=(ISORT(L+1)+ISORT(L))/2.
141 IRANG=ISORT(NVECT)-ISORT(1)
WRITE(LSTDEV,144) X,X2,NVECT
WRITE(LSTDEV,142) XMEAN,XMEDIN,MODE
WRITE(LSTDEV,143) ISORT(NVECT),ISORT(1),IRANG
GO TO 160
150 WRITE(LSTDEV,151) ISORT(NVECT),ISORT(1)
151 FORMAT(' MAXIMUM= ',A5,36X,'MINIMUM= ',A5)
GO TO 170
160 WRITE(LSTDEV,161) SEM,XSTD,XVAR
161 FORMAT(' STANDARD ERROR OF MEAN= ',G,11X,'STANDARD DEVIATION= ',
1G,15X,'VARIANCE= ',G)
WRITE(LSTDEV,162) SKEW,COV,XKUR
162 FORMAT(' COEFFICIENT OF SKEWNESS= ',G,10X,
1'COEFFICIENT OF VARIATION= ',G,9X,'KURTOSIS= ',G)
C
C FREQUENY AND HISTOGRAM
C
170 IBEGRN(1)=ISORT(1)
IFREQ(1)=1
NOUTSZ=1
IF(NVECT.EQ.1) GO TO 210
DO 173 J=2,NVECT
IF(IBEGRN(NOUTSZ).EQ.ISORT(J)) GO TO 174
NOUTSZ=NOUTSZ+1
IF(NOUTSZ.GT.25) GO TO 175
IBEGRN(NOUTSZ)=ISORT(J)
IFREQ(NOUTSZ)=1
GO TO 173
174 IFREQ(NOUTSZ)=IFREQ(NOUTSZ)+1
173 CONTINUE
GO TO 210
175 NOUTSZ=40
DO 179 J=1,25
179 IFREQ(J)=0
GO TO (176,190,200) ITYPE
C
C FLOAT
176 RANGE=(SORT(NVECT)-SORT(1))/25
BEGRAN(1)=SORT(1)
DO 177 J=2,25
177 BEGRAN(J)=BEGRAN(J-1)+RANGE
DO 178 J=1,24
178 ENDRAN(J)=BEGRAN(J+1)
ENDRAN(25)=SORT(NVECT)
DO 180 J=1,NVECT
DO 181 L=1,25
IF(SORT(J).GE.ENDRAN(L)) GO TO 181
IFREQ(L)=IFREQ(L)+1
GO TO 180
181 CONTINUE
IFREQ(25)=IFREQ(25)+1
180 CONTINUE
GO TO 210
C
C ALPHA
190 RANGE=(SORT(NVECT)-SORT(1))/25
BEGRAN(1)=SORT(1)
DO 191 J=2,25
191 BEGRAN(J)=BEGRAN(J-1)+RANGE
DO 192 J=1,24
192 ENDRAN(J)=BEGRAN(J+1)
ENDRAN(25)=SORT(NVECT)
DO 193 J=1,25
IORAN(1,J)=' '
193 IORAN(2,J)=' '
DO 194 J=1,NVECT
DO 195 L=1,25
IF(L.EQ.25) GO TO 197
IF(SORT(J).GE.ENDRAN(L)) GO TO 195
197 IFREQ(L)=IFREQ(L)+1
IF(IFREQ(L).NE.1) GO TO 196
IORAN(1,L)=ISORT(J)
IORAN(2,L)=ISORT(J)
GO TO 194
196 IF(ISORT(J).GT.IORAN(2,L)) IORAN(2,L)=ISORT(J)
IF(ISORT(J).LT.IORAN(1,L)) IORAN(1,L)=ISORT(J)
GO TO 194
195 CONTINUE
194 CONTINUE
GO TO 210
C
C FIXED
200 IRANG=ISORT(NVECT)-ISORT(1)
IRANG=IRANG/25
IF((IRANG*25+ISORT(1)).LT.ISORT(NVECT)) IRANG=IRANG+1
IORAN(1,1)=ISORT(1)
DO 201 J=2,25
201 IORAN(1,J)=IORAN(1,J-1)+IRANG
DO 202 J=1,24
202 IORAN(2,J)=IORAN(1,J+1)-1
IORAN(2,25)=ISORT(NVECT)
DO 204 J=1,NVECT
DO 205 L=1,25
IF(ISORT(J).GT.IORAN(2,L)) GO TO 205
IFREQ(L)=IFREQ(L)+1
GO TO 204
205 CONTINUE
IFREQ(25)=IFREQ(25)+1
204 CONTINUE
C
C FIND PERCENTAGE CUM PERCENTAGE AND GRAPH IT
C
210 X=NVECT
L=NOUTSZ
IF(L.GT.25) L=25
PERC(1)=(IFREQ(1)/X)*100.
XMAX=PERC(1)
CUMPCT(1)=PERC(1)
IF(L.EQ.1) GO TO 215
DO 211 J=2,L
PERC(J)=(IFREQ(J)/X)*100.
IF(XMAX.LT.PERC(J)) XMAX=PERC(J)
211 CUMPCT(J)=CUMPCT(J-1)+PERC(J)
215 XIND=2
IF(XMAX.LE.75) XIND=1.5
IF(XMAX.LE.50) XIND=1.
IF(XMAX.LE.25) XIND=.5
IF(XMAX.LE.10) XIND=.2
IF(XMAX.LE.5) XIND=.1
DO 212 J=10,50,10
212 AXISGR(J/10)=XIND*J
WRITE(LSTDEV,213) AXISGR
213 FORMAT('0',61X,'CUMULATIVE',10X,5(F5.1,5X))
WRITE(LSTDEV,214)
214 FORMAT(12X,'VALUE',20X,'FREQUENCY',3X,'PERCENTAGE',3X,
1'PERCENTAGE',3X,'+---------+---------+---------',
2'+---------+---------+')
IF(NOUTSZ.GT.25) GO TO 250
C
C GRAPH BASED ON INDIVIDUAL VALUES
C
DO 216 J=1,NOUTSZ
L=(PERC(J)/XIND)+.5
X='X'
IF(L.LE.0) X=' '
220 GO TO (221,223,225) ITYPE
221 WRITE(LSTDEV,222) BEGRAN(J),IFREQ(J),PERC(J),CUMPCT(J),(X,K=1,L)
222 FORMAT(9X,G,13X,I7,6X,F7.3,6X,F7.3,5X,'I',50A1)
GO TO 216
223 WRITE(LSTDEV,224) BEGRAN(J),IFREQ(J),PERC(J),CUMPCT(J),(X,K=1,L)
224 FORMAT(12X,A5,20X,I7,6X,F7.3,6X,F7.3,5X,'I',50A1)
GO TO 216
225 WRITE(LSTDEV,226)IBEGRN(J),IFREQ(J),PERC(J),CUMPCT(J),(X,K=1,L)
226 FORMAT(6X,I11,20X,I7,6X,F7.3,6X,F7.3,5X,'I',50A1)
216 CONTINUE
GO TO 280
C
C GRAPH BASED ON RANGES OF VALUES
C
250 DO 251 J=1,25
L=(PERC(J)/XIND)+.5
X='X'
IF(L.LE.0) X=' '
GO TO (252,254,256) ITYPE
252 WRITE(LSTDEV,253)BEGRAN(J),ENDRAN(J),IFREQ(J),PERC(J),
1CUMPCT(J),(X,K=1,L)
253 FORMAT(1X,G,' -',G,4X,I7,6X,F7.3,6X,F7.3,5X,'I',50A1)
GO TO 251
254 IF(IFREQ(J).LT.1) GO TO 251
WRITE(LSTDEV,255) IORAN(1,J),IORAN(2,J),IFREQ(J),PERC(J),
1CUMPCT(J),(X,K=1,L)
255 FORMAT(11X,A5,' - ',A5,13X,I7,6X,F7.3,6X,F7.3,5X,'I',50A1)
GO TO 251
256 IF(IORAN(1,J).GT.ISORT(NVECT)) GO TO 251
WRITE(LSTDEV,257) IORAN(1,J),IORAN(2,J),IFREQ(J),PERC(J),
1CUMPCT(J),(X,K=1,L)
257 FORMAT(5X,I11,' -',I11,8X,I7,6X,F7.3,6X,F7.3,5X,'I',50A1)
251 CONTINUE
280 WRITE(LSTDEV,281)
281 FORMAT(37X,7('-'),31X,5('+---------'),'+')
L=25
IF(NOUTSZ.LT.L) L=NOUTSZ
NTOT=0
DO 282 I=1,L
282 NTOT=NTOT+IFREQ(I)
WRITE(LSTDEV,283) NTOT,AXISGR
283 FORMAT(37X,I7,38X,5(F5.1,5X))
284 KV=KV+1
IF(KV.LE.IV(2,KI)) GO TO 41
40 CONTINUE
IF(NS.LT.1) RETURN
CLOSE (UNIT=ITMPRY,DISPOSE='DELETE')
RETURN
END