program testpdgtonew
c
c  test pdgtonew translation routine
c
      implicit none

#include "stdlun.inc"
#include "pdgtbl.inc"

      integer idold1,idold2,idnew1,idnew2,itmp1,itmp2
      integer i,j,k,l,m

      integer pdgtonew
      external pdgtonew
c
      lnhout = 6
      lnhdcy = 24
c...special cases
      write(lnhout,1001)
      do i=1,99
        idold1=i
        idold2=-i
        idnew1=pdgtonew(idold1,1)
        if(idnew1.gt.0)then
          idnew2=pdgtonew(idold2,1)
          itmp1=pdgtonew(idnew1,2)
          if(idnew2.eq.0)then
            write(lnhout,1101) idold1,idnew1,itmp1
          else
            itmp2=pdgtonew(idnew2,2)
            write(lnhout,1102) idold1,idnew1,itmp1,idold2,idnew2,itmp2
          endif
        endif
      enddo
c...diquarks
      do i=1,3
        do j=1,2
          do k=1,3,2
              idold1 = i*1000 + j*100 + k
              idold2 = -idold1
              idnew1 = pdgtonew(idold1,1)
              if(idnew1.gt.0)then
        	idnew2=pdgtonew(idold2,1)
        	itmp1=pdgtonew(idnew1,2)
        	if(idnew2.eq.0)then
        	  write(lnhout,1101) idold1,idnew1,itmp1
        	else
        	  itmp2=pdgtonew(idnew2,2)
        	  write(lnhout,1102) 
     1        	        idold1,idnew1,itmp1,idold2,idnew2,itmp2
        	endif
              endif
          enddo
        enddo
      enddo
c...meson not in table
      idold1 = 30221
      idold2 = -idold1
      idnew1 = pdgtonew(idold1,1)
      if(idnew1.gt.0)then
        idnew2=pdgtonew(idold2,1)
        itmp1=pdgtonew(idnew1,2)
        if(idnew2.eq.0)then
          write(lnhout,1101) idold1,idnew1,itmp1
        else
          itmp2=pdgtonew(idnew2,2)
          write(lnhout,1102) idold1,idnew1,itmp1,idold2,idnew2,itmp2
        endif
      endif
c...baryons not in table
      idold1 = 14122
      idold2 = -idold1
      idnew1 = pdgtonew(idold1,1)
      if(idnew1.gt.0)then
        idnew2=pdgtonew(idold2,1)
        itmp1=pdgtonew(idnew1,2)
        if(idnew2.eq.0)then
          write(lnhout,1101) idold1,idnew1,itmp1
        else
          itmp2=pdgtonew(idnew2,2)
          write(lnhout,1102) idold1,idnew1,itmp1,idold2,idnew2,itmp2
        endif
      endif
      idold1 = 4332
      idold2 = -idold1
      idnew1 = pdgtonew(idold1,1)
      if(idnew1.gt.0)then
        idnew2=pdgtonew(idold2,1)
        itmp1=pdgtonew(idnew1,2)
        if(idnew2.eq.0)then
          write(lnhout,1101) idold1,idnew1,itmp1
        else
          itmp2=pdgtonew(idnew2,2)
          write(lnhout,1102) idold1,idnew1,itmp1,idold2,idnew2,itmp2
        endif
      endif
c...check the PDG table
      write(lnhout,1002)
      call pdgrdtb
      do i=1,nmxln2
        idold1 = idpdg(i)
        if(idold1 .ne. 0)then
          idold2 = -idold1
          idnew1 = pdgtonew(idold1,1)
          if(idnew1.gt.0)then
            idnew2=pdgtonew(idold2,1)
            itmp1=pdgtonew(idnew1,2)
            if(idnew2.eq.0)then
              write(lnhout,1103) pdname(i),idold1,idnew1,itmp1
            else
              itmp2=pdgtonew(idnew2,2)
              write(lnhout,1104) 
     1              pdname(i),idold1,idnew1,itmp1,idold2,idnew2,itmp2
            endif
          endif
        endif
      enddo

 1001 format(//5x,'PDG96 new scheme',4x,'PDG96',
     1         7x,'PDG96 new scheme',4x,'PDG96')
 1101 format(1x,3i10)
 1102 format(1x,3i10,2x,3i10)
 1002 format(//27x,'PDG96 new scheme',4x,'PDG96',
     1         7x,'PDG96 new scheme',4x,'PDG96')
 1103 format(1x,a21,1x,3i10)
 1104 format(1x,a21,1x,3i10,2x,3i10)
      end