PROGRAM listprn
      IMPLICIT REAL*8(A-H,O-Z)
      IMPLICIT INTEGER*4(I-N)
      parameter (np0=100,nf0=1000)
      DIMENSION par(nf0,np0),ave(np0),itypep(np0),dev(np0),rms(np0)
      logical lex
C     
      WRITE(6,*)'LIST.PRN - correcting periodic angles + statistic'

      inquire(file='LIST.PAR',exist=lex)
      if(.not.lex)call report(' LIST.PAR not found.')
      open(45,file='LIST.PAR')
      read(45,*)nag
      if(nag.gt.np0)call report(' Too many parameters')
      do 21 iag=1,nag
      read(45,*)
21    read(45,*)itypep(iag)
      close(45)

      open(32,file='LIST.PRN')
3     read(32,*,end=22,err=22)nf,(par(nf,ii),ii=1,nag)
      if(nf+1.gt.nf0)call report('too many sets')
      goto 3
22    close(32)

c
      do 1 ii=1,nag

c     original period (0..360):
      ave1=0.0d0
      do 2 jj=1,nf
2     ave1=ave1+par(jj,ii)
      ave1=ave1/dble(nf)
      dev1=0.0d0
      rms1=0.0d0
      do 25 jj=1,nf
      rms1=rms1+(par(jj,ii)-ave1)**2
25    dev1=dev1+abs(par(jj,ii)-ave1)

c     trial period (-180..180):
      ave2=0.0d0
      do 26 jj=1,nf
      p=par(jj,ii)
      if(p.gt.180.0d0)p=p-360.0d0
26    ave2=ave2+p
      ave2=ave2/dble(nf)
      dev2=0.0d0
      rms2=0.0d0
      do 27 jj=1,nf
      p=par(jj,ii)
      if(p.gt.180.0d0)p=p-360.0d0
      rms2=rms2+(p-ave2)**2
27    dev2=dev2+abs(p-ave2)
      if(dev2.lt.dev1)then
       ave(ii)=ave2
       rms(ii)=dsqrt(rms2/dble(nf))
       dev(ii)=dev2/dble(nf)
      else
       ave(ii)=ave1
       rms(ii)=dsqrt(rms1/dble(nf))
       dev(ii)=dev1/dble(nf)
      endif
1     continue      
c
c     record everything within -180..180
      open(32,file='LISTC.PRN')
      do 4 j=1,nf
      write(32,321)j
321   format(i6,$)
      do 41 i=1,nag
      p=par(j,i)
      if(p.gt. 180.0d0)p=p-360.0d0
      if(p.lt.-180.0d0)p=p+360.0d0
41    write(32,322)p
322   format(F10.3,$)
4     write(32,*)
      write(32,*)
      write(32,323)
323   format('AVERAG',$)
      do 42 i=1,nag
      if(ave(i).gt. 180.0d0)ave(i)=ave(i)-360.0d0
      if(ave(i).lt.-180.0d0)ave(i)=ave(i)+360.0d0
42    write(32,322)ave(i)
      write(32,*)
      write(32,3231)
3231  format('AVEDEV',$)
      do 43 i=1,nag
43    write(32,322)dev(i)
      write(32,*)
      write(32,3232)
3232  format('RMSDEV',$)
      do 44 i=1,nag
44    write(32,322)rms(i)
      write(32,*)
      close(32)

      write(6,*)'LISTC.PRN - angles corrected'
      end

      subroutine report(s)
      character*(*) s
      write(6,*)s
      stop
      end