program spreads
c
c		statistics on grades
c
	real*4 thresh(4)
	integer*4 imark(7), ith(4)
	integer*4 igrad(500),ihist(1000)
	real*4 fnumin(20)
	character*12 filnam
	character*1 prplt(70,60),csym
	character*131 linin,linp
	character*80 linout
	character*1 clino(80)
	character*1 clinin(131),clinp(131)
	integer*1 itest,jtest
	character*1 ctest,dtest
	equivalence (clinin(1),linin),(clinp(1),linp)
	equivalence (ctest,itest),(dtest,jtest)
	equivalence (linout,clino(1))
	data thresh /.88,.78,.65,.5/
c
	kgm=1
	do 5 i=1,1000
    5	ihist(i)=0
c
	write (*,*) ' input file name, column to take, max grade'
	filnam='a1001.grades'
	jcol=8
	kgmax=123
	read (*,*) filnam, jcol,kgmax
	open(15,name=filnam,status='old',form='formatted',
     1		access='sequential')
c
	iln=0
	do 30  iln2=1,500
	iln=iln+1
	do 10  icol=1,131
   10	clinin(icol)=' '
c
	read (15,105,end=35) linin
  105	format (a131)
c
	ipc=1
	do 15 icol=1,110
	  ctest=clinin(icol)
c	 if (iln.eq.11) write (*,*) icol,itest,'=',ctest,'='
c	 if (iln.eq.11) read (*,*) kjunk
	  dtest=clinin(icol+1)
	  if (itest.ne.9) go to 12
	  clinp(ipc)=' '
	  if (jtest.ne.9) go to 12
	  ipc=ipc+1
	  clinp(ipc)='0'
c	  ipc=ipc+1
c	  clinp(ipc)=' '
	  go to 15
   12	continue
	  clinp(ipc)=clinin(icol)
	  if (ipc.gt.125) go to 17
   15	ipc=ipc+1
c
	do 16 icol=111,129,2
	  clinp(ipc)=' '
	  ipc=ipc+1
	  if (ipc.gt.125) go to 17
	  clinp(ipc)='0'
   16	  ipc=ipc+1
   17	continue
c
c	write (*,105) linin
c	write (*,*) ' padded line',iln
c	write (*,105) linp
c
	read(linp,*,end=34) (fnumin(k),k=1,jcol)
c	if (iln.lt.5) write (*,*) (fnumin(k),k=1,jcol)
	igrad(iln)=fnumin(jcol)
	if (igrad(iln).eq.0) iln=iln-1
c	  if (iln.lt.5) write (*,*) 'input',iln,igrad(iln),jcol
   30	continue
	write (*,*) ' warning - file not exhausted'
   34	write (*,*) ' eof on internal read',iln,fnumin(icol)
   35	nst=iln-1
	write (*,*) nst, ' students total'
	write (24,*) nst, ' students total'
c
	igmx=igrad(1)
	igmn=igrad(1)
	sum=0.
	sumsq=0.
	do 40  i=1,nst
	  if (igrad(i).gt.igmx) igmx=igrad(i)
	  if (igrad(i).lt.igmn) igmn=igrad(i)
	  k=igrad(i)
	  if (k.gt.1000) k=1000
	  if (k.lt.1) k=1
	  ihist(k)=ihist(k)+1
	  sum=sum+igrad(i)
	  sumsq=sumsq+igrad(i)**2
   40	continue
c
	xn=nst
	xbar=sum/xn
	sig=sqrt((sumsq - xn*(xbar**2))/(xn-1))
	write (*,*) ' statistics :  xbar, sigma=',xbar,sig
	write (24,*) ' statistics :  xbar, sigma=',xbar,sig
	write (*,*) ' max, min : ',igmx,igmn
	write (24,*) ' max, min : ',igmx,igmn
	ihmx=ihist(igmn)
	do 42 i=igmn,igmx
c	 write (*,*) 'ihist(',i,')',ihist(i)
	 if (ihist(i).gt.ihmx) ihmx=ihist(i)
   42	continue
c
	fntot=0.
	i25=0
	i50=0
	i75=0
	hmax=ihist(igmn)
	do 50  i=igmn,igmx
	  fntot=fntot+ihist(i)
	  if ((fntot.gt.(xn*.25)).and.(i25.eq.0))  i25=i
	  if ((fntot.gt.(xn*.5)).and.(i50.eq.0))  i50=i
	  if ((fntot.gt.(xn*.75)).and.(i75.eq.0))  i75=i
	  if (ihist(i).gt.hmax) hmax=ihist(i)
   50	continue
	write (*,*) ' percentiles :  25',i25,'  50',i50,'  75',i75
	write (24,*) ' percentiles :  25',i25,'  50',i50,'  75',i75
c
	xfac=(1+igmx-igmn)/70.
	xfac=.9999+xfac
	ixfac=xfac
	xfac=ixfac
	xfac=1./xfac
	yfac=hmax/60.
	yfac=yfac+.9999
	iyfac=yfac
	yfac=iyfac
	yfac=1./yfac
c
   51	continue
	numa=0
	numb=0
	numc=0
	numd=0
	numf=0
	do 52  k=1,4
	 x= kgmax*thresh(k)
	 ith(k)=x 
   52	continue
c
	 do 55 ix=1,70
	  do 53 iy=1,60
	  prplt(ix,iy)=' '
   53	  continue
	  ihx = igmx+ix-70
	  csym='F'
	  if (ihx.gt.ith(4)) csym='D'
	  if (ihx.gt.ith(3)) csym='C'
	  if (ihx.gt.ith(2)) csym='B'
	  if (ihx.gt.ith(1)) csym='A'
	  if (csym.eq.'F') numf=numf+ihist(ihx)
	  if (csym.eq.'D') numd=numd+ihist(ihx)
	  if (csym.eq.'C') numc=numc+ihist(ihx)
	  if (csym.eq.'B') numb=numb+ihist(ihx)
	  if (csym.eq.'A') numa=numa+ihist(ihx)
c	  ihx=ix+igmn
	  if (ihx.gt.igmx) go to 55
	  if (ihx.lt.igmn) go to 55
	  ihy=ihist(ihx)
	  if (ihy.lt.1) go to 55
	  if (ihy.gt.60) ihy=60
	  do 54 k=1,ihy
	    prplt(ix,k)=csym
   54	  continue
   55	continue
	kx=igmx-70
	if (kx.le.igmn) go to 156
	do 155 ihx=igmn, kx
	  csym='F'
	  if (ihx.gt.ith(4)) csym='D'
	  if (ihx.gt.ith(3)) csym='C'
	  if (ihx.gt.ith(2)) csym='B'
	  if (ihx.gt.ith(1)) csym='A'
	  if (csym.eq.'F') numf=numf+ihist(ihx)
	  if (csym.eq.'D') numd=numd+ihist(ihx)
	  if (csym.eq.'C') numc=numc+ihist(ihx)
	  if (csym.eq.'B') numb=numb+ihist(ihx)
	  if (csym.eq.'A') numa=numa+ihist(ihx)
  155	continue
  156	continue
c
	do 56 icol=1,80
   56	clino(icol)=' '
	m7=(2+igmx)/10
	imark(7)=10*m7
	ifmt=2+igmx-imark(7)
	ifmt=ifmt+110
	if (ifmt.gt.119) ifmt=119
	if (ifmt.lt.110) ifmt=110
	do 57 k=1,6
	  j=7-k
	  imark(j)=imark(j+1)-10
   57	continue
	if ((kgm.le.0).and.(ifmt.eq.119))
     1		write (24,119) (imark(k),k=1,7)
	if (ifmt.eq.119)write (*,119) (imark(k),k=1,7)
	if ((kgm.le.0).and.(ifmt.eq.118)
     1		)write (24,118) (imark(k),k=1,7)
	if (ifmt.eq.118)write (*,118) (imark(k),k=1,7)
	if ((kgm.le.0).and.(ifmt.eq.117)
     1		)write (24,117) (imark(k),k=1,7)
	if (ifmt.eq.117)write (*,117) (imark(k),k=1,7)
	if ((kgm.le.0).and.(ifmt.eq.116)
     1		)write (24,116) (imark(k),k=1,7)
	if (ifmt.eq.116)write (*,116) (imark(k),k=1,7)
	if ((kgm.le.0).and.(ifmt.eq.115)
     1		)write (24,115) (imark(k),k=1,7)
	if (ifmt.eq.115)write (*,115) (imark(k),k=1,7)
	if ((kgm.le.0).and.(ifmt.eq.114)
     1		)write (24,114) (imark(k),k=1,7)
	if (ifmt.eq.114)write (*,114) (imark(k),k=1,7)
	if ((kgm.le.0).and.(ifmt.eq.113)
     1		)write (24,113) (imark(k),k=1,7)
	if (ifmt.eq.113)write (*,113) (imark(k),k=1,7)
	if ((kgm.le.0).and.(ifmt.eq.112)
     1		)write (24,112) (imark(k),k=1,7)
	if (ifmt.eq.112)write (*,112) (imark(k),k=1,7)
	if ((kgm.le.0).and.(ifmt.eq.111)
     1		)write (24,111) (imark(k),k=1,7)
	if (ifmt.eq.111)write (*,111) (imark(k),k=1,7)
	if ((kgm.le.0).and.(ifmt.eq.110)
     1		)write (24,110) (imark(k),k=1,7)
	if (ifmt.eq.110)write (*,110) (imark(k),k=1,7)
  110	format (9x,7(7x,i3))
  111	format (8x,7(7x,i3))
  119	format (7x,7(i3,7x))
  118	format (7x,7(1x,i3,6x))
  117	format (7x,7(2x,i3,5x))
  116	format (7x,7(3x,i3,4x))
  115	format (7x,7(4x,i3,3x))
  114	format (7x,7(5x,i3,2x))
  113	format (7x,7(6x,i3,1x))
  112	format (7x,7(7x,i3))
c	write (*,*)' ifmt ',ifmt
c
	do 58  icol=1,79
	clino(icol)='-'
	k=icol-7
	if (k.le.0) go to 58
	k1=igmx+k-70
	if (mod(k1,5).eq.0) clino(icol)='+'
	if (mod(k1,10).eq.0) clino(icol)='|'
   58	continue
	if (kgm.le.0) write (24,106) linout
	write (*,106) linout
  106	format (a80)
c
	if (ihmx.gt.60) ihmx=60
	do 60 i=1,ihmx
	  iy=1+ihmx-i
	if ((kgm.le.0).and. (mod(iy,10).eq.0))
     1		 write (24,102)	iy,(prplt(k,iy),k=1,70)
	  if (mod(iy,10).eq.0) write (*,102) 
     1		iy,(prplt(k,iy),k=1,70)
  102	  format (1x,i4,2x,70a1)
	  if (mod(iy,10).eq.0) go to 60
	if (kgm.le.0) write (24,101) (prplt(k,iy),k=1,70)
	  write (*,101) (prplt(k,iy),k=1,70)
  101	  format (7x,70a1)
   60	continue
	if (kgm.le.0) write (24,106) linout
	write (*,106) linout
	if (kgm.le.0) write (24,*)
	write (*,*)
	if (kgm.le.0) write (24,122) numa,numb,numc,numd,numf
	write (*,122) numa,numb,numc,numd,numf
  122	format (' numbers of  As=',i3,'  Bs=',i3,
     1		'  Cs=',i3,'  Ds=',i3,'  Fs=',i3)
	ftot=numa+numb+numc+numd+numf
	fa=numa
	fa=fa/ftot
	fb=numb
	fb=fb/ftot
	fc=numc
	fc=fc/ftot
	fd=numd
	fd=fd/ftot
	ff=numf
	ff=ff/ftot
	if (kgm.le.0) write (24,121) fa,fb,fc,fd,ff
	write (*,121) fa,fb,fc,fd,ff
  121	format (' fraction of As=',f4.2,' Bs=',f4.2,
     1		' Cs=',f4.2,' Ds=',f4.2,' Fs=',f4.2)
	if (kgm.le.0) go to 62
	write (*,*) 'above computed using max score=',kgmax
	write (*,*) 'to change, enter new max score:'
	write (*,*) 'to save, enter 0:'
	read (*,*) kgm
	if (kgm.gt.0) kgmax=kgm
	go to 51
c
c	write (*,*) igmn,igmx,'igmn,igmx'
c	do 62 i=igmn,igmx
c	 write (*,*) 'ihist(',i,')',ihist(i)
   62	continue
	write (*,*) ' statistics written to file fort.24'
	stop
	end