* Rearranges patches of a wave-file (shuffles them like a card deck)

      program REARRANGE
       include 'fsublib.fi'

       structure /WAVEHEADER/
        integer		main_id
        integer		length
        integer		wave_id
        integer		fmt_id
        integer		fmt_length
        integer*2	format
        integer*2	channels
        integer		samplerate
        integer		byte_per_second
        integer*2	samplesize
        integer*2	bit
        integer		data_id
        integer		data_length
       end structure

       character*256		arg
       record /WAVEHEADER/	header
       logical			exists
       integer*2		t_h, t_m, t_s, t_ms
       integer*1		buffer(:)
       integer			src, dst, status, size, patchsize

       real			length

       if(iargc() .NE. 4)
     &  stop 'rearrange {infile.wav} {outfile.wav} {patchsize|0}'

       call igetarg(3, arg)
       read(arg,*) length

       call igetarg(1, arg)
       inquire(file=arg, exist=exists)
       if(.not. exists) go to 666

       open(10, file=arg, status='OLD', access='SEQUENTIAL', err=666,
     &       form='UNFORMATTED', recordtype='FIXED', action='READ')
       read(10,err=666) header
       header.samplesize = 2
       size = filesize(10) - isizeof(header)
       allocate(buffer(size), stat=status)
       if(status .NE. 0) go to 666
       read(10,err=666) buffer
       close(10)

       call gettim(t_h, t_m, t_s, t_ms)
       if(length .NE. 0)
     &  patchsize = length*header.samplesize*header.samplerate
       i = 1
       while(i .LE. size) do
	if(length .EQ. 0)
     &   patchsize = urand(t_ms)*header.samplesize*header.samplerate
        if(mod(patchsize, 2)) patchsize = patchsize + 1
        if(i + patchsize .GT. size) quit
	k = int(urand(t_ms)*(size-patchsize)/
     &		(header.channels*header.samplesize))*
     &		header.channels*header.samplesize + 1
        do j = 0, patchsize
	 src = buffer(i+j)
	 dst = buffer(k+j)
	 buffer(i+j) = dst
	 buffer(k+j) = src
	end do
	i = i + patchsize
       end while

       call igetarg(2, arg)
       inquire(file=arg, exist=exists)
       if(exists) call fsystem('del '//arg(:lentrim(arg)))
       open(10, file=arg, status='NEW', access='SEQUENTIAL',err=666,
     &       form='UNFORMATTED', recordtype='FIXED', action='WRITE')
       write(10,err=666) header
       write(10,err=666) buffer
       close(10)

       deallocate(buffer)

       stop 'Finished properly'
666    print *, 'Some kind of error occured - but I don''t care...'
      end