c
c  match master pedigree file with data file
c   trim pedigrees down to essential animals
c
      parameter(nam=2000000)

      character*12 anim(nam),sire(nam),dam(nam),ia,is,id
      character*12 prev,blnk
      character*3 isex,asex(nam)
      integer bdate,mark(nam),genr(nam)
c
c  read in PED01.d
c
      mam=0
      open(10,file='PED01.d',form='formatted',status='old')
      open(15,file='PEDA0.d',form='formatted',status='unknown')
      sire = '               '
      dam = '               '
      anim = '               '
      prev = '               '
      asex='   '
      blnk = prev
      mark=0
      mam=0

 10   read(10,1010,end=50)ia,bdate,isex,is,id
 1010 format(1x,a12,1x,i9,a3,1x,a12,1x,a12)
c  -r53
      mam = mam + 1
       anim(mam) = ia
        sire(mam) = is
         dam(mam) = id
         asex(mam)=isex
         genr(mam)=bdate
      go to 10
 50   close(10)
      print *,mam,' Animals in, pedigree'
      mamp=mam+1
      nob=0
      nor=0
      prev='            '
      open(12,file='TYP07.d',form='formatted',status='old')
 20   read(12,1212,end=60)ia
 1212 format(1x,a12)
      nor=nor+1
      if(ia.ne.prev)then
         ka=luchs(ia,anim,mam)
         if(ka.eq.0)then
           print *,ia,' not in pedigrees'
           else
             if(mark(ka).eq.0)then
              mark(ka)=10
              nob=nob+1
             endif
         endif
         prev = ia
      endif
      go to 20
 60   close(12)
      print *,nob,' Animals in, data'
      print *,nor,' Records in, data'
c
c  loop through to find all parents
c
      nloop=0
      nout=0
 65   madd=0
      nloop=nloop+1
      if(nloop.gt.10)go to 80
      do 70 ja=1,mam
       if(mark(ja).lt.5)go to 70
       is = sire(ja)
       id = dam(ja)
       if(is.eq.blnk)go to 75
       ks=luchs(is,anim,mam)
        if(ks.eq.0)go to 75
          if(mark(ks).gt.0)go to 75
          mark(ks)=10
          madd=madd+1
         
 75    if(id.eq.blnk)go to 70
       kd=luchs(id,anim,mam)
        if(kd.eq.0)go to 70
         if(mark(kd).gt.0)go to 70
         mark(kd)=10
         madd = madd + 1
 70    continue
       print *,nloop,madd,' Loops'
       if(madd.gt.0)go to 65  
c     save all essential animals
       nout=0
 80    do 83 ja=1,mam
       if(mark(ja).gt.0)then
        ia = anim(ja)
         is = sire(ja)
          id = dam(ja)
           bdate = genr(ja)
            isex = asex(ja)
          write(15,1010)ia,bdate,isex,is,id
          nout=nout+1
         endif
 83     continue
c
      print *,nout,' Pedigrees out'
      close(15)
      stop
      end
      include 'lupch.f'