c
c    Read pedigrees  
c    Assign generation numbers to animals - for sorting
c    This program designed for very large pedigrees
c
c     Revised: Feb 21, 2020
c
c   Animal IDs are read as characters (15 maximum)
c   Format: Animal, Sire, Dam
c 
      Parameter (nam=2000000)
      Common /BIGINT/gen(nam),msir(nam),mdam(nam)
      Integer gen,msir,mdam,ka,ks,kd,ky
      Character*12 ianm, isir, idam, oid(nam), prev,
     x     sire(nam),dam(nam),blnk
      Character*3 isex
      Integer bdate
c
c  Open files - input from sort after ped01.f
c
      open(9,file='PEDA0.d',form='formatted',status='old')
      open(12,file='PEDA1.d',form='formatted',status='unknown')
      open(17,file='ped1.out',form='formatted',status='unknown')
c
c  Initialize arrays 
c
      gen = 0
      msir = 0
      mdam = 0
      oid = '                '
      sire = '                '
      blnk = '                '
      dam = '                '
      mam=0
      prev = '               '
c
c  Read in all pedigrees - sorted
c
 10   read(9,1001,end=20)ianm,bdate,isex,isir,idam
 1001 format(1x,a12,1x,i9,a3,1x,a12,1x,a12)
c
c  see if animal is already in list
c
      mam = mam + 1
      oid(mam)=ianm
      gen(mam)=1
      sire(mam) = isir
      dam(mam) = idam
      go to 10
c
 20   close(9)
      print *,mam,' Unique Animals in'
c
c  determine numbers for sires and dams
c
      do 25 k=1,mam
         isir = sire(k)
         idam = dam(k)
c         sire and dam are not missing
         if(isir.ne.blnk)then
           msir(k) = luchs(isir,oid,mam)
          endif
         if(idam.ne.blnk)then 
           mdam(k) = luchs(idam,oid,mam)
          endif
           if(k.lt.10)print *,k,'  ',isir,msir(k),mdam(k)
 25   continue   

      write(17,1701)mam
 1701 format(1x,i10,' Animals in pedigree')
c
c  Do iterations on generation numbers
c
      kpass=0
      mxgen=0
 125   merr=0
      kpass=kpass+1
      do 30 i=1,mam
c
c  check parent generation numbers
c
         kk=gen(i)
         kkp=kk+1
         if(msir(i).gt.0)then
           ksir=msir(i)
           if(kkp.gt.gen(ksir))then
               gen(ksir) = kkp
               merr = merr +1
               if(gen(ksir).gt.mxgen)mxgen=gen(ksir)
              endif
         endif

 32      if(mdam(i).gt.0)then
          kdam = mdam(i)
          if(kkp.gt.gen(kdam))then
               gen(kdam)=kkp
               merr = merr + 1
               if(gen(kdam).gt.mxgen)mxgen=gen(kdam)
            endif
         endif   
 30   continue   
      write(17,1702)kpass,merr,mxgen
 1702 format(' PedPass',i10,i10,i5)
      if(mxgen.gt.50)go to 9992
      if(merr.gt.0)go to 125
c
c  write out pedigrees for sort routine
c
 39   do 40 i=1,mam
      write(12,1400)gen(i),oid(i),sire(i),dam(i)
 1400 format(1x,i5,1x,a12,1x,a12,1x,a12)
c                6  7  19 20  32 33  45
c  -r46 -kd2a5a8a12         
 40   continue   
      go to 9995

 9991 write(17,1795) kanm, ksir, kdam
 1795  format('  Animal ID greater than nam',3i8)
      go to 9995
 9992 write(17,1796) mxgen
 1796 format('  Too many generations - a loop?',i8)
 9995 write(17,1704)
 1704 format('%%%%%%%%%%%%%%%%%%%%  End of ped01 %%%%%%%%%%')
      close(12)
      close(17)
      stop
      end

      include 'lupch.f'