Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-09 - 43,50466/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