c
c  summarize data, sorted by cow, calving date
c
      Parameter (ntr=18)
      Character*15 cow,herd,prev
      Character*8  tnam(ntr)
      Character*5  NNR
      Real*8 av(ntr,5),dx,dx2,z,w,xmin,xmax,x(ntr)
      Integer bdate,cdate,fdate,age,CE,NS,DAYS
      Integer ix(ntr)

      tnam(1)='Age Cal '
      tnam(2)='CInt    '
      tnam(3)='1st CE  '
      tnam(4)='1st NNR '
      tnam(5)='1st NS  '
      tnam(6)='1st DO  '
      tnam(7)='2nd Age '
      tnam(8)='1st CI  '
      tnam(9)='2nd CE  '
      tnam(10)='2nd NNR '
      tnam(11)='2nd NS  '
      tnam(12)='2nd DO  '
      tnam(13)='3rd Age '
      tnam(14)='2nd CI '
      tnam(15)='3rd CE '
      tnam(16)='3rd NNR'
      tnam(17)='3rd NS '
      tnam(18)='3rd DO '
      av=0.d0

      do 3 k=1,ntr
         av(k,4)=99999.0
         av(k,5)=-99999.0
 3    continue
      prev='               '
c
      open(10,file='REP01S.d',form='formatted',status='old')
      open(12,file='REP02.d',form='formatted',status='unknown')
c
      nin=0
      nout=0
 10   read(10,1010,end=99)cow,bdate,herd,cdate,age,CE,fdate,NNR,NS,DAYS
 1010 format(a15,i10,a15,i10,i5,i5,i10,a5,i5,i10)
c             15  25  40  50 55 60 70   80  90
c  -r91  -ka1a15a41a10
      nin = nin + 1
      if(cow.ne.prev)then
         prev = cow
         ix=0
         mr = 0
         kerr=0
         endif
      mr = mr + 1
      if(mr.gt.1)go to 20
c
c     first parity info
c
      kb=0
      kc1=0
      if(bdate.gt.0)call perpd2(bdate,kb)
      if(cdate.gt.0)call perpd2(cdate,kc1)
      iage = kc1 - kb
      imo = (dfloat(iage)/30.5d0)+0.500001d0
      if(imo.gt.36)kerr=kerr+1
      if(imo.lt.18)kerr=kerr+1
      if(kerr.gt.0)go to 10
      ix(1)=imo
      ix(2)=0
      ix(3)=CE
      ix(4)=0
      if(NNR.eq.'    0')ix(4)=1
      if(NNR.eq.'    1')ix(4)=2
      ix(5)=NS
      kk=DAYS
      if(kk.gt.165)kk=0
      if(kk.lt.45)kk=0
      ix(6)=kk
      iyr=cdate/10000
      icg=0
      write(12,1207)cow,bdate,mr,herd,cdate,iyr,icg,imo,(ix(L),L=1,6)
 1207 format(1x,a15,i10,i5,a15,i10,i5,i10,i5,6i8)
      nout=nout+1
c                16  26 31  46  56 61  71 76 116
c     -r125  -ka27a20a57a5
      kstar=1
      kend=6
      go to 40
c
c   2nd parity info
 20   if(mr.gt.2)go to 30
      if(kerr.gt.0)go to 10
      kc2=0
      if(cdate.gt.0)call perpd2(cdate,kc2)
      iage = kc2 - kb
      imo = (dfloat(iage)/30.5d0)+0.500001d0
      if(imo.gt.50)kerr=kerr+1
      if(imo.lt.30)kerr=kerr+1
      if(kerr.gt.0)go to 10
      ix(7)=imo
      ix(8) = kc2 - kc1
      if(ix(8).gt.500)kerr=kerr+1
      if(kerr.gt.0)go to 10
      ix(9)=CE
      ix(10)=0
      if(NNR.eq.'    0')ix(10)=1
      if(NNR.eq.'    1')ix(10)=2
      ix(11)=NS
      kk=DAYS
      if(kk.gt.165)kk=0
      if(kk.lt.45)kk=0
      ix(12)=kk
      iyr=cdate/10000
      icg=0
      write(12,1207)cow,bdate,mr,herd,cdate,iyr,icg,imo,(ix(L),L=7,12)
      nout=nout+1
      kstar=7
      kend=12
      go to 40
c
c     3rd parity info
c
 30   if(mr.gt.3)go to 10
      if(kerr.gt.0)go to 10
      kc3=0
      if(cdate.gt.0)call perpd2(cdate,kc3)
      iage = kc3 - kb
      imo = (dfloat(iage)/30.5d0)+0.500001d0
      if(imo.lt.45)kerr=kerr+1
      if(imo.gt.70)kerr=kerr+1
      if(kerr.gt.0)go to 10
      ix(13)=imo
      ix(14)=kc3 - kc2
      if(ix(14).gt.500)kerr=kerr+1
      if(kerr.gt.0)go to 10
      ix(15)=CE
      ix(16)=0
      if(NNR.eq.'    0')ix(16)=1
      if(NNR.eq.'    1')ix(16)=2
      ix(17)=NS
      kk=DAYS
      if(kk.gt.165)kk=0
      if(kk.lt.45)kk=0
      ix(18)=kk
      iyr=cdate/10000
      icg=0
      write(12,1207)cow,bdate,mr,herd,cdate,iyr,icg,imo,(ix(L),L=13,18)
      nout=nout+1
      kstar=13
      kend=18
c     
 40   do 15 k=kstar,kend
         if(ix(k).gt.0)then
            av(k,1)=av(k,1)+1.d0
            z=av(k,1)
            w=dfloat(ix(k))
            dx=w-av(k,2)
            av(k,2)=av(k,2)+(dx/z)
            dx2 = dx*(w-av(k,2))-av(k,3)
            if(w.lt.av(k,4))av(k,4)=w
            if(w.gt.av(k,5))av(k,5)=w
            if(z.gt.1.d0)then
               av(k,3)=av(k,3)+dx2/(z-1.d0)
               endif
         endif
 15   continue
      go to 10
 99   close(10)
      print 3001,nin,nout
 3001 format(1x,i10,' Records in'/1x,i10,' OUT')
c
      print 3007
 3007 format(/10x,'Trait N     Mean  SD  Min Max')
      do 55 k=1,ntr
         z=av(k,1)
         dx=av(k,2)
         dx2 = av(k,3)
         xmin = av(k,4)
         xmax = av(k,5)
         if(dx2.gt.0.d0)dx2 = dsqrt(dx2)
        print 3009,tnam(k),z,dx,dx2,xmin,xmax
 3009 format(1x,a8,f10.0,4f12.3)
 55   continue
c
      close(12)
      stop
      end
      include 'perpd2.f'