c************
c  Description: Host MULTIPLY routine
c
c  Author:	JGS   12/19/90
c
c  $Revision: 1.1 $
c  $Modtime:   06 Apr 1994  9:39:44  $
c  
c************
	program MULTIPLY

	include 'primitive.inc'

	record /HEADER/ HA,HB,HC
	logical*4 abscissa,conjugate
	parameter (L_bbuf=32768)
	include 'buffers.inc'
	record /BUFFER/ A,B
	real*8 size, start

	call M$CHECKIN
c
c open and test input file #1
	HA.file_name = M$APICK(1)
	HA.type_allow = '1000,2000'	
	HA.format_allow = 'S#,C#'
	call M$INOK (HA)
c
c open and test input file #2
	HB.file_name = M$APICK(2)
	HB.type_allow = '1000,2000'	
	HB.format_allow = 'S#,C#'
	call M$INOK (HB)
c
c align and check for compatible input file specs
	abscissa = M$SPICK(4)
!!	call M$ALIGN (HA,HB,abscissa,size,start)
c
c find complex combination mode
	mode = 0
	if (HA.format(1:1).eq.'C') mode = mode + 1
	if (HB.format(1:1).eq.'C') mode = mode + 2
	conjugate = M$SPICK(5)
	if (conjugate) then
	  if (mode.ge.2) mode = mode + 2
	  if (mode.le.1) call M$WARNING('Asked for CONJ of real file')
	endif
c
c setup and allocate output file
	call M$PROPAGATE (HA, HC)
	HC.file_name = M$APICK(3)
	HC.format = M$PROMOTE_FORMAT (HA.format,HB.format,'SL')
	if (HC.class.eq.1) HC.xstart = start
	if (HC.class.eq.2) HC.ystart = start
	HC.size = size
	call M$ALLOCATE (HC)
c
c force type 1000 data reckoning
	call M$FORCE1000 (HA)
	call M$FORCE1000 (HB)
	call M$FORCE1000 (HC)
c
c set grabx parameters
	LPER = M$XFER_LENGTH (HC.bpe,L_bbuf)
	HA.buf_type = HC.buf_type
	HB.buf_type = HC.buf_type
c
c signal dataflow and start processing buffers
	call M$SYNC

	call M$VTYPE(HC.buf_type)

	do while ( M$DO(LPER,nget) )

	  HA.xfer_len = nget
	  HB.xfer_len = nget
	  call M$GRABX (HA, A, ngotA)
	  call M$GRABX (HB, B, ngotB)
	  ngot = min (ngotA,ngotB)

	  if (mode.eq.0) then		! A Real,    B Real
	    call M$VMUL(A, B, A, ngot)

	  elseif (mode.eq.1) then	! A Complex, B Real
	    call M$CRVMUL(A, B, A, ngot)

	  elseif (mode.eq.2) then	! A Real,    B Complex
	    call M$CRVMUL(B, A, B, ngot)

	  elseif (mode.eq.3) then	! A Complex, B Complex
	    call M$CVMUL(A, B, B, ngot, 0)

	  elseif (mode.eq.4) then	! A Real,    B Complex Conj.
	    call M$CVCONJ(B, B, ngot)
	    call M$CRVMUL(B, A, B, ngot)

	  elseif (mode.eq.5) then	! A Complex, B Complex Conj.
	    call M$CVMUL(A, B, B, ngot, 2)
	  endif

	  if (mode.le.1) call M$FILAD (HC, A, ngot)
	  if (mode.gt.1) call M$FILAD (HC, B, ngot)

	enddo
c
c close files
	call M$CLOSE (HA)
	call M$CLOSE (HB)
	call M$CLOSE (HC)

	call M$RETURN
	end
