      program sorthkl
      implicit none
c---- functions
      integer   hkl
      integer   length
c---- local vars
      character infile*80
      integer   li
      character outfile*80
      integer   lo
      integer   nd
      integer   nin,nout,nr
      integer   h,k,l
      real      intensity,sigma
c      integer   i,s
      integer   error
      character string*80
      character command*80
      integer   lc
      integer   code
      integer   allowed  ! if only one or more of these bits are set the
                         ! reflection is still accepted
      logical   ok
      integer   n_allowed
      integer   n_good
      character line*80
      integer   in,out
      character message*256
 
      call finish(-6)
      allowed = 16+32+64
      allowed = 1+2+4+8+16+32+64+128+256+512
      allowed = 0
      call get_logical('MASK',line)
      if(line.ne.'MASK') then
        call get_integer(allowed,line)
        if(allowed.lt.0) allowed = 65535
      endif
      if(allowed.ne.0) then
        call str_integer(allowed,'Allowed error code mask = #',string)
        call str_write(6,string)
        call log_add(string)
      endif
      error = 1
      call get_commandline
      call get_inp(infile,nd,'FAST filename to sort',
     1 *900)
      call build_file(infile,' ','.FAST',infile,li)
      call open_file(infile(1:li),in,message,error)
      call str_write(6,message)
      if(error.ne.0) goto 900
      read(in,'(a)') line
 
      call build_file_type(infile,' ','.SCR',outfile,lo)
      call create_file(outfile(1:lo),out,message,error)
      call str_write(6,message)
      if(error.ne.0) goto 900
 
c---- skip header
      read(in,'(a)') line
      do while(line(1:6).ne.'!!_END')
        read(in,'(a)') line
      enddo
c
      read(in,*,iostat=error) nr,h,k,l,intensity,sigma,code
      if(error.ne.0) then
        call str_write(6,'Error: empty input file')
        goto 900
      endif
      nin = 0
      nout = 0
      n_good  = 0
      n_allowed = 0
      do while(error.eq.0)
        nin = nin + 1
        ok = ((code.eq.0) .or. ((code.and.allowed).eq.code))
        if(code.eq.0) then
          n_good = n_good + 1
          write (out,200) hkl(h,k,l),h,k,l,intensity,sigma,code,nr
200       format(i10,3i5,2f9.2,i6,i6)
          nout = nout + 1
        else if((code.and.allowed).eq.code) then
          n_allowed = n_allowed + 1
          write (out,200) hkl(h,k,l),h,k,l,intensity,sigma,code,nr
          nout = nout + 1
        endif
        read(in,*,iostat=error) nr,h,k,l,intensity,sigma,code
      enddo ! while error
      close(in)
      close(out)
      call str_num(n_good,'# reflection^ with errorcode 0',string)
      call str_write(6,string)
      call log_add(string)
      if(n_allowed.ne.0) then
        call str_num(n_allowed,
     1   '# reflection^ with allowed errorcode',string)
        call str_write(6,string)
        call log_add(string)
      endif
      call str_num(nin,'# reflection^ from '//infile(1:li),string)
      call str_write(6,string)
      call log_add(string)
      call str_num(nout,'# reflection^ to '//outfile(1:lo),string)
      call str_write(6,string)
      call log_add(string)
      error = 0
900   continue
      call log_close
      call finish(6)
      if(error.ne.0) then
        call exit(2)
      else
        command = 'SORT '//outfile(1:lo)// ' '//outfile(1:lo)
        lc = length(command)
        call str_write(6,'Executing '//command(1:lc))
        call lib$do_command(command(1:lc))
      endif
      end
 
      integer function hkl(h,k,l)
      implicit none
      integer   h,k,l
c---- constants
      integer   maxindex
      parameter (maxindex = 200)
c---- NB abs(h) < 100
c
      hkl = (h+maxindex)*maxindex**2 +
     1      (k+maxindex)*maxindex +
     2      (l+maxindex)
      return
      end
