c************
c  Description: Preliminary HOST NORMALIZE routine
c
c  Author:	JGS   12/19/90
c
c  $Revision: 1.1 $
c  $Modtime:   10/20/93 18:19:32  $
c  Modifications: NORMALIZE - taking Type 2000 files
c		  cjb 09-Jun-04, changed nbytes = HOUT.dbpe
c		  for Type 2000 files
c  
c************
	program NORMALIZE

	implicit none
	include 'primitive.inc'
	record /HEADER/ HIN,HOUT

	integer*4	LPER, Lbuf, mode, nbytes, ngot, Lwrkbuf
	integer*4	isok, idsc, idsh, idm, imax, imin
	real*4		sum, fscale, fshift, fmax, fmin, fsh, fmu
	complex*8	csum
	character*2	cmode

	call M$CHECKIN
c
c open and test input file 
	HIN.file_name = M$APICK(1)
	HIN.type_allow = '1000,2000'
	HIN.format_allow = 'S#,C#'
	call M$INOK (HIN)
c
c setup and allocate output file
	call M$PROPAGATE (HIN, HOUT)
	HOUT.file_name = M$APICK(2)
	HOUT.format = M$PROMOTE_FORMAT(HIN.format,'SF','SF')
	call M$ALLOCATE (HOUT)
c
c find normalize width
	if (HIN.type.ge.2000) then
	  LPER = HIN.subsize
	else
	  LPER = M$LPICK(3)
	  if (LPER.le.0) LPER = min(HIN.size,16384.d0)
	endif
c
c find normalization mode
	cmode = M$APICK(4)
	if (cmode.eq.'ME') then
	  mode = 1			! mean only
	elseif (cmode.eq.'SD') then
	  mode = 2			! mean + std dev scale
	elseif (cmode.eq.'PE') then
	  mode = 3			! peak-to-peak
	elseif (cmode.eq.'NO') then
	  mode = 4			! no normalization - just scale
	else
	  call M$ERROR('Unsupported normalize mode :'//cmode)
	endif
c
c get scaling factors
	fscale = M$FPICK(5)
	fshift = M$FPICK(6)
c
c real-time controls of scaling
	idm  = M$MWINIT ('Mode',mode,
     &	'MODE;Mean Only,Mean+Std,Peak-to-Peak,No Norm')
	idsc = M$FWINIT ('Scale',fscale,1.0,-1.0,1.0)	
	idsh = M$FWINIT ('Shift',fshift,1.0,-1.0,1.0)	
c
c allocate a buffer
c=====MODIFICATION DR #500248============================
	if (HIN.type.ge.2000) then
	  nbytes = HOUT.dbpe
	else
	  nbytes = LPER*HOUT.dbpe
	endif
	call M$MALLOC (nbytes,Lbuf)
	if (HIN.format(1:1).eq.'C' .and. (mode .eq. 3) ) 
     &     call M$MALLOC (nbytes/2,Lwrkbuf)
c
c set grabx parameters
	call M$FORCE1000 (HIN)
	call M$FORCE1000 (HOUT)
	HIN.buf_type = 'F'
	HOUT.buf_type = 'F'

	call M$SYNC
c
c loop through buffers
	do while ( M$DO(LPER,HIN.xfer_len) )

	  call M$GRABX (HIN, %val(Lbuf), ngot)

	  isok = M$MWGET (idm,mode)
	  isok = M$FWGET (idsc,fscale)
	  isok = M$FWGET (idsh,fshift)

	  if (HIN.format(1:1).eq.'C') then		! complex

	    if (mode .eq. 1 .and. ngot.gt.0) then
	      call M$CVSUM (%val(Lbuf), csum, ngot)
	      call M$CVSADD (%val(Lbuf), -csum/ngot, %val(Lbuf), ngot)
	    elseif (mode .eq. 2) then
	      call M$CVNORM (%val(Lbuf),%val(Lbuf),ngot)
	    elseif (mode .eq. 3) then
	      call M$CVNORM (%val(Lbuf),%val(Lwrkbuf),ngot)
	      call M$VMXMN (%val(Lwrkbuf),fmax,fmin,imax,imin,ngot)
	      fsh = -(fmax+fmin)/2
	      call M$VSADD (%val(Lbuf), fsh, %val(Lbuf), ngot*2)
	      fmu = (fmax-fmin)
	      if (fmu.ne.0.0) fmu = 1.0/fmu	
	      call M$VSMUL (%val(Lbuf), fmu, %val(Lbuf), ngot*2)
	    endif

	    if (fscale.ne.1.0)
     &	      call M$VSMUL (%val(Lbuf), fscale, %val(Lbuf), ngot*2)
	    if (fshift.ne.0.0)
     &	      call M$VSADD (%val(Lbuf), fshift, %val(Lbuf), ngot*2)

	  else						! real

	    if (mode .eq. 1 .and. ngot .gt. 0) then
	      call M$VSUM (%val(Lbuf), sum, ngot)
	      call M$VSADD (%val(Lbuf), -sum/ngot, %val(Lbuf), ngot)
	    elseif (mode .eq. 2) then
	      call M$VNORM (%val(Lbuf),%val(Lbuf),ngot)
	    elseif (mode .eq. 3) then
	      call M$VMXMN (%val(Lbuf),fmax,fmin,imax,imin,ngot)
	      fsh = -(fmax+fmin)/2
	      call M$VSADD (%val(Lbuf), fsh, %val(Lbuf), ngot)
	      fmu = (fmax-fmin)
	      if (fmu.ne.0.0) fmu = 1.0/fmu	
	      call M$VSMUL (%val(Lbuf), fmu, %val(Lbuf), ngot)
	    endif

	    if (fscale.ne.1.0)
     &	      call M$VSMUL (%val(Lbuf), fscale, %val(Lbuf), ngot)
	    if (fshift.ne.0.0)
     &	      call M$VSADD (%val(Lbuf), fshift, %val(Lbuf), ngot)

	  endif

	  call M$FILAD (HOUT, %val(Lbuf), ngot)

	enddo

c close files
	call M$CLOSE (HIN)
	call M$CLOSE (HOUT)
	call M$RETURN

	end

