C
C Locus structure:
C number of loci, locus name, locus type, and locus position in file
C loctype 1=marker 2=quant 3=affection 4-6=deleted
C
C     integer nloci
C     character*10 loc(MAXLOC)
C     integer loctyp(MAXLOC),locpos(MAXLOC)
C
C position of locus on sex-averaged linkage map
C
C     real map(MAXLOC)
C
C jth name 1=marker
C 
C third fourth first fifth second $m
C   6    7  8   9     10    11    12 13  14 15  16 17  18 19
C
        elseif (keyword.eq.'ord') then
          pos1=0
          pos2=0
          do 302 i=1,MAXLOC
            key1(i)=0
            key2(i)=0
  302     continue
          j=2
   29     continue
            call lister(j,narg,words,nloci,loc,i,last)
          if (.not.last) then
            if (i.lt.0) then
              type=-i
              do 301 i=1,nloci
              if (loctyp(i).eq.type) then
                pos1=pos1+1
                key1(pos1)=i
                pos2=pos2+1
                key2(pos2)=locpos(i)
                if (loctyp(i).eq.1) then
                  pos2=pos2+1
                  key2(pos2)=locpos(i)+1
                end if
              end if
  301         continue
            elseif (loctyp(i).lt.4) then
              pos1=pos1+1
              key1(pos1)=i
              pos2=pos2+1
              key2(pos2)=locpos(i)
              if (loctyp(i).eq.1) then
                pos2=pos2+1
                key2(pos2)=locpos(i)+1
              end if
            end if
            goto 29
          end if
          call newnam(wrknum, wrkfil)
          open(TWRK,file=wrkfil,form='unformatted')
          call order(WRK,TWRK,key1,key2,pedigree,num,nfound,id,fa,mo,
     &           sex,locus,numloc,nloci,loc,loctyp,locpos.map)
          close(WRK,status='delete')
          close(TWRK,status='keep')
          open(WRK,file=wrkfil,form='unformatted')
C
C Reorder loci in pedigree file, locus database
C
      subroutine order(wrk,twrk,ord,pedigree,num,nfound,id,fa,mo,sex,
     &             locus,numloc,nloci,loc,loctyp,locpos.map,plevel)
      integer MAXSIZ,MAXLOC
      parameter (MAXSIZ=1000,MAXLOC=120)
      integer plevel, twrk, wrk
C Pedigree structure
      character*10 pedigree
      integer num,nfound 
      character*8 id(MAXSIZ) 
      integer fa(MAXSIZ),mo(MAXSIZ),sex(MAXSIZ)
      integer numloc
      real locus(MAXSIZ,MAXLOC)
      logical last
C
C Locus structure:
C number of loci, locus name, locus type, and locus position in file
C loctype 1=marker 2=quant 3=affection 4-6=deleted
C
      integer nloci
      character*10 loc(MAXLOC)
      integer loctyp(MAXLOC),locpos(MAXLOC)
C
C position of locus on sex-averaged linkage map
C
      real map(MAXLOC)
C
      integer i

      last=.false.
      rewind(wrk)
   10 continue
       call wrkin(wrk,pedigree,num,nfound,id,fa,mo,sex,locus,numloc,
     &            last)
       if (last) goto 20

       do 30 i=1,num
         
   30  continue
 
       call wrkout(twrk,pedigree,num,nfound,id,fa,mo,sex,
     &             locus,numloc)
      goto 10
   20 continue

      write(*,'(/a,i5/)') 'Number of pedigrees selected=',nped

      return
      end
C end-of-order
C
