c************
c  Description: Commutates an input file into a number of output files
c
c  Author:	JGS
c
c  $Revision: 1.4 $
c  $Modtime:   18 Aug 1993 14:52:02  $
c  
c************
	program FANOUT
c
	include 'primitive.inc'
        parameter (maxfiles=32,L_bbuf=32768)
        record /HEADER/ HIN,HOUT(maxfiles)
        record /M_PTR/ bloc
	integer*4 syncmode
c
	call M$CHECKIN
c
c get the number of input files
	nfiles = M$GET_SWITCH('MF')
	if (nfiles.le.0) nfiles = Mc.number_parameters - 1
	if (nfiles.gt.maxfiles) call M$ERROR ('Too many input files')
c
c open and test input file
	HIN.file_name = M$APICK(1)
	HIN.type_allow = ' '	
	HIN.format_allow = ' '
	call M$INOK (HIN)
c
c get the frame size
	LFRAME = M$GET_SWITCH('FS')
	if (LFRAME.le.0) then
	  LFRAME = HIN.subsize
	  if (HIN.class .ne. 2) LFRAME = 1 
	endif
c
c open output files 
	do n = 1,nfiles
	  HOUT(n).file_name = M$APICK(n+1)
	  Mu.files = 0	! no overwrite checking
	  call M$PROPAGATE (HIN, HOUT(n))
	  call M$ALLOCATE (HOUT(n))
	  call M$FORCE1000 (HOUT(n))
	enddo
c
c finish input file
	call M$FORCE1000 (HIN)
	maxbpe = HIN.bpe
c
c real time control of commutator
	ns = M$GET_SWITCH('SELECT')	
	ids = M$LWINIT ('Select out',ns,-1,nfiles,1)
	syncmode = M$GET_SWITCH('SYNC')	
	ng = M$GET_SWITCH('GATE')	
	idg = M$LWINIT ('Gate width',ng,-1,LFRAME,1)
c
c get a buffer for a single record
	LPER = min(LFRAME, M$XFER_LENGTH (maxbpe,L_bbuf))
	call M$MALLOC (maxbpe*LPER,bloc.p)
c
c signal end of preamble
	call M$SYNC
c
c loop through buffers
	n = 0
	do while ( M$DO(LFRAME,ndo) )

	  idum = M$LWGET(ids,ns)  ! new select mode
	  idum = M$LWGET(idg,ng)  ! new gate mode
	  ngdo = ng

	  do while (ns.eq.0)		! block
	    call M$PAUSE(Mc.pause)
	    idum = M$LWGET(ids,ns)
	    if (Mc.break) goto 99
	  enddo

	  if (ns.lt.0) n = mod(n,nfiles)+1	! commutate

	  do while (ndo.gt.0)
	    nget = min(ndo,LPER)

	    HIN.xfer_len = nget
	    call M$GRABX (HIN,%val(bloc.p),ngot)

	    if (ngdo.gt.0) then			! apply gate
	      i = min(ngdo,ngot)
	      call M$REFORMAT (0,'L',%val(bloc.p),HIN.buf_type,1)
	      call M$VMOVN (%val(bloc.p),0,%val(bloc.p),1,i*HIN.spa,HIN.bps)
	      ngdo = ngdo - i
	    endif
		
	    if (ns.lt.0) then		! commutate
	      call M$FILAD (HOUT(n), %val(bloc.p), ngot)
	    else			! select
	      call M$FILAD (HOUT(ns), %val(bloc.p), ngot)
	    endif

	    ndo = ndo - nget
	  enddo

	enddo
c
c close files
  99	call M$CLOSE (HIN)
	do n = 1,nfiles
	  call M$CLOSE (HOUT(n))
	enddo

	call M$RETURN

	end

